diff --git a/A-INSTALL b/A-INSTALL
index b24b68d83beadd3dad6fdce21619a189c8c84192..fd58dab6f265e5ed95c672869c60329b468d940b 100644
--- a/A-INSTALL
+++ b/A-INSTALL
@@ -1,8 +1,8 @@
#
# Version of PACKAGE MESONH "Open distribution"
-# PACK-MNH-V5-6-2
-# DATE : 28/11/2023
-# VERSION : MESONH MASDEV5_6 + BUG-2
+# PACK-MNH-V5-7-0
+# DATE : 08/01/2024
+# VERSION : MESONH MASDEV5_7 + BUG-0
#
# MAP
#
@@ -1022,13 +1022,9 @@ git clone -b 2014.01 https://github.com/forefireAPI/firefront.git
# b) MNH_RTTOV for optional radiative computation
# --------------------------------------
#
-# The RTTOV package was not included into the open source version of Meso-NH
+# The RTTOV 13.2 package was not included into the open source version of Meso-NH
# because it needs a licence agrement.
#
-# ----------------------------------
-# OPTION 1: Use version 13.2 of RTTOV
-# -----------------------------------
-#
# Run the 'configure' script preceded with the setting of the MNH_RTTOV variable:
#
cd MNH.../src/
@@ -1058,63 +1054,6 @@ make ARCH=ifort # Use Intel "ifort" compiler; other options: gfortran, NA
cd MNH.../src/
make
-# ----------------------------------
-# OPTION 2: Use version 11.3 of RTTOV
-# -----------------------------------
-# Download the RTTOV package rttov113.tar.gz by following the instructions given on https://nwpsaf.eu/site/software/rttov/
-#
-# Install the RTTOV package rttov113.tar.gz
-cd MNH.../src/LIB
-mkdir RTTOV-11.3
-cd RTTOV-11.3
-tar xvfz rttov113.tar.gz
-cd src
-make ARCH=ifort # Use Intel "ifort" compiler; other options: gfortran, NAG, pgf90, IBM
-#
-# And then for the compilation, run the 'configure' script preceded with the setting of the MNH_RTTOV variable:
-#
-
-cd MNH.../src/
-export MNH_RTTOV=1
-export VER_RTTOV=11.3
-./configure
-
-etc ...
-
-# ----------------------------------
-# OPTION 3: Use version 8.7 of RTTOV
-# ----------------------------------
-# For already(old) licencied MesoNH users (MNH-4-X version with research licence see here: http://mesonh.aero.obs-mip.fr/mesonh410/UserInformation)
-#
-# the package could be reloaded in this way
-#
-# - With cvs access
-#
-
-cd MNH.../src/LIB
-cvs up -rPACK-MNH-V4-10-3 -d -P RTTOV
-
-#
-# - With WEB access (with WEB login/pass as usually) the RTTOV package could also be retrieve in tarball with wget like this:
-#
-
-cd MNH.../src/LIB
-wget --http-user=USER --http-password=PASS 'http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/viewcvs.cgi/MNH-VX-Y-Z/src/LIB/RTTOV/?view=tar&pathrev=PACK-MNH-V4-10-3' -O RTTOV.tar.gz
-tar xvfz RTTOV.tar.gz
-
-# /!\ don't forget the ''. Otherwise, this will not work!
-
-#
-# And then for the compilation, run the 'configure' script preceded with the setting of the MNH_RTTOV variable:
-#
-
-cd MNH.../src/
-export MNH_RTTOV=1
-export VER_RTTOV=8.7
-./configure
-
-etc ...
-
# c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF
# --------------------------------------
#
diff --git a/MY_RUN/KTEST/014_LIMA/002_mesonh/EXSEG1.nam b/MY_RUN/KTEST/014_LIMA/002_mesonh/EXSEG1.nam
index 520671a7f97b4fde4022bafc66f27be5c186bfe5..626e2e3f9b91e7835674cfe896f7aabb42a9178a 100644
--- a/MY_RUN/KTEST/014_LIMA/002_mesonh/EXSEG1.nam
+++ b/MY_RUN/KTEST/014_LIMA/002_mesonh/EXSEG1.nam
@@ -38,6 +38,7 @@
CTURBDIM = "3DIM",
LTURB_DIAG = F,
LTURB_FLX = F
+ LTURB_PRECIP = F/
/
&NAM_CH_MNHCn LUSECHEM = F /
@@ -103,24 +104,28 @@
XIFN_CONC(1)=1000./ ! Concentration du mode 1 d'IFN (/L)
-&NAM_BU_RU LBU_RU = T /
+&NAM_BU_RU LBU_RU = F /
-&NAM_BU_RW LBU_RW = T /
+&NAM_BU_RW LBU_RW = F /
&NAM_BU_RTH LBU_RTH = T /
-&NAM_BU_RRV LBU_RRV = T /
+&NAM_BU_RRV LBU_RRV = F /
-&NAM_BU_RRC LBU_RRC = T /
+&NAM_BU_RRC LBU_RRC = F /
-&NAM_BU_RRR LBU_RRR = T /
+&NAM_BU_RRR LBU_RRR = T,
+ CBULIST_RRR(1) = "ALL"/
&NAM_BU_RRI LBU_RRI = T /
-&NAM_BU_RRS LBU_RRS = T /
+&NAM_BU_RRS LBU_RRS = T,
+ CBULIST_RRS(1) = "ALL"/
-&NAM_BU_RRG LBU_RRG = T /
+&NAM_BU_RRG LBU_RRG = T,
+ CBULIST_RRG(1) = "ALL"/
&NAM_BU_RSV LBU_RSV = T /
+ CBULIST_RSV(1) = "ALL"/
&NAM_NEBn LSUBG_COND = F /
&NAM_PARAM_ICEn CSUBG_AUCV_RC = 'NONE'/
diff --git a/bin/Mpirun b/bin/Mpirun
index a17fb8255685db0979e45334e0c91aad8f75197b..f1da14a45e8d8206d8a0cd3de833608aadabc4d0 100755
--- a/bin/Mpirun
+++ b/bin/Mpirun
@@ -3,7 +3,7 @@
#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.
-set -x
+#set -x
NARGS=$#
let "N_1=${NARGS} - 1"
export N_1
diff --git a/bin/spll b/bin/spll
index 2fca7bbac410524360863946a1c820c5672ae4eb..58dd5438bb435dbcdaee6390b05005b7dc3e2b83 100755
--- a/bin/spll
+++ b/bin/spll
@@ -4,6 +4,7 @@
#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
#set -x
+export LC_ALL=C
if [ $# -ne 2 ]
then
echo ERROR USAGE :: spll NSOURCE file
@@ -33,7 +34,8 @@ turb.f90|shallow_mf.f90|rain_ice.f90|lima.f90|\
lima_adjust_split.f90|lima_precip_scavenging.f90|ini_tiwmx.f90|\
ini_snow.f90|ini_rain_ice.f90|ini_neb.f90|ini_cst.f90|\
ice_adjust.f90|gradient_u.f90|gradient_v.f90|gradient_w.f90|\
-gamma.f90|gamma_inc.f90|general_gamma.f90|condensation.f90"
+gamma.f90|gamma_inc.f90|general_gamma.f90|condensation.f90|\
+minpack.f90"
#
if [ "$SUF" = "f" ]
diff --git a/bin/spll_lst b/bin/spll_lst
index 96bd5b15f838cb28c8c77a1904954b55e29d68e1..c86fcf06be5706aa9c20437845dd1cbcd49ffa75 100755
--- a/bin/spll_lst
+++ b/bin/spll_lst
@@ -4,6 +4,7 @@
#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
#set -x
+export LC_ALL=C
if [ $# -ne 2 ]
then
echo ERROR USAGE :: spll NSOURCE file
@@ -33,7 +34,8 @@ turb.f90|shallow_mf.f90|rain_ice.f90|lima.f90|\
lima_adjust_split.f90|lima_precip_scavenging.f90|ini_tiwmx.f90|\
ini_snow.f90|ini_rain_ice.f90|ini_neb.f90|ini_cst.f90|\
ice_adjust.f90|gradient_u.f90|gradient_v.f90|gradient_w.f90|\
-gamma.f90|gamma_inc.f90|general_gamma.f90|condensation.f90"
+gamma.f90|gamma_inc.f90|general_gamma.f90|condensation.f90|\
+minpack.f90"
#
if [ "$SUF" = "f" ]
diff --git a/bin/spll_new b/bin/spll_new
index ba3f84c799656ca9bafb0ab4334cd13b87d6ab0a..2f450ebdaa82eab9bcda1311761a910654798941 100755
--- a/bin/spll_new
+++ b/bin/spll_new
@@ -4,6 +4,7 @@
#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
#set -x
+export LC_ALL=C
if [ $# -ne 2 ]
then
echo ERROR USAGE :: spll NSOURCE file
@@ -33,7 +34,8 @@ turb.f90|shallow_mf.f90|rain_ice.f90|lima.f90|\
lima_adjust_split.f90|lima_precip_scavenging.f90|ini_tiwmx.f90|\
ini_snow.f90|ini_rain_ice.f90|ini_neb.f90|ini_cst.f90|\
ice_adjust.f90|gradient_u.f90|gradient_v.f90|gradient_w.f90|\
-gamma.f90|gamma_inc.f90|general_gamma.f90|condensation.f90"
+gamma.f90|gamma_inc.f90|general_gamma.f90|condensation.f90|\
+minpack.f90"
#
if [ "$SUF" = "f" ]
diff --git a/conf/profile_mesonh.ihm b/conf/profile_mesonh.ihm
index 54f2d6f79452ba7315511be9ffb871a408f44819..c20fbc4f98dea81aa111a659425d3fdcdcfe2214 100755
--- a/conf/profile_mesonh.ihm
+++ b/conf/profile_mesonh.ihm
@@ -176,9 +176,7 @@ export VARTTY=\`tty\`
#
[ ! -f \${SRC_MESONH}/conf/conf_\${ARCH} ] || . \${SRC_MESONH}/conf/conf_\${ARCH}
#
-# Optional Environnement variable/Module Env
-#
-${MNHENV}
+# Check 'CDFPERSO'
#
if [ \${VER_CDF} = 'CDFPERSO' ] ; then
if [ -z \$NETCDF_CONFIG ] ; then
@@ -186,6 +184,9 @@ echo 'WARNING : You chose VER_CDF=CDFPERSO, please set NETCDF_CONFIG environment
fi
fi
#
+#
+# Check 'OASISPERSO'
+#
if [ -n "${VER_OASIS}" ] ; then
if [ \${VER_OASIS} = 'OASISPERSO' ] ; then
if [ -z \$OASISDIR ] ; then
@@ -193,3 +194,7 @@ echo 'WARNING : You chose VER_OASIS=OASISPERSO, please set OASISDIR environment
fi
fi
fi
+#
+# Optional Environnement variable/Module Env
+#
+${MNHENV}
diff --git a/src/ARCH_SRC/surfex/dummy_topd.F90 b/src/ARCH_SRC/surfex/dummy_topd.F90
index 2f35ab71a5b0ea22bf2066595c087cfe6f84f4c6..0fdc837507609a3d745a782e55e704102e579e39 100644
--- a/src/ARCH_SRC/surfex/dummy_topd.F90
+++ b/src/ARCH_SRC/surfex/dummy_topd.F90
@@ -4,6 +4,7 @@ END MODULE MODD_BUDGET_COUPL_ROUT
! ######################
! ######################
MODULE MODD_COUPLING_TOPD
+LOGICAL :: LPERT_PARAM
END MODULE MODD_COUPLING_TOPD
! ######################
! ######################
diff --git a/src/LIB/FOREFIRE/C_ForeFire_Interface.c b/src/LIB/FOREFIRE/C_ForeFire_Interface.c
index a2fad3353d9148479a19d72a7be8421c0836c65a..f00a1a015a7f92a5cd4a2a16ec56f00751d0cc35 100644
--- a/src/LIB/FOREFIRE/C_ForeFire_Interface.c
+++ b/src/LIB/FOREFIRE/C_ForeFire_Interface.c
@@ -1,5 +1,5 @@
/*
-*MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+*MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
*MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
*MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
*MNH_LIC for details. version 1.
diff --git a/src/LIB/FOREFIRE/F_ForeFire_Interface.f90 b/src/LIB/FOREFIRE/F_ForeFire_Interface.f90
index b9457e78139f07d2d5a26672b220a8677fd77ef7..2792cbb56ce5e377ab1914cc2ac2a6680ffd9945 100644
--- a/src/LIB/FOREFIRE/F_ForeFire_Interface.f90
+++ b/src/LIB/FOREFIRE/F_ForeFire_Interface.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
diff --git a/src/LIB/FOREFIRE/coupling_forefiren.f90 b/src/LIB/FOREFIRE/coupling_forefiren.f90
index 0791f7f1cca1272e036f8a3d32cfd1ea5bec888d..6308f5c59ffa05a32c219332f07574b725f5c037 100644
--- a/src/LIB/FOREFIRE/coupling_forefiren.f90
+++ b/src/LIB/FOREFIRE/coupling_forefiren.f90
@@ -1,9 +1,8 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!##############################
+!##############################
MODULE MODI_COUPLING_FOREFIRE_n
!##############################
@@ -83,20 +82,20 @@ INTEGER :: JSV
PSFTQ(:, :) = PSFTQ(:, :) + FF_VAPORFLUX(:, :)
DO JSV = 1, NSV_FF
- CALL MNH_GET_DOUBLEARRAY(sScalarVariables(JSV), FF_SVFLUXES(:, :, JSV), FF_MATRIXSIZE, 1)
+ CALL MNH_GET_DOUBLEARRAY(sScalarVariables(JSV), FF_SVFLUXES(:, :, JSV), FF_MATRIXSIZE, 1)
PSFSV(:, :, NSV_FFBEG-1+JSV) = PSFSV(:, :, NSV_FFBEG-1+JSV) + FF_SVFLUXES(:, :, JSV)
END DO
-
+
IF ( LFFCHEM ) THEN
DO JSV = 1, NFFCHEMVAR
- CALL MNH_GET_DOUBLEARRAY(sChemicalVariables(JSV), FF_CVFLUXES(:, :, JSV), FF_MATRIXSIZE, 1)
+ CALL MNH_GET_DOUBLEARRAY(sChemicalVariables(JSV), FF_CVFLUXES(:, :, JSV), FF_MATRIXSIZE, 1)
PSFSV(:, :, FF_CHEMINDICES(JSV)) = PSFSV(:, :, FF_CHEMINDICES(JSV)) + FF_CVFLUXES(:, :, JSV)
END DO
ENDIF
END SUBROUTINE COUPLING_FOREFIRE_n
-
+
!##############################################
SUBROUTINE SEND_GROUND_WIND_n (U, V, KG, IINFO)
!##############################################
@@ -139,7 +138,7 @@ TYPE(LIST_ll), POINTER :: FOREFIREFIELD_ll ! list of fields to exc
FFOUTERWINDV(2,JFF) = V(3,JFF,KG)
FFOUTERWINDV(FF_NX-1,JFF) = V(FF_NX-2,JFF,KG)
END DO
-
+
VAL1 = INT(U(2,3,KG)*FFMULT+0.5)
VAL2 = INT(U(3,3,KG)*FFMULT+0.5)
VAL3 = INT(U(3,2,KG)*FFMULT+0.5)
@@ -177,8 +176,8 @@ TYPE(LIST_ll), POINTER :: FOREFIREFIELD_ll ! list of fields to exc
FFOUTERWINDV(FF_NX-1,FF_NY-1) = VAL1*FFMULT*FFMULT*100 + VAL2*FFMULT*10 + VAL3
NULLIFY(FOREFIREFIELD_ll)
- CALL ADD2DFIELD_ll( FOREFIREFIELD_ll, FFOUTERWINDU, 'SEND_GROUND_WIND_n::FFOUTERWINDU' )
- CALL ADD2DFIELD_ll( FOREFIREFIELD_ll, FFOUTERWINDV, 'SEND_GROUND_WIND_n::FFOUTERWINDV' )
+ CALL ADD2DFIELD_ll(FOREFIREFIELD_ll,FFOUTERWINDU,'FF2D::OUTERWINDU')
+ CALL ADD2DFIELD_ll(FOREFIREFIELD_ll,FFOUTERWINDV,'FF2D::OUTERWINDU')
CALL UPDATE_HALO_ll(FOREFIREFIELD_ll,IINFO)
CALL CLEANLIST_ll(FOREFIREFIELD_ll)
CALL MNH_PUT_DOUBLEARRAY(sOutWindU, FF_TIME, FFOUTERWINDU, FF_MATRIXSIZE, 1)
@@ -186,7 +185,7 @@ TYPE(LIST_ll), POINTER :: FOREFIREFIELD_ll ! list of fields to exc
END SUBROUTINE SEND_GROUND_WIND_n
-
+
!#####################################
SUBROUTINE FOREFIRE_RECEIVE_PARAL_n ()
!#####################################
@@ -209,7 +208,7 @@ IMPLICIT NONE
END SUBROUTINE FOREFIRE_RECEIVE_PARAL_n
-
+
!#######################################
SUBROUTINE FOREFIRE_SEND_PARAL_n (IINFO)
!#######################################
@@ -239,18 +238,18 @@ TYPE(LIST_ll), POINTER :: FOREFIREFIELD_ll ! list of fields to exch
!* Calling the MNH parallel routines for the forefire-related variables
!
NULLIFY(FOREFIREFIELD_ll)
- CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_POSX, 'FOREFIRE_SEND_PARAL_n::FFNODES_POSX' )
- CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_POSY, 'FOREFIRE_SEND_PARAL_n::FFNODES_POSY' )
- CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_VELX, 'FOREFIRE_SEND_PARAL_n::FFNODES_VELX' )
- CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_VELY, 'FOREFIRE_SEND_PARAL_n::FFNODES_VELY' )
- CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_TIME, 'FOREFIRE_SEND_PARAL_n::FFNODES_TIME' )
- CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_ID, 'FOREFIRE_SEND_PARAL_n::FFNODES_ID' )
+ CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_POSX,'FF3D::NODEPOSX')
+ CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_POSY,'FF3D::NODEPOSY')
+ CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_VELX,'FF3D::NODEVELX')
+ CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_VELY,'FF3D::NODEVELY')
+ CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_TIME,'FF3D::NODETIME')
+ CALL ADD3DFIELD_ll(FOREFIREFIELD_ll, FFNODES_ID,'FF3D::NODEID')
CALL UPDATE_HALO_ll(FOREFIREFIELD_ll, IINFO)
CALL CLEANLIST_ll(FOREFIREFIELD_ll)
END SUBROUTINE FOREFIRE_SEND_PARAL_n
-
-
+
+
!#####################################################
SUBROUTINE FOREFIRE_DUMP_FIELDS_n(U, V, W, MNHSV, TH &
, R, PABS, TKE, NX, NY, NZ)
@@ -281,7 +280,7 @@ INTEGER :: JSV
FF3DOUT = 1
FFNUMOUT = FFNUMOUT + 1
END IF
-
+
IF ( FF3DOUTPUTSFLOW .AND. FF3DOUT.EQ.1 ) THEN
CALL MNH_DUMP_DOUBLEARRAY(FFNMODEL, PROCID, sU, FF_TIME, U, NX*NY*NZ, NX, NY, NZ, 1)
CALL MNH_DUMP_DOUBLEARRAY(FFNMODEL, PROCID, sV, FF_TIME, V, NX*NY*NZ, NX, NY, NZ, 1)
@@ -291,14 +290,14 @@ INTEGER :: JSV
, FF_TIME, MNHSV(:, :, :, NSV_FFBEG-1+JSV), NX*NY*NZ, NX, NY, NZ, 1)
END DO
END IF
-
+
IF ( FF3DOUTPUTSPHYS .AND. FF3DOUT.EQ.1 ) THEN
CALL MNH_DUMP_DOUBLEARRAY(FFNMODEL, PROCID, sT, FF_TIME, TH, NX*NY*NZ, NX, NY, NZ, 1)
CALL MNH_DUMP_DOUBLEARRAY(FFNMODEL, PROCID, sMoist, FF_TIME, R, NX*NY*NZ, NX, NY, NZ, 1)
CALL MNH_DUMP_DOUBLEARRAY(FFNMODEL, PROCID, sP, FF_TIME, PABS, NX*NY*NZ, NX, NY, NZ, 1)
CALL MNH_DUMP_DOUBLEARRAY(FFNMODEL, PROCID, sTKE, FF_TIME, TKE, NX*NY*NZ, NX, NY, NZ, 1)
END IF
-
+
IF ( LFFCHEM .AND. FF3DOUTPUTSCHEM .AND. FF3DOUT.EQ.1 ) THEN
DO JSV = 1, NFFCHEMVAR
CALL MNH_DUMP_DOUBLEARRAY(FFNMODEL, PROCID, cast_char_to_c(CNAMES(FF_CHEMINDICES(JSV))) &
@@ -309,7 +308,7 @@ INTEGER :: JSV
, FF_TIME, MNHSV(:, :, :, FF_CHEMINDOUT(JSV)), NX*NY*NZ, NX, NY, NZ, 1)
END DO
END IF
-
+
FF3DOUT = 0
END SUBROUTINE FOREFIRE_DUMP_FIELDS_n
diff --git a/src/LIB/FOREFIRE/init_forefiren.f90 b/src/LIB/FOREFIRE/init_forefiren.f90
index 00c85c6238af9cc3d0e675fcfd4b3dce258002e0..767f92d1c5dd314339f55245b96930ee6f88ae73 100644
--- a/src/LIB/FOREFIRE/init_forefiren.f90
+++ b/src/LIB/FOREFIRE/init_forefiren.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -34,6 +34,7 @@
!! -------
!! P. Tulet CNRM
!! X. Pialat SPE
+!! J.B.Filippi (SPE)
USE MODD_FOREFIRE
USE MODD_FOREFIRE_n
diff --git a/src/LIB/FOREFIRE/modd_forefire.f90 b/src/LIB/FOREFIRE/modd_forefire.f90
index 4afe973443e1e0f8c13132c7cbeda66b51c4a1e4..563962a05b53a354c2898a93761a913cb536cf31 100644
--- a/src/LIB/FOREFIRE/modd_forefire.f90
+++ b/src/LIB/FOREFIRE/modd_forefire.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -12,6 +12,7 @@
!! ------
! : P. Tulet, LACy / CNRM
!! : X. Pialat, SPE
+! J.B.Filippi (SPE)
! Creation : 15.02.2012
!
!-------------------------------------------------------------------------------
diff --git a/src/LIB/FOREFIRE/modd_forefiren.f90 b/src/LIB/FOREFIRE/modd_forefiren.f90
index bea6c974552a5fbd6718f79f8f8ac44fc6b5ea66..6c019357d6e82de5236c2f79daff6534bd9a327c 100644
--- a/src/LIB/FOREFIRE/modd_forefiren.f90
+++ b/src/LIB/FOREFIRE/modd_forefiren.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -8,7 +8,7 @@
!! AUTHOR
!! ------
!! P. Tulet *Meteo France*
-!!
+!!! J.B.Filippi (SPE)
!! MODIFICATIONS
!! -------------
!! Original 07/08
diff --git a/src/LIB/FOREFIRE/modn_forefire.f90 b/src/LIB/FOREFIRE/modn_forefire.f90
index a1e956163d9f898b4128677f1161619c594a1f7e..337ff931683ebeacbc246d4b9e2671d84046e60f 100644
--- a/src/LIB/FOREFIRE/modn_forefire.f90
+++ b/src/LIB/FOREFIRE/modn_forefire.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -11,7 +11,8 @@
!! AUTHOR
!! ------
! : P. Tulet (LACy / CNRM)
-!! X. Pialat (SPE)
+! X. Pialat (SPE)
+! J.B.Filippi (SPE)
! Creation : 09.10.2010
!-------------------------------------------------------------------------------
!
diff --git a/src/LIB/RAD/ecrad-1.4.0.tar.gz b/src/LIB/RAD/ecrad-1.4.0.tar.gz
index 23aca40b30fbe71caff28e98f33314d2d78f1be5..eae88b18d9ad03c8e6533edde21405ca414e3c1c 100644
--- a/src/LIB/RAD/ecrad-1.4.0.tar.gz
+++ b/src/LIB/RAD/ecrad-1.4.0.tar.gz
@@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
-oid sha256:2fa92987214bde44613d682de4440caf766dc00b6cc04a3903afb62588e3ca0a
-size 8968642
+oid sha256:a3e35da607a7b4f5c4925bfb6bbc5bbeac37e2489f5d4b9cd079f4eb7137b3b2
+size 8930299
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/data/YBUR_ice_scattering_rrtm.nc b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YBUR_ice_scattering_rrtm.nc
new file mode 100644
index 0000000000000000000000000000000000000000..cfcaf7ff2ecada6346d89231a840851ffa998bc8
Binary files /dev/null and b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YBUR_ice_scattering_rrtm.nc differ
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/data/YCOL_ice_scattering_rrtm.nc b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YCOL_ice_scattering_rrtm.nc
new file mode 100644
index 0000000000000000000000000000000000000000..b51cdc499d6352c8d79a690fce41bef49eb95706
Binary files /dev/null and b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YCOL_ice_scattering_rrtm.nc differ
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/data/YDRO_ice_scattering_rrtm.nc b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YDRO_ice_scattering_rrtm.nc
new file mode 100644
index 0000000000000000000000000000000000000000..f6412d1704477f6d1fe5cfda9d8068ec59c7f394
Binary files /dev/null and b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YDRO_ice_scattering_rrtm.nc differ
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/data/YHBU_ice_scattering_rrtm.nc b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YHBU_ice_scattering_rrtm.nc
new file mode 100644
index 0000000000000000000000000000000000000000..127f166ddd6073d17afeb31ec962628965571cd1
Binary files /dev/null and b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YHBU_ice_scattering_rrtm.nc differ
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/data/YHCO_ice_scattering_rrtm.nc b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YHCO_ice_scattering_rrtm.nc
new file mode 100644
index 0000000000000000000000000000000000000000..3b3ad6fef7c98f08bc9d2811d298c2dc0bc1911b
Binary files /dev/null and b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YHCO_ice_scattering_rrtm.nc differ
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/data/YPLA_ice_scattering_rrtm.nc b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YPLA_ice_scattering_rrtm.nc
new file mode 100644
index 0000000000000000000000000000000000000000..92baaf1e9b331dfc351a01b1841f2bd813bd07d3
Binary files /dev/null and b/src/LIB/RAD/ecrad-1.4.0_mnh/data/YPLA_ice_scattering_rrtm.nc differ
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/ice_effective_radius.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/ice_effective_radius.F90
index bf49064711ac14753db719592bfd774e9a13b063..6e1958014c0a6c8a9016088321eef4cb45c3c91b 100644
--- a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/ice_effective_radius.F90
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/ice_effective_radius.F90
@@ -5,8 +5,8 @@ INTERFACE
SUBROUTINE ICE_EFFECTIVE_RADIUS &
& (KIDIA, KFDIA, KLON, KLEV, &
- & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
- & PRE_UM)
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PCIT_LIMA, &
+ & PGEMU, PRE_UM)
USE PARKIND1 , ONLY : JPIM, JPRB
! INPUT ARGUMENTS
@@ -24,6 +24,7 @@ REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV) ! (kg/kg)
REAL(KIND=JPRB), INTENT(IN) :: PQ_ICE(KLON,KLEV) ! (kg/kg)
REAL(KIND=JPRB), INTENT(IN) :: PQ_SNOW(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PCIT_LIMA(KLON,KLEV) ! (/kg)
! *** Single level variable
REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON) ! Sine of latitude
@@ -37,8 +38,8 @@ END MODULE MODI_ICE_EFFECTIVE_RADIUS
SUBROUTINE ICE_EFFECTIVE_RADIUS &
& (KIDIA, KFDIA, KLON, KLEV, &
- & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
- & PRE_UM)
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PCIT_LIMA, &
+ & PGEMU, PRE_UM)
! ICE_EFFECTIVE_RADIUS
!
@@ -76,7 +77,8 @@ USE YOERDU , ONLY : REPLOG, REPSCW
USE YOMLUN , ONLY : NULERR
USE YOMCST , ONLY : RD, RPI, RTT
USE MODD_PARAM_ECRAD_n , ONLY : NRADIP, NMINICE, XRE2DE, XRMINICE ! ice optical properties model
-
+USE MODD_PARAM_LIMA , ONLY : XALPHAI,XNUI ! Ice crystals distribution parameters
+USE MODD_PARAM_LIMA_COLD , ONLY : XDELTAI,XBI,XREFFI,XLBI,XLBEXI ! Ice crystals distribution parameters
! -------------------------------------------------------------------
IMPLICIT NONE
@@ -96,6 +98,8 @@ REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV) ! (kg/kg)
REAL(KIND=JPRB), INTENT(IN) :: PQ_ICE(KLON,KLEV) ! (kg/kg)
REAL(KIND=JPRB), INTENT(IN) :: PQ_SNOW(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PCIT_LIMA(KLON,KLEV) ! (/kg)
+
! *** Single level variable
REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON) ! Sine of latitude
@@ -116,6 +120,8 @@ REAL(KIND=JPRB) :: ZDIAMETER_UM ! Effective diameter in microns
! Min effective diameter in microns; may vary with latitude
REAL(KIND=JPRB) :: ZMIN_DIAMETER_UM(KLON)
+REAL(KIND=JPRB) :: ZLBDAI(KLON,KLEV) ! (/kg)
+
INTEGER :: JL, JK
@@ -199,7 +205,18 @@ CASE(3)
ENDIF
ENDDO
ENDDO
-
+
+CASE(4)
+ !!!! Ice effective radius from Yang et al (2013) reff = V/A
+ ! Distribution parameters for ice and snow
+ DO JK = 1,KLEV
+ DO JL = KIDIA,KFDIA
+ IF (PCLOUD_FRAC(JL,JK) > 0.001_JPRB &
+ & .AND. (PQ_ICE(JL,JK)+PQ_SNOW(JL,JK)) > 0.0_JPRB) THEN
+ PRE_UM(JL,JK) = XREFFI*( XLBI*PCIT_LIMA(JL,JK) / PQ_ICE(JL,JK) )**(XLBEXI*(XDELTAI-XBI))
+ ENDIF
+ ENDDO
+ ENDDO
CASE DEFAULT
WRITE(NULERR,'(A,I0,A)') 'ICE EFFECTIVE RADIUS OPTION NRADLP=',NRADIP,' NOT AVAILABLE'
CALL ABOR1('ERROR IN ICE_EFFECTIVE_RADIUS')
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/liquid_effective_radius.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/liquid_effective_radius.F90
index 0478665d5bf3087112cb96987c4fead9674004b6..d3e1a888fe7fda8fc06a9133f4e7745339cfff11 100644
--- a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/liquid_effective_radius.F90
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/liquid_effective_radius.F90
@@ -5,6 +5,7 @@ INTERFACE
SUBROUTINE LIQUID_EFFECTIVE_RADIUS &
& (KIDIA, KFDIA, KLON, KLEV, &
& PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQ, PQ_RAIN, &
+ & PCCT_LIMA, PCRT_LIMA, &
& PLAND_FRAC, PCCN_LAND, PCCN_SEA, &
& PRE_UM)
@@ -27,6 +28,9 @@ REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV)
REAL(KIND=JPRB), INTENT(IN) :: PQ_LIQ(KLON,KLEV) ! (kg/kg)
REAL(KIND=JPRB), INTENT(IN) :: PQ_RAIN(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT (IN) :: PCCT_LIMA(KLON,KLEV) ! cloud water concentration (LIMA)
+REAL(KIND=JPRB), INTENT (IN) :: PCRT_LIMA(KLON,KLEV) ! rain water concentration (LIMA)
+
! *** Single-level variables
REAL(KIND=JPRB), INTENT(IN) :: PLAND_FRAC(KLON) ! 1=land, 0=sea
REAL(KIND=JPRB), INTENT(IN) :: PCCN_LAND(KLON)
@@ -44,6 +48,7 @@ END MODULE MODI_LIQUID_EFFECTIVE_RADIUS
SUBROUTINE LIQUID_EFFECTIVE_RADIUS &
& (KIDIA, KFDIA, KLON, KLEV, &
& PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQ, PQ_RAIN, &
+ & PCCT_LIMA, PCRT_LIMA, &
& PLAND_FRAC, PCCN_LAND, PCCN_SEA, &
& PRE_UM)
@@ -84,6 +89,8 @@ USE YOM_YGFL , ONLY : YGFL
USE YOERDU , ONLY : REPLOG, REPSCW
USE YOMLUN , ONLY : NULERR
USE YOMCST , ONLY : RD, RPI
+USE MODD_PARAM_LIMA , ONLY : XALPHAR,XNUR, & ! Raindrop distribution parameters
+ & XALPHAC,XNUC ! Cloud droplet distribution parameters
! -------------------------------------------------------------------
@@ -104,6 +111,9 @@ REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV)
REAL(KIND=JPRB), INTENT(IN) :: PQ_LIQ(KLON,KLEV) ! (kg/kg)
REAL(KIND=JPRB), INTENT(IN) :: PQ_RAIN(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT (IN) :: PCCT_LIMA(KLON,KLEV) ! cloud water concentration (LIMA)
+REAL(KIND=JPRB), INTENT (IN) :: PCRT_LIMA(KLON,KLEV) ! rain water concentration (LIMA)
+
! *** Single-level variables
REAL(KIND=JPRB), INTENT(IN) :: PLAND_FRAC(KLON) ! 1=land, 0=sea
REAL(KIND=JPRB), INTENT(IN) :: PCCN_LAND(KLON)
@@ -129,6 +139,7 @@ REAL(KIND=JPRB) :: ZSPECTRAL_DISPERSION
REAL(KIND=JPRB) :: ZNTOT_CM3 ! Number conc in cm-3
REAL(KIND=JPRB) :: ZRE_CUBED
REAL(KIND=JPRB) :: ZLWC_GM3, ZRWC_GM3 ! In-cloud liquid, rain content in g m-3
+REAL(KIND=JPRB) :: PCCT_CM3 ! Droplet concentration(from lima) in cm-3
REAL(KIND=JPRB) :: ZAIR_DENSITY_GM3 ! Air density in g m-3
REAL(KIND=JPRB) :: ZRAIN_RATIO ! Ratio of rain to liquid water content
REAL(KIND=JPRB) :: ZWOOD_FACTOR, ZRATIO
@@ -242,12 +253,53 @@ CASE(2)
! Cloud fraction or liquid+rain water content too low to
! consider this a cloud
PRE_UM(JL,JK) = PP_MIN_RE_UM
+
ENDIF
ENDDO
ENDDO
+
+CASE(4)
+
+ ! Calculates effective radius from LIMA
+ DO JL = KIDIA,KFDIA
+ ! First compute the cloud droplet concentration
+
+ DO JK = 1,KLEV
+
+ ! Only consider cloudy regions
+ IF (PCLOUD_FRAC(JL,JK) >= 0.001_JPRB &
+ & .AND. (PQ_LIQ(JL,JK)+PQ_RAIN(JL,JK)) > 0.0_JPRB) THEN
+
+ ! Compute liquid and rain water contents
+ ZAIR_DENSITY_GM3 = 1000.0_JPRB * PPRESSURE(JL,JK) &
+ & / (RD*PTEMPERATURE(JL,JK))
+ ! In-cloud mean water contents found by dividing by cloud
+ ! fraction
+ PCCT_CM3 = PCCT_LIMA (JL, JK) * ZAIR_DENSITY_GM3 * 1.E-9_JPRB
+ ZLWC_GM3 = ZAIR_DENSITY_GM3 * PQ_LIQ(JL,JK) / PCLOUD_FRAC(JL,JK)
+ PRE_UM(JL,JK)=100*(4.*ZLWC_GM3*(XNUC+2)**2/(PCCT_CM3*3.*RPI*(XNUC**2+XNUC)))**(1./3.)
+! print*,"r_eff=",PRE_UM(JL,JK)
+ if (PRE_UM(JL,JK)>50) then
+ PRE_UM(JL,JK)=50.
+ else if (PRE_UM(JL,JK)<1.) then
+ PRE_UM(JL,JK)=1.
+ end if
+
+
+ ELSE
+ ! Cloud fraction or liquid+rain water content too low to
+ ! consider this a cloud
+ PRE_UM(JL,JK) = 1.
+
+ ENDIF
+
+ ENDDO
+
+ ENDDO
+
CASE DEFAULT
WRITE(NULERR,'(A,I0,A)') 'LIQUID EFFECTIVE RADIUS OPTION IRADLP=',IRADLP,' NOT AVAILABLE'
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_scheme.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_scheme.F90
index 06cd9e27126ab46ca69f02066a47b3e6115af03b..270f990cf654f92e7abcd219722adde361ec7649 100644
--- a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_scheme.F90
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_scheme.F90
@@ -25,6 +25,7 @@ SUBROUTINE RADIATION_SCHEME &
& PPRESSURE_H, PTEMPERATURE_H, &
& PQ, PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, PCCL4, PO3_DP, &
& PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_RAIN, PQ_SNOW, &
+ & PCCT_LIMA, PCRT_LIMA, PCIT_LIMA, &
& PAEROSOL_OLD, PAEROSOL, &
& PFLUX_SW, PFLUX_LW, PFLUX_SW_CLEAR, PFLUX_LW_CLEAR, &
& PFLUX_SW_SURF, PFLUX_LW_SURF, PFLUX_SW_SURF_CLEAR, PFLUX_LW_SURF_CLEAR, &
@@ -186,6 +187,11 @@ REAL(KIND=JPRB), INTENT(IN) :: PQ_LIQUID(KLON,KLEV)
REAL(KIND=JPRB), INTENT(IN) :: PQ_ICE(KLON,KLEV)
REAL(KIND=JPRB), INTENT(IN) :: PQ_RAIN(KLON,KLEV)
REAL(KIND=JPRB), INTENT(IN) :: PQ_SNOW(KLON,KLEV)
+! *** Particle concentrations
+REAL(KIND=JPRB), INTENT (IN) :: PCCT_LIMA(KLON,KLEV) ! cloud water concentration (LIMA)
+REAL(KIND=JPRB), INTENT (IN) :: PCRT_LIMA(KLON,KLEV) ! rain water concentration (LIMA)
+REAL(KIND=JPRB), INTENT (IN) :: PCIT_LIMA(KLON,KLEV) ! ice crystal concentration (LIMA)
+
! *** Aerosol mass mixing ratios
REAL(KIND=JPRB), INTENT(IN) :: PAEROSOL_OLD(KLON,6,KLEV)
@@ -436,13 +442,14 @@ cloud%fraction(KIDIA:KFDIA,:) = PCLOUD_FRAC(KIDIA:KFDIA,:)
! Compute effective radii and convert to metres
CALL LIQUID_EFFECTIVE_RADIUS(KIDIA, KFDIA, KLON, KLEV, &
& PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQUID, PQ_RAIN, &
+ & PCCT_LIMA, PCRT_LIMA, &
& PLAND_SEA_MASK, PCCN_LAND, PCCN_SEA, &
& PRE_LIQUID_UM)
cloud%re_liq(KIDIA:KFDIA,:) = PRE_LIQUID_UM(KIDIA:KFDIA,:) * 1.0e-6_JPRB
CALL ICE_EFFECTIVE_RADIUS(KIDIA, KFDIA, KLON, KLEV, &
- & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
- & PRE_ICE_UM)
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PCIT_LIMA, &
+ & PGEMU, PRE_ICE_UM)
cloud%re_ice(KIDIA:KFDIA,:) = PRE_ICE_UM(KIDIA:KFDIA,:) * 1.0e-6_JPRB
! Get the cloud overlap decorrelation length (for cloud boundaries),
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_setup.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_setup.F90
index 0677d3f94c66fd2ab89ac6efee68a4e993669f38..69d2d44fc5601fa4672b0192a98d00c428d52483 100644
--- a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_setup.F90
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_setup.F90
@@ -40,7 +40,7 @@ MODULE RADIATION_SETUP
USE radiation_config, ONLY : config_type, &
& ISolverMcICA, ISolverSpartacus, &
& ILiquidModelSlingo, ILiquidModelSOCRATES, &
- & IIceModelFu, IIceModelBaran, &
+ & IIceModelFu, IIceModelBaran, IIceModelShapes, &
& IOverlapExponential
USE MODD_PARAM_ECRAD_n , ONLY : rad_config
@@ -161,6 +161,8 @@ CONTAINS
rad_config%i_ice_model = IIceModelFu
ELSEIF (NICEOPT == 4) THEN
rad_config%i_ice_model = IIceModelBaran
+ ELSEIF (NICEOPT == 7) THEN
+ rad_config%i_ice_model = IIceModelShapes
ELSE
WRITE(NULERR,'(a,i0)') 'Unavailable ice optics model in modular radiation scheme: NICEOPT=', &
& NICEOPT
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_cloud_optics.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_cloud_optics.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f636fd604bac0b890f3dbaa2916c6a88b56b7cd4
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_cloud_optics.F90
@@ -0,0 +1,526 @@
+! radiation_cloud_optics.F90 - Computing cloud optical properties
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author: Robin Hogan
+! Email: r.j.hogan@ecmwf.int
+!
+! Modifications
+! 2017-07-22 R. Hogan Added Yi et al. ice optics model
+
+module radiation_cloud_optics
+
+ implicit none
+
+ public
+
+contains
+
+ ! Provides elemental function "delta_eddington_scat_od"
+#include "radiation_delta_eddington.h"
+
+ !---------------------------------------------------------------------
+ ! Load cloud scattering data; this subroutine delegates to one
+ ! in radiation_cloud_optics_data.F90, but checks the size of
+ ! what is returned
+ subroutine setup_cloud_optics(config)
+
+ use parkind1, only : jprb
+ use yomhook, only : lhook, dr_hook
+
+ use radiation_io, only : nulerr, radiation_abort
+ use radiation_config, only : config_type, IIceModelFu, IIceModelBaran, &
+ & IIceModelBaran2016, IIceModelBaran2017, &
+ & IIceModelYi,IIceModelShapes, &
+ & ILiquidModelSOCRATES, ILiquidModelSlingo
+ use radiation_cloud_optics_data, only : cloud_optics_type
+ use radiation_ice_optics_fu, only : NIceOpticsCoeffsFuSW, &
+ & NIceOpticsCoeffsFuLW
+ use radiation_ice_optics_baran, only : NIceOpticsCoeffsBaran, &
+ & NIceOpticsCoeffsBaran2016
+ use radiation_ice_optics_baran2017, only : NIceOpticsCoeffsBaran2017, &
+ & NIceOpticsGeneralCoeffsBaran2017
+ use radiation_ice_optics_yi, only : NIceOpticsCoeffsYiSW, &
+ & NIceOpticsCoeffsYiLW
+ use radiation_ice_optics_shapes, only : NIceOpticsCoeffsShapesSW, &
+ & NIceOpticsCoeffsShapesLW
+ use radiation_liquid_optics_socrates, only : NLiqOpticsCoeffsSOCRATES
+ use radiation_liquid_optics_slingo, only : NLiqOpticsCoeffsSlingoSW, &
+ & NLiqOpticsCoeffsLindnerLiLW
+
+ type(config_type), intent(inout) :: config
+
+ real(jprb) :: hook_handle
+
+ if (lhook) call dr_hook('radiation_cloud_optics:setup_cloud_optics',0,hook_handle)
+
+ call config%cloud_optics%setup(trim(config%liq_optics_file_name), &
+ & trim(config%ice_optics_file_name), iverbose=config%iverbosesetup)
+
+ ! Check liquid coefficients
+ if (size(config%cloud_optics%liq_coeff_lw, 1) /= config%n_bands_lw) then
+ write(nulerr,'(a,i0,a,i0,a)') &
+ & '*** Error: number of longwave bands for droplets (', &
+ & size(config%cloud_optics%liq_coeff_lw, 1), &
+ & ') does not match number for gases (', config%n_bands_lw, ')'
+ call radiation_abort()
+ end if
+ if (size(config%cloud_optics%liq_coeff_sw, 1) /= config%n_bands_sw) then
+ write(nulerr,'(a,i0,a,i0,a)') &
+ & '*** Error: number of shortwave bands for droplets (', &
+ & size(config%cloud_optics%liq_coeff_sw, 1), &
+ & ') does not match number for gases (', config%n_bands_sw, ')'
+ call radiation_abort()
+ end if
+
+ if (config%i_liq_model == ILiquidModelSOCRATES) then
+ if (size(config%cloud_optics%liq_coeff_lw, 2) /= NLiqOpticsCoeffsSOCRATES) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of liquid cloud optical coefficients (', &
+ & size(config%cloud_optics%liq_coeff_lw, 2), &
+ & ') does not match number expected (', NLiqOpticsCoeffsSOCRATES,')'
+ call radiation_abort()
+ end if
+ else if (config%i_liq_model == ILiquidModelSlingo) then
+ if (size(config%cloud_optics%liq_coeff_sw, 2) /= NLiqOpticsCoeffsSlingoSW) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of shortwave liquid cloud optical coefficients (', &
+ & size(config%cloud_optics%liq_coeff_sw, 2), &
+ & ') does not match number expected (', NLiqOpticsCoeffsSlingoSW,')'
+ call radiation_abort()
+ end if
+ if (size(config%cloud_optics%liq_coeff_lw, 2) /= NLiqOpticsCoeffsLindnerLiLW) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of longwave liquid cloud optical coefficients (', &
+ & size(config%cloud_optics%liq_coeff_lw, 2), &
+ & ') does not match number expected (', NLiqOpticsCoeffsLindnerLiLw,')'
+ call radiation_abort()
+ end if
+ end if
+
+ ! Check ice coefficients
+ if (size(config%cloud_optics%ice_coeff_lw, 1) /= config%n_bands_lw) then
+ write(nulerr,'(a,i0,a,i0,a)') &
+ & '*** Error: number of longwave bands for ice particles (', &
+ & size(config%cloud_optics%ice_coeff_lw, 1), &
+ & ') does not match number for gases (', config%n_bands_lw, ')'
+ call radiation_abort()
+ end if
+ if (size(config%cloud_optics%ice_coeff_sw, 1) /= config%n_bands_sw) then
+ write(nulerr,'(a,i0,a,i0,a)') &
+ & '*** Error: number of shortwave bands for ice particles (', &
+ & size(config%cloud_optics%ice_coeff_sw, 1), &
+ & ') does not match number for gases (', config%n_bands_sw, ')'
+ call radiation_abort()
+ end if
+
+ if (config%i_ice_model == IIceModelFu) then
+ if (size(config%cloud_optics%ice_coeff_lw, 2) &
+ & /= NIceOpticsCoeffsFuLW) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of LW ice-particle optical coefficients (', &
+ & size(config%cloud_optics%ice_coeff_lw, 2), &
+ & ') does not match number expected (', NIceOpticsCoeffsFuLW,')'
+ call radiation_abort()
+ end if
+ if (size(config%cloud_optics%ice_coeff_sw, 2) &
+ & /= NIceOpticsCoeffsFuSW) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of SW ice-particle optical coefficients (', &
+ & size(config%cloud_optics%ice_coeff_sw, 2), &
+ & ') does not match number expected (', NIceOpticsCoeffsFuSW,')'
+ call radiation_abort()
+ end if
+ else if (config%i_ice_model == IIceModelBaran &
+ & .and. size(config%cloud_optics%ice_coeff_lw, 2) &
+ & /= NIceOpticsCoeffsBaran) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of ice-particle optical coefficients (', &
+ & size(config%cloud_optics%ice_coeff_lw, 2), &
+ & ') does not match number expected (', NIceOpticsCoeffsBaran,')'
+ call radiation_abort()
+ else if (config%i_ice_model == IIceModelBaran2016 &
+ & .and. size(config%cloud_optics%ice_coeff_lw, 2) &
+ & /= NIceOpticsCoeffsBaran2016) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of ice-particle optical coefficients (', &
+ & size(config%cloud_optics%ice_coeff_lw, 2), &
+ & ') does not match number expected (', NIceOpticsCoeffsBaran2016,')'
+ call radiation_abort()
+ else if (config%i_ice_model == IIceModelBaran2017) then
+ if (size(config%cloud_optics%ice_coeff_lw, 2) &
+ & /= NIceOpticsCoeffsBaran2017) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of ice-particle optical coefficients (', &
+ & size(config%cloud_optics%ice_coeff_lw, 2), &
+ & ') does not match number expected (', NIceOpticsCoeffsBaran2017,')'
+ call radiation_abort()
+ else if (.not. allocated(config%cloud_optics%ice_coeff_gen)) then
+ write(nulerr,'(a)') &
+ & '*** Error: coeff_gen needed for Baran-2017 ice optics parameterization'
+ call radiation_abort()
+ else if (size(config%cloud_optics%ice_coeff_gen) &
+ & /= NIceOpticsGeneralCoeffsBaran2017) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of general ice-particle optical coefficients (', &
+ & size(config%cloud_optics%ice_coeff_gen), &
+ & ') does not match number expected (', NIceOpticsGeneralCoeffsBaran2017,')'
+ call radiation_abort()
+ end if
+ else if (config%i_ice_model == IIceModelYi) then
+ if (size(config%cloud_optics%ice_coeff_lw, 2) &
+ & /= NIceOpticsCoeffsYiLW) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of LW ice-particle optical coefficients (', &
+ & size(config%cloud_optics%ice_coeff_lw, 2), &
+ & ') does not match number expected (', NIceOpticsCoeffsYiLW,')'
+ call radiation_abort()
+ end if
+ if (size(config%cloud_optics%ice_coeff_sw, 2) &
+ & /= NIceOpticsCoeffsYiSW) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of SW ice-particle optical coefficients (', &
+ & size(config%cloud_optics%ice_coeff_sw, 2), &
+ & ') does not match number expected (', NIceOpticsCoeffsYiSW,')'
+ call radiation_abort()
+ end if
+ else if (config%i_ice_model == IIceModelShapes) then
+ if (size(config%cloud_optics%ice_coeff_lw, 2) &
+ & /= NIceOpticsCoeffsShapesLW) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of LW ice-particle optical coefficients (', &
+ & size(config%cloud_optics%ice_coeff_lw, 2), &
+ & ') does not match number expected (', NIceOpticsCoeffsShapesLW,')'
+ call radiation_abort()
+ end if
+ if (size(config%cloud_optics%ice_coeff_sw, 2) &
+ & /= NIceOpticsCoeffsShapesSW) then
+ write(nulerr,'(a,i0,a,i0,a,i0,a)') &
+ & '*** Error: number of SW ice-particle optical coefficients (', &
+ & size(config%cloud_optics%ice_coeff_sw, 2), &
+ & ') does not match number expected (', NIceOpticsCoeffsShapesSW,')'
+ call radiation_abort()
+ end if
+ end if
+
+ if (lhook) call dr_hook('radiation_cloud_optics:setup_cloud_optics',1,hook_handle)
+
+ end subroutine setup_cloud_optics
+
+
+ !---------------------------------------------------------------------
+ ! Compute cloud optical properties
+ subroutine cloud_optics(nlev,istartcol,iendcol, &
+ & config, thermodynamics, cloud, &
+ & od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
+ & od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
+
+ use parkind1, only : jprb
+ use yomhook, only : lhook, dr_hook
+
+ use radiation_io, only : nulout, nulerr, radiation_abort
+ use radiation_config, only : config_type, IIceModelFu, IIceModelBaran, &
+ & IIceModelBaran2016, IIceModelBaran2017, &
+ & IIceModelYi,IIceModelShapes, &
+ & ILiquidModelSOCRATES, ILiquidModelSlingo
+ use radiation_thermodynamics, only : thermodynamics_type
+ use radiation_cloud, only : cloud_type
+ use radiation_constants, only : AccelDueToGravity
+ use radiation_cloud_optics_data, only : cloud_optics_type
+ use radiation_ice_optics_fu, only : calc_ice_optics_fu_sw, &
+ & calc_ice_optics_fu_lw
+ use radiation_ice_optics_baran, only : calc_ice_optics_baran, &
+ & calc_ice_optics_baran2016
+ use radiation_ice_optics_baran2017, only : calc_ice_optics_baran2017
+ use radiation_ice_optics_yi, only : calc_ice_optics_yi_sw, &
+ & calc_ice_optics_yi_lw
+ use radiation_ice_optics_shapes, only : calc_ice_optics_shapes_sw, &
+ & calc_ice_optics_shapes_lw
+ use radiation_liquid_optics_socrates, only:calc_liq_optics_socrates
+ use radiation_liquid_optics_slingo, only:calc_liq_optics_slingo, &
+ & calc_liq_optics_lindner_li
+
+ integer, intent(in) :: nlev ! number of model levels
+ integer, intent(in) :: istartcol, iendcol ! range of columns to process
+ type(config_type), intent(in), target :: config
+ type(thermodynamics_type),intent(in) :: thermodynamics
+ type(cloud_type), intent(in) :: cloud
+
+ ! Layer optical depth, single scattering albedo and g factor of
+ ! clouds in each longwave band, where the latter two
+ ! variables are only defined if cloud longwave scattering is
+ ! enabled (otherwise both are treated as zero).
+ real(jprb), dimension(config%n_bands_lw,nlev,istartcol:iendcol), intent(out) :: &
+ & od_lw_cloud
+ real(jprb), dimension(config%n_bands_lw_if_scattering,nlev,istartcol:iendcol), &
+ & intent(out) :: ssa_lw_cloud, g_lw_cloud
+
+ ! Layer optical depth, single scattering albedo and g factor of
+ ! clouds in each shortwave band
+ real(jprb), dimension(config%n_bands_sw,nlev,istartcol:iendcol), intent(out) :: &
+ & od_sw_cloud, ssa_sw_cloud, g_sw_cloud
+
+ ! Longwave and shortwave optical depth, scattering optical depth
+ ! and asymmetry factor, for liquid and ice in all bands but a
+ ! single cloud layer
+ real(jprb), dimension(config%n_bands_lw) :: &
+ & od_lw_liq, scat_od_lw_liq, g_lw_liq, &
+ & od_lw_ice, scat_od_lw_ice, g_lw_ice
+ real(jprb), dimension(config%n_bands_sw) :: &
+ & od_sw_liq, scat_od_sw_liq, g_sw_liq, &
+ & od_sw_ice, scat_od_sw_ice, g_sw_ice
+
+ ! In-cloud water path of cloud liquid or ice (i.e. liquid or ice
+ ! gridbox-mean water path divided by cloud fraction); kg m-2
+ real(jprb) :: lwp_in_cloud, iwp_in_cloud
+
+ ! Full-level temperature (K)
+ real(jprb) :: temperature
+
+ ! Factor to convert gridbox-mean mixing ratio to in-cloud water
+ ! path
+ real(jprb) :: factor
+
+ ! Pointer to the cloud optics coefficients for brevity of
+ ! access
+ type(cloud_optics_type), pointer :: ho
+
+ integer :: jcol, jlev
+
+ real(jprb) :: hook_handle
+
+ if (lhook) call dr_hook('radiation_cloud_optics:cloud_optics',0,hook_handle)
+
+ if (config%iverbose >= 2) then
+ write(nulout,'(a)') 'Computing cloud absorption/scattering properties'
+ end if
+
+ ho => config%cloud_optics
+
+ ! Array-wise assignment
+ od_lw_cloud = 0.0_jprb
+ od_sw_cloud = 0.0_jprb
+ ssa_sw_cloud = 0.0_jprb
+ g_sw_cloud = 0.0_jprb
+ if (config%do_lw_cloud_scattering) then
+ ssa_lw_cloud = 0.0_jprb
+ g_lw_cloud = 0.0_jprb
+ end if
+
+ do jlev = 1,nlev
+ do jcol = istartcol,iendcol
+ ! Only do anything if cloud is present (assume that
+ ! cloud%crop_cloud_fraction has already been called)
+ if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
+
+ ! Compute in-cloud liquid and ice water path
+ if (config%is_homogeneous) then
+ ! Homogeneous solvers assume cloud fills the box
+ ! horizontally, so we don't divide by cloud fraction
+ factor = ( thermodynamics%pressure_hl(jcol,jlev+1) &
+ & -thermodynamics%pressure_hl(jcol,jlev ) ) &
+ & / AccelDueToGravity
+ else
+ factor = ( thermodynamics%pressure_hl(jcol,jlev+1) &
+ & -thermodynamics%pressure_hl(jcol,jlev ) ) &
+ & / (AccelDueToGravity * cloud%fraction(jcol,jlev))
+ end if
+ lwp_in_cloud = factor * cloud%q_liq(jcol,jlev)
+ iwp_in_cloud = factor * cloud%q_ice(jcol,jlev)
+
+ ! Only compute liquid properties if liquid cloud is
+ ! present
+ if (lwp_in_cloud > 0.0_jprb) then
+ if (config%i_liq_model == ILiquidModelSOCRATES) then
+ ! Compute longwave properties
+ call calc_liq_optics_socrates(config%n_bands_lw, &
+ & config%cloud_optics%liq_coeff_lw, &
+ & lwp_in_cloud, cloud%re_liq(jcol,jlev), &
+ & od_lw_liq, scat_od_lw_liq, g_lw_liq)
+ ! Compute shortwave properties
+ call calc_liq_optics_socrates(config%n_bands_sw, &
+ & config%cloud_optics%liq_coeff_sw, &
+ & lwp_in_cloud, cloud%re_liq(jcol,jlev), &
+ & od_sw_liq, scat_od_sw_liq, g_sw_liq)
+ else if (config%i_liq_model == ILiquidModelSlingo) then
+ ! Compute longwave properties
+ call calc_liq_optics_lindner_li(config%n_bands_lw, &
+ & config%cloud_optics%liq_coeff_lw, &
+ & lwp_in_cloud, cloud%re_liq(jcol,jlev), &
+ & od_lw_liq, scat_od_lw_liq, g_lw_liq)
+ ! Compute shortwave properties
+ call calc_liq_optics_slingo(config%n_bands_sw, &
+ & config%cloud_optics%liq_coeff_sw, &
+ & lwp_in_cloud, cloud%re_liq(jcol,jlev), &
+ & od_sw_liq, scat_od_sw_liq, g_sw_liq)
+ else
+ write(nulerr,*) '*** Error: Unknown liquid model with code', &
+ & config%i_liq_model
+ call radiation_abort()
+ end if
+
+ ! Delta-Eddington scaling in the shortwave only
+ if (.not. config%do_sw_delta_scaling_with_gases) then
+ call delta_eddington_scat_od(od_sw_liq, scat_od_sw_liq, g_sw_liq)
+ end if
+ !call delta_eddington_scat_od(od_lw_liq, scat_od_lw_liq, g_lw_liq)
+
+ else
+ ! Liquid not present: set properties to zero
+ od_lw_liq = 0.0_jprb
+ scat_od_lw_liq = 0.0_jprb
+ g_lw_liq = 0.0_jprb
+
+ od_sw_liq = 0.0_jprb
+ scat_od_sw_liq = 0.0_jprb
+ g_sw_liq = 0.0_jprb
+ end if ! Liquid present
+
+ ! Only compute ice properties if ice cloud is present
+ if (iwp_in_cloud > 0.0_jprb) then
+ if (config%i_ice_model == IIceModelBaran) then
+ ! Compute longwave properties
+ call calc_ice_optics_baran(config%n_bands_lw, &
+ & config%cloud_optics%ice_coeff_lw, &
+ & iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+ & od_lw_ice, scat_od_lw_ice, g_lw_ice)
+ ! Compute shortwave properties
+ call calc_ice_optics_baran(config%n_bands_sw, &
+ & config%cloud_optics%ice_coeff_sw, &
+ & iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+ & od_sw_ice, scat_od_sw_ice, g_sw_ice)
+ else if (config%i_ice_model == IIceModelBaran2016) then
+ temperature = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev) &
+ & +thermodynamics%temperature_hl(jcol,jlev+1))
+ ! Compute longwave properties
+ call calc_ice_optics_baran2016(config%n_bands_lw, &
+ & config%cloud_optics%ice_coeff_lw, &
+ & iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+ & temperature, &
+ & od_lw_ice, scat_od_lw_ice, g_lw_ice)
+ ! Compute shortwave properties
+ call calc_ice_optics_baran2016(config%n_bands_sw, &
+ & config%cloud_optics%ice_coeff_sw, &
+ & iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+ & temperature, &
+ & od_sw_ice, scat_od_sw_ice, g_sw_ice)
+ else if (config%i_ice_model == IIceModelBaran2017) then
+ temperature = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev) &
+ & +thermodynamics%temperature_hl(jcol,jlev+1))
+ ! Compute longwave properties
+ call calc_ice_optics_baran2017(config%n_bands_lw, &
+ & config%cloud_optics%ice_coeff_gen, &
+ & config%cloud_optics%ice_coeff_lw, &
+ & iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+ & temperature, &
+ & od_lw_ice, scat_od_lw_ice, g_lw_ice)
+ ! Compute shortwave properties
+ call calc_ice_optics_baran2017(config%n_bands_sw, &
+ & config%cloud_optics%ice_coeff_gen, &
+ & config%cloud_optics%ice_coeff_sw, &
+ & iwp_in_cloud, cloud%q_ice(jcol,jlev), &
+ & temperature, &
+ & od_sw_ice, scat_od_sw_ice, g_sw_ice)
+ else if (config%i_ice_model == IIceModelFu) then
+ ! Compute longwave properties
+ call calc_ice_optics_fu_lw(config%n_bands_lw, &
+ & config%cloud_optics%ice_coeff_lw, &
+ & iwp_in_cloud, cloud%re_ice(jcol,jlev), &
+ & od_lw_ice, scat_od_lw_ice, g_lw_ice)
+ if (config%do_fu_lw_ice_optics_bug) then
+ ! Reproduce bug in old IFS scheme
+ scat_od_lw_ice = od_lw_ice - scat_od_lw_ice
+ end if
+ ! Compute shortwave properties
+ call calc_ice_optics_fu_sw(config%n_bands_sw, &
+ & config%cloud_optics%ice_coeff_sw, &
+ & iwp_in_cloud, cloud%re_ice(jcol,jlev), &
+ & od_sw_ice, scat_od_sw_ice, g_sw_ice)
+ else if (config%i_ice_model == IIceModelYi) then
+ ! Compute longwave properties
+ call calc_ice_optics_yi_lw(config%n_bands_lw, &
+ & config%cloud_optics%ice_coeff_lw, &
+ & iwp_in_cloud, cloud%re_ice(jcol,jlev), &
+ & od_lw_ice, scat_od_lw_ice, g_lw_ice)
+ ! Compute shortwave properties
+ call calc_ice_optics_yi_sw(config%n_bands_sw, &
+ & config%cloud_optics%ice_coeff_sw, &
+ & iwp_in_cloud, cloud%re_ice(jcol,jlev), &
+ & od_sw_ice, scat_od_sw_ice, g_sw_ice)
+ else if (config%i_ice_model == IIceModelShapes) then
+ ! Compute longwave properties
+ call calc_ice_optics_shapes_lw(config%n_bands_lw, &
+ & config%cloud_optics%ice_coeff_lw, &
+ & iwp_in_cloud, cloud%re_ice(jcol,jlev), &
+ & od_lw_ice, scat_od_lw_ice, g_lw_ice)
+ ! Compute shortwave properties
+ call calc_ice_optics_shapes_sw(config%n_bands_sw, &
+ & config%cloud_optics%ice_coeff_sw, &
+ & iwp_in_cloud, cloud%re_ice(jcol,jlev), &
+ & od_sw_ice, scat_od_sw_ice, g_sw_ice)
+ else
+ write(nulerr,*) '*** Error: Unknown ice model with code', &
+ & config%i_ice_model
+ call radiation_abort()
+ end if
+
+ ! Delta-Eddington scaling in both longwave and shortwave
+ ! (assume that particles are larger than wavelength even
+ ! in longwave)
+ if (.not. config%do_sw_delta_scaling_with_gases) then
+ call delta_eddington_scat_od(od_sw_ice, scat_od_sw_ice, g_sw_ice)
+ end if
+ call delta_eddington_scat_od(od_lw_ice, scat_od_lw_ice, g_lw_ice)
+
+ else
+ ! Ice not present: set properties to zero
+ od_lw_ice = 0.0_jprb
+ scat_od_lw_ice = 0.0_jprb
+ g_lw_ice = 0.0_jprb
+
+ od_sw_ice = 0.0_jprb
+ scat_od_sw_ice = 0.0_jprb
+ g_sw_ice = 0.0_jprb
+ end if ! Ice present
+
+ ! Combine liquid and ice
+ if (config%do_lw_cloud_scattering) then
+ od_lw_cloud(:,jlev,jcol) = od_lw_liq + od_lw_ice
+ where (scat_od_lw_liq+scat_od_lw_ice > 0.0_jprb)
+ g_lw_cloud(:,jlev,jcol) = (g_lw_liq * scat_od_lw_liq &
+ & + g_lw_ice * scat_od_lw_ice) &
+ & / (scat_od_lw_liq+scat_od_lw_ice)
+ elsewhere
+ g_lw_cloud(:,jlev,jcol) = 0.0_jprb
+ end where
+ ssa_lw_cloud(:,jlev,jcol) = (scat_od_lw_liq + scat_od_lw_ice) &
+ & / (od_lw_liq + od_lw_ice)
+ else
+ ! If longwave scattering is to be neglected then the
+ ! best approximation is to set the optical depth equal
+ ! to the absorption optical depth
+ od_lw_cloud(:,jlev,jcol) = od_lw_liq - scat_od_lw_liq &
+ & + od_lw_ice - scat_od_lw_ice
+ end if
+ od_sw_cloud(:,jlev,jcol) = od_sw_liq + od_sw_ice
+ g_sw_cloud(:,jlev,jcol) = (g_sw_liq * scat_od_sw_liq &
+ & + g_sw_ice * scat_od_sw_ice) &
+ & / (scat_od_sw_liq + scat_od_sw_ice)
+ ssa_sw_cloud(:,jlev,jcol) &
+ & = (scat_od_sw_liq + scat_od_sw_ice) / (od_sw_liq + od_sw_ice)
+ end if ! Cloud present
+ end do ! Loop over column
+ end do ! Loop over level
+
+ if (lhook) call dr_hook('radiation_cloud_optics:cloud_optics',1,hook_handle)
+
+ end subroutine cloud_optics
+
+end module radiation_cloud_optics
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_config.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_config.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0f641bb4012cc8cf73955dd206e029fbc9632970
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_config.F90
@@ -0,0 +1,1983 @@
+! radiation_config.F90 - Derived type to configure the radiation scheme
+!
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author: Robin Hogan
+! Email: r.j.hogan@ecmwf.int
+!
+! Modifications
+! 2017-07-22 R. Hogan Added Yi et al. ice optics model
+! 2017-10-23 R. Hogan Renamed single-character variables
+! 2018-03-15 R. Hogan Added logicals controlling surface spectral treatment
+! 2018-08-29 R. Hogan Added monochromatic single-scattering albedo / asymmetry factor
+! 2018-09-03 R. Hogan Added min_cloud_effective_size
+! 2018-09-04 R. Hogan Added encroachment_scaling
+! 2018-09-13 R. Hogan Added IEncroachmentFractal
+! 2019-01-02 R. Hogan Added Cloudless solvers
+! 2019-01-14 R. Hogan Added out_of_bounds_[1,2,3]d for checker routines
+! 2019-01-18 R. Hogan Added albedo weighting
+! 2019-02-03 R. Hogan Added ability to fix out-of-physical-bounds inputs
+! 2019-02-10 R. Hogan Renamed "encroachment" to "entrapment"
+!
+! Note: The aim is for ecRad in the IFS to be as similar as possible
+! to the offline version, so if you make any changes to this or any
+! files in this directory, please inform Robin Hogan.
+!
+
+module radiation_config
+ USE MODD_PARAM_LIMA, ONLY : CPRISTINE_ICE_LIMA
+ use parkind1, only : jprb
+
+ use radiation_cloud_optics_data, only : cloud_optics_type
+ use radiation_aerosol_optics_data, only : aerosol_optics_type
+ use radiation_pdf_sampler, only : pdf_sampler_type
+ use radiation_cloud_cover, only : OverlapName, &
+ & IOverlapMaximumRandom, IOverlapExponentialRandom, IOverlapExponential
+
+ implicit none
+ public
+
+ ! Configuration codes: use C-style enumerators to avoid having to
+ ! remember the numbers
+
+ ! Solvers: can be specified for longwave and shortwave
+ ! independently, except for "Homogeneous", which must be the same
+ ! for both
+ enum, bind(c)
+ enumerator ISolverCloudless, ISolverHomogeneous, ISolverMcICA, &
+ & ISolverSpartacus, ISolverTripleclouds
+ end enum
+ character(len=*), parameter :: SolverName(0:4) = (/ 'Cloudless ', &
+ & 'Homogeneous ', &
+ & 'McICA ', &
+ & 'SPARTACUS ', &
+ & 'Tripleclouds' /)
+
+ ! SPARTACUS shortwave solver can treat the reflection of radiation
+ ! back up into different regions in various ways
+ enum, bind(c)
+ enumerator &
+ & IEntrapmentZero, & ! No entrapment, as Tripleclouds
+ & IEntrapmentEdgeOnly, & ! Only radiation passed through cloud edge is horizontally homogenized
+ & IEntrapmentExplicit, & ! Estimate horiz migration dist, account for fractal clouds
+ & IEntrapmentExplicitNonFractal, & ! As above but ignore fractal nature of clouds
+ & IEntrapmentMaximum ! Complete horizontal homogenization within regions (old SPARTACUS assumption)
+ end enum
+
+ ! Names available in the radiation namelist for variable
+ ! sw_entrapment_name
+ character(len=*), parameter :: EntrapmentName(0:4) = [ 'Zero ', &
+ & 'Edge-only ', &
+ & 'Explicit ', &
+ & 'Non-fractal', &
+ & 'Maximum ' ]
+ ! For backwards compatibility, the radiation namelist also supports
+ ! the equivalent variable sw_encroachment_name with the following
+ ! names
+ character(len=*), parameter :: EncroachmentName(0:4) = [ 'Zero ', &
+ & 'Minimum ', &
+ & 'Fractal ', &
+ & 'Computed', &
+ & 'Maximum ' ]
+
+ ! Two-stream models
+ ! This is not configurable at run-time
+
+ ! Gas models
+ enum, bind(c)
+ enumerator IGasModelMonochromatic, IGasModelIFSRRTMG
+ end enum
+ character(len=*), parameter :: GasModelName(0:1) = (/ 'Monochromatic', &
+ & 'RRTMG-IFS ' /)
+
+ ! Hydrometeor scattering models
+ enum, bind(c)
+ enumerator ILiquidModelMonochromatic, &
+ & ILiquidModelSOCRATES, ILiquidModelSlingo
+ end enum
+ character(len=*), parameter :: LiquidModelName(0:2) = (/ 'Monochromatic', &
+ & 'SOCRATES ', &
+ & 'Slingo ' /)
+
+ enum, bind(c)
+ enumerator IIceModelMonochromatic, IIceModelFu, &
+ & IIceModelBaran, IIceModelBaran2016, IIceModelBaran2017, &
+ & IIceModelYi, IIceModelShapes
+ end enum
+ character(len=*), parameter :: IceModelName(0:6) = (/ 'Monochromatic', &
+ & 'Fu-IFS ', &
+ & 'Baran ', &
+ & 'Baran2016 ', &
+ & 'Baran2017 ', &
+ & 'Yi ', &
+ & 'Shapes ' /)
+
+ ! Cloud PDF distribution shapes
+ enum, bind(c)
+ enumerator IPdfShapeLognormal, IPdfShapeGamma
+ end enum
+ character(len=*), parameter :: PdfShapeName(0:1) = (/ 'Lognormal', &
+ & 'Gamma ' /)
+
+ ! Maximum number of different aerosol types that can be provided
+ integer, parameter :: NMaxAerosolTypes = 256
+
+ ! Maximum number of shortwave albedo and longwave emissivity
+ ! intervals
+ integer, parameter :: NMaxAlbedoIntervals = 256
+
+ ! Length of string buffer for printing config information
+ integer, parameter :: NPrintStringLen = 60
+
+ !---------------------------------------------------------------------
+ ! Derived type containing all the configuration information needed
+ ! to run the radiation scheme. The intention is that this is fixed
+ ! for a given model run. The parameters are to list first those
+ ! quantities that can be set directly by the user, for example using a
+ ! namelist, and second those quantities that are computed afterwards
+ ! from the user-supplied numbers, especially the details of the gas
+ ! optics model.
+ type config_type
+ ! USER-CONFIGURABLE PARAMETERS
+
+ ! Override default solar spectrum
+ logical :: use_spectral_solar_scaling = .false.
+
+ ! Directory in which gas, cloud and aerosol data files are to be
+ ! found
+ character(len=511) :: directory_name = '.'
+
+ ! Cloud is deemed to be present in a layer if cloud fraction
+ ! exceeds this value
+ real(jprb) :: cloud_fraction_threshold = 1.0e-6_jprb
+ ! ...and total cloud water mixing ratio exceeds this value
+ real(jprb) :: cloud_mixing_ratio_threshold = 1.0e-9_jprb
+
+ ! Overlap scheme
+ integer :: i_overlap_scheme = IOverlapExponentialRandom
+
+ ! Use the Shonk et al. (2010) "beta" overlap parameter, rather
+ ! than the "alpha" overlap parameter of Hogan and Illingworth
+ ! (2000)?
+ logical :: use_beta_overlap = .false.
+
+ ! Shape of sub-grid cloud water PDF
+ integer :: i_cloud_pdf_shape = IPdfShapeGamma
+
+ ! The ratio of the overlap decorrelation length for cloud
+ ! inhomogeneities to the overlap decorrelation length for cloud
+ ! boundaries. Observations suggest this has a value of 0.5
+ ! (e.g. from the decorrelation lengths of Hogan and Illingworth
+ ! 2003 and Hogan and Illingworth 2000).
+ real(jprb) :: cloud_inhom_decorr_scaling = 0.5_jprb
+
+ ! Factor controlling how much of the cloud edge length interfaces
+ ! directly between the clear-sky region (region a) and the
+ ! optically thick cloudy region (region c). If Lxy is the length
+ ! of the interfaces between regions x and y, and Lab and Lbc have
+ ! been computed already, then
+ ! Lac=clear_to_thick_fraction*min(Lab,Lbc).
+ real(jprb) :: clear_to_thick_fraction = 0.0_jprb
+
+ ! Factor allowing lateral transport when the sun is close to
+ ! overhead; consider atand(overhead_sun_factor) to be the number
+ ! of degrees that the sun angle is perturbed from zenith for the
+ ! purposes of computing lateral transport. A value of up to 0.1
+ ! seems to be necessary to account for the fact that some forward
+ ! scattered radiation is treated as unscattered by delta-Eddington
+ ! scaling; therefore it ought to have the chance to escape.
+ real(jprb) :: overhead_sun_factor = 0.0_jprb
+
+ ! Minimum gas optical depth in a single layer at any wavelength,
+ ! for stability
+ real(jprb) :: min_gas_od_lw = 1.0e-15_jprb
+ real(jprb) :: min_gas_od_sw = 0.0_jprb
+
+ ! Maximum gas optical depth in a layer before that g-point will
+ ! not be considered for 3D treatment: a limit is required to avoid
+ ! expensive computation of matrix exponentials on matrices with
+ ! large elements
+ real(jprb) :: max_gas_od_3d = 8.0_jprb
+
+ ! Maximum total optical depth of a cloudy region for stability:
+ ! optical depth will be capped at this value in the SPARTACUS
+ ! solvers
+ real(jprb) :: max_cloud_od = 16.0_jprb
+
+ ! How much longwave scattering is included?
+ logical :: do_lw_cloud_scattering = .true.
+ logical :: do_lw_aerosol_scattering = .true.
+
+ ! Number of regions used to describe clouds and clear skies. A
+ ! value of 2 means one clear and one cloudy region, so clouds are
+ ! horizontally homogeneous, while a value of 3 means two cloudy
+ ! regions with different optical depth, thereby representing
+ ! inhomogeneity via the Shonk & Hogan (2008) "Tripleclouds"
+ ! method.
+ integer :: nregions = 3
+
+ ! Code specifying the solver to be used: use the enumerations
+ ! defined above
+ integer :: i_solver_sw = ISolverMcICA
+ integer :: i_solver_lw = ISolverMcICA
+
+ ! Do shortwave delta-Eddington scaling on the cloud-aerosol-gas
+ ! mixture (as in the original IFS scheme), rather than the more
+ ! correct approach of separately scaling the cloud and aerosol
+ ! scattering properties before merging with gases. Note that
+ ! .true. is not compatible with the SPARTACUS solver.
+ logical :: do_sw_delta_scaling_with_gases = .false.
+
+ ! Codes describing the gas and cloud scattering models to use, the
+ ! latter of which is currently not used
+ integer :: i_gas_model = IGasModelIFSRRTMG
+ ! integer :: i_cloud_model
+
+ ! Optics if i_gas_model==IGasModelMonochromatic.
+ ! The wavelength to use for the Planck function in metres. If this
+ ! is positive then the output longwave fluxes will be in units of
+ ! W m-2 um-1. If this is zero or negative (the default) then
+ ! sigma*T^4 will be used and the output longwave fluxes will be in
+ ! W m-2.
+ real(jprb) :: mono_lw_wavelength = -1.0_jprb
+ ! Total zenith optical depth of the atmosphere in the longwave and
+ ! shortwave, distributed vertically according to the pressure.
+ ! Default is zero.
+ real(jprb) :: mono_lw_total_od = 0.0_jprb
+ real(jprb) :: mono_sw_total_od = 0.0_jprb
+ ! Single-scattering albedo and asymmetry factor: values typical
+ ! for liquid clouds with effective radius of 10 microns, at (SW)
+ ! 0.55 micron wavelength and (LW) 10.7 microns wavelength
+ real(jprb) :: mono_sw_single_scattering_albedo = 0.999999_jprb
+ real(jprb) :: mono_sw_asymmetry_factor = 0.86_jprb
+ real(jprb) :: mono_lw_single_scattering_albedo = 0.538_jprb
+ real(jprb) :: mono_lw_asymmetry_factor = 0.925_jprb
+
+ ! Codes describing particle scattering models
+ integer :: i_liq_model = ILiquidModelSOCRATES
+ integer :: i_ice_model = IIceModelBaran
+
+ ! The mapping from albedo/emissivity intervals to SW/LW bands can
+ ! either be done by finding the interval containing the central
+ ! wavenumber of the band (nearest neighbour), or by a weighting
+ ! according to the spectral overlap of each interval with each
+ ! band
+ logical :: do_nearest_spectral_sw_albedo = .true.
+ logical :: do_nearest_spectral_lw_emiss = .true.
+
+ ! User-defined monotonically increasing wavelength bounds (m)
+ ! between input surface albedo/emissivity intervals. Implicitly
+ ! the first interval starts at zero and the last ends at
+ ! infinity.
+ real(jprb) :: sw_albedo_wavelength_bound(NMaxAlbedoIntervals-1) = -1.0_jprb
+ real(jprb) :: lw_emiss_wavelength_bound( NMaxAlbedoIntervals-1) = -1.0_jprb
+ ! The index to the surface albedo/emissivity intervals for each of
+ ! the wavelength bounds specified in sw_albedo_wavelength_bound
+ ! and lw_emiss_wavelength_bound
+ integer :: i_sw_albedo_index(NMaxAlbedoIntervals) = 0
+ integer :: i_lw_emiss_index (NMaxAlbedoIntervals) = 0
+
+ ! Do we compute longwave and/or shortwave radiation?
+ logical :: do_lw = .true.
+ logical :: do_sw = .true.
+
+ ! Do we compute clear-sky fluxes and/or solar direct fluxes?
+ logical :: do_clear = .true.
+ logical :: do_sw_direct = .true.
+
+ ! Do we include 3D effects?
+ logical :: do_3d_effects = .true.
+
+ ! To what extent do we include "entrapment" effects in the
+ ! SPARTACUS solver? This essentially means that in a situation
+ ! like this
+ !
+ ! 000111
+ ! 222222
+ !
+ ! Radiation downwelling from region 1 may be reflected back into
+ ! region 0 due to some degree of homogenization of the radiation
+ ! in region 2. Hogan and Shonk (2013) referred to this as
+ ! "anomalous horizontal transport" for a 1D model, although for 3D
+ ! calculations it is desirable to include at least some of it. The
+ ! options are described by the IEntrapment* parameters above.
+ integer :: i_3d_sw_entrapment = IEntrapmentExplicit
+
+ ! In the longwave, the equivalent process it either "on" (like
+ ! maximum entrapment) or "off" (like zero entrapment):
+ logical :: do_3d_lw_multilayer_effects = .false.
+
+ ! Do we account for the effective emissivity of the side of
+ ! clouds?
+ logical :: do_lw_side_emissivity = .true.
+
+ ! The 3D transfer rate "X" is such that if transport out of a
+ ! region was the only process occurring then by the base of a
+ ! layer only exp(-X) of the original flux would remain in that
+ ! region. The transfer rate computed geometrically can be very
+ ! high for the clear-sky regions in layers with high cloud
+ ! fraction. For stability reasons it is necessary to provide a
+ ! maximum possible 3D transfer rate.
+ real(jprb) :: max_3d_transfer_rate = 10.0_jprb
+
+ ! It has also sometimes been found necessary to set a minimum
+ ! cloud effective size for stability (metres)
+ real(jprb) :: min_cloud_effective_size = 100.0_jprb
+
+ ! Given a horizontal migration distance, there is still
+ ! uncertainty about how much entrapment occurs associated with how
+ ! one assumes cloud boundaries line up in adjacent layers. This
+ ! factor can be varied between 0.0 (the boundaries line up to the
+ ! greatest extent possible given the overlap parameter) and 1.0
+ ! (the boundaries line up to the minimum extent possible). In the
+ ! Hogan et al. entrapment paper it is referred to as the overhang
+ ! factor zeta, and a value of 0 matches the Monte Carlo
+ ! calculations best.
+ real(jprb) :: overhang_factor = 0.0_jprb
+
+ ! By default, the Meador & Weaver (1980) expressions are used
+ ! instead of the matrix exponential whenever 3D effects can be
+ ! neglected (e.g. cloud-free layers or clouds with infinitely
+ ! large effective cloud size), but setting the following to true
+ ! uses the matrix exponential everywhere, enabling the two
+ ! methods to be compared. Note that Meador & Weaver will still be
+ ! used for very optically thick g points where the matrix
+ ! exponential can produce incorrect results.
+ logical :: use_expm_everywhere = .false.
+
+ ! Aerosol descriptors: aerosol_type_mapping must be of length
+ ! n_aerosol_types, and contains 0 if that type is to be ignored,
+ ! positive numbers to map on to the indices of hydrophobic
+ ! aerosols in the aerosol optics configuration file, and negative
+ ! numbers to map on to (the negative of) the indices of
+ ! hydrophilic aerosols in the configuration file.
+ logical :: use_aerosols = .false.
+ integer :: n_aerosol_types = 0
+ integer :: i_aerosol_type_map(NMaxAerosolTypes)
+
+ ! Save the gas and cloud optical properties for each g point in
+ ! "radiative_properties.nc"?
+ logical :: do_save_radiative_properties = .false.
+
+ ! Save the flux profiles in each band?
+ logical :: do_save_spectral_flux = .false.
+
+ ! Save the surface downwelling shortwave fluxes in each band?
+ logical :: do_surface_sw_spectral_flux = .true.
+
+ ! Compute the longwave derivatives needed to apply the approximate
+ ! radiation updates of Hogan and Bozzo (2015)
+ logical :: do_lw_derivatives = .false.
+
+ ! Save the flux profiles in each g-point (overrides
+ ! do_save_spectral_flux if TRUE)?
+ logical :: do_save_gpoint_flux = .false.
+
+ ! In the IFS environment, setting up RRTM has already been done
+ ! so not needed to do it again
+ logical :: do_setup_ifsrrtm = .true.
+
+ ! In the IFS environment the old scheme has a bug in the Fu
+ ! longwave ice optics whereby the single scattering albedo is one
+ ! minus what it should be. Unfortunately fixing it makes
+ ! forecasts worse. Setting the following to true reproduces the
+ ! bug.
+ logical :: do_fu_lw_ice_optics_bug = .false.
+
+ ! Control verbosity: 0=none (no output to standard output; write
+ ! to standard error only if an error occurs), 1=warning, 2=info,
+ ! 3=progress, 4=detailed, 5=debug. Separate settings for the
+ ! setup of the scheme and the execution of it.
+ integer :: iverbosesetup = 2
+ integer :: iverbose = 1
+
+ ! Are we doing radiative transfer in complex surface canopies
+ ! (streets/vegetation), in which case tailored downward fluxes are
+ ! needed at the top of the canopy?
+ logical :: do_canopy_fluxes_sw = .false.
+ logical :: do_canopy_fluxes_lw = .false.
+ ! If so, do we use the full spectrum as in the atmosphere, or just
+ ! the reduced spectrum in which the shortwave albedo and longwave
+ ! emissivity are provided?
+ logical :: use_canopy_full_spectrum_sw = .false.
+ logical :: use_canopy_full_spectrum_lw = .false.
+ ! Do we treat gas radiative transfer in streets/vegetation?
+ logical :: do_canopy_gases_sw = .false.
+ logical :: do_canopy_gases_lw = .false.
+
+ ! Optics file names for overriding the ones generated from the
+ ! other options. If these remain empty then the generated names
+ ! will be used (see the "consolidate_config" routine below). If
+ ! the user assigns one of these and it starts with a '/' character
+ ! then that will be used instead. If the user assigns one and it
+ ! doesn't start with a '/' character then it will be prepended by
+ ! the contents of directory_name.
+ character(len=511) :: ice_optics_override_file_name = ''
+ character(len=511) :: liq_optics_override_file_name = ''
+ character(len=511) :: aerosol_optics_override_file_name = ''
+
+ ! Optionally override the look-up table file for the cloud-water
+ ! PDF used by the McICA solver
+ character(len=511) :: cloud_pdf_override_file_name = ''
+
+ ! Has "consolidate" been called?
+ logical :: is_consolidated = .false.
+ ! COMPUTED PARAMETERS
+ ! Users of this library should not edit these parameters directly;
+ ! they are set by the "consolidate" routine
+
+ ! Wavenumber range for each band, in cm-1, which will be allocated
+ ! to be of length n_bands_sw or n_bands_lw
+ real(jprb), allocatable, dimension(:) :: wavenumber1_sw
+ real(jprb), allocatable, dimension(:) :: wavenumber2_sw
+ real(jprb), allocatable, dimension(:) :: wavenumber1_lw
+ real(jprb), allocatable, dimension(:) :: wavenumber2_lw
+
+
+ ! If the nearest surface albedo/emissivity interval is to be used
+ ! for each SW/LW band then the following arrays will be allocated
+ ! to the length of the number of bands and contain the index to
+ ! the relevant interval
+ integer, allocatable, dimension(:) :: i_albedo_from_band_sw
+ integer, allocatable, dimension(:) :: i_emiss_from_band_lw
+
+ ! ...alternatively, this matrix dimensioned
+ ! (n_albedo_intervals,n_bands_sw) providing the weights needed for
+ ! computing the albedo in each ecRad band from the albedo in each
+ ! native albedo band - see radiation_single_level.F90
+ real(jprb), allocatable, dimension(:,:) :: sw_albedo_weights
+ ! ...and similarly in the longwave, dimensioned
+ ! (n_emiss_intervals,n_bands_lw)
+ real(jprb), allocatable, dimension(:,:) :: lw_emiss_weights
+
+ ! Arrays of length the number of g-points that convert from
+ ! g-point to the band index
+ integer, allocatable, dimension(:) :: i_band_from_g_lw
+ integer, allocatable, dimension(:) :: i_band_from_g_sw
+
+ ! We allow for the possibility for g-points to be ordered in terms
+ ! of likely absorption (weakest to strongest) across the shortwave
+ ! or longwave spectrum, in order that in SPARTACUS we select only
+ ! the first n g-points that will not have too large an absorption,
+ ! and therefore matrix exponentials that are both finite and not
+ ! too expensive to compute. The following two arrays map the
+ ! reordered g-points to the original ones.
+ integer, allocatable, dimension(:) :: i_g_from_reordered_g_lw
+ integer, allocatable, dimension(:) :: i_g_from_reordered_g_sw
+
+ ! The following map the reordered g-points to the bands
+ integer, allocatable, dimension(:) :: i_band_from_reordered_g_lw
+ integer, allocatable, dimension(:) :: i_band_from_reordered_g_sw
+
+ ! The following map the reordered g-points to the spectral
+ ! information being saved: if do_save_gpoint_flux==TRUE then this
+ ! will map on to the original g points, but if only
+ ! do_save_spectral_flux==TRUE then this will map on to the bands
+ integer, pointer, dimension(:) :: i_spec_from_reordered_g_lw
+ integer, pointer, dimension(:) :: i_spec_from_reordered_g_sw
+
+ ! Number of spectral intervals used for the canopy radiative
+ ! transfer calculation; they are either equal to
+ ! n_albedo_intervals/n_emiss_intervals or n_g_sw/n_g_lw
+ integer :: n_canopy_bands_sw = 1
+ integer :: n_canopy_bands_lw = 1
+
+ ! Data structure containing cloud scattering data
+ type(cloud_optics_type) :: cloud_optics
+
+ ! Data structure containing aerosol scattering data
+ type(aerosol_optics_type) :: aerosol_optics
+
+ ! Object for sampling from a gamma or lognormal distribution
+ type(pdf_sampler_type) :: pdf_sampler
+
+ ! Optics file names
+ character(len=511) :: ice_optics_file_name, &
+ & liq_optics_file_name, &
+ & aerosol_optics_file_name
+
+ ! McICA PDF look-up table file name
+ character(len=511) :: cloud_pdf_file_name
+
+ ! Number of gpoints and bands in the shortwave and longwave - set
+ ! to zero as will be set properly later
+ integer :: n_g_sw = 0, n_g_lw = 0
+ integer :: n_bands_sw = 0, n_bands_lw = 0
+
+ ! Number of spectral points to save (equal either to the number of
+ ! g points or the number of bands
+ integer :: n_spec_sw = 0, n_spec_lw = 0
+
+ ! Dimensions to store variables that are only needed if longwave
+ ! scattering is included. "n_g_lw_if_scattering" is equal to
+ ! "n_g_lw" if aerosols are allowed to scatter in the longwave,
+ ! and zero otherwise. "n_bands_lw_if_scattering" is equal to
+ ! "n_bands_lw" if clouds are allowed to scatter in the longwave,
+ ! and zero otherwise.
+ integer :: n_g_lw_if_scattering = 0, n_bands_lw_if_scattering = 0
+
+ ! Treat clouds as horizontally homogeneous within the gribox
+ logical :: is_homogeneous = .false.
+
+ ! If the solvers are both "Cloudless" then we don't need to do any
+ ! cloud processing
+ logical :: do_clouds = .true.
+
+ contains
+ procedure :: read => read_config_from_namelist
+ procedure :: consolidate => consolidate_config
+ procedure :: set => set_config
+ procedure :: print => print_config
+ procedure :: get_sw_weights
+ procedure :: define_sw_albedo_intervals
+ procedure :: define_lw_emiss_intervals
+ procedure :: consolidate_intervals
+
+ end type config_type
+
+! procedure, private :: print_logical, print_real, print_int
+
+contains
+
+
+ !---------------------------------------------------------------------
+ ! This subroutine reads configuration data from a namelist file, and
+ ! anything that is not in the namelists will be set to default
+ ! values. If optional output argument "is_success" is present, then
+ ! on error (e.g. missing file) it will be set to .false.; if this
+ ! argument is missing then on error the program will be aborted. You
+ ! may either specify the file_name or the unit of an open file to
+ ! read, but not both.
+ subroutine read_config_from_namelist(this, file_name, unit, is_success)
+
+ use yomhook, only : lhook, dr_hook
+ use radiation_io, only : nulout, nulerr, nulrad, radiation_abort
+
+ class(config_type), intent(inout) :: this
+ character(*), intent(in), optional :: file_name
+ integer, intent(in), optional :: unit
+ logical, intent(out), optional :: is_success
+
+ integer :: iosopen, iosread ! Status after calling open and read
+
+ ! The following variables are read from the namelists and map
+ ! directly onto members of the config_type derived type
+
+ ! To be read from the radiation_config namelist
+ logical :: do_sw, do_lw, do_clear, do_sw_direct
+ logical :: do_3d_effects, use_expm_everywhere, use_aerosols
+ logical :: do_lw_side_emissivity
+ logical :: do_3d_lw_multilayer_effects, do_fu_lw_ice_optics_bug
+ logical :: do_lw_aerosol_scattering, do_lw_cloud_scattering
+ logical :: do_save_radiative_properties, do_save_spectral_flux
+ logical :: do_save_gpoint_flux, do_surface_sw_spectral_flux
+ logical :: use_beta_overlap, do_lw_derivatives
+ logical :: do_sw_delta_scaling_with_gases
+ logical :: do_canopy_fluxes_sw, do_canopy_fluxes_lw
+ logical :: use_canopy_full_spectrum_sw, use_canopy_full_spectrum_lw
+ logical :: do_canopy_gases_sw, do_canopy_gases_lw
+ integer :: n_regions, iverbose, iverbosesetup, n_aerosol_types
+ real(jprb):: mono_lw_wavelength, mono_lw_total_od, mono_sw_total_od
+ real(jprb):: mono_lw_single_scattering_albedo, mono_sw_single_scattering_albedo
+ real(jprb):: mono_lw_asymmetry_factor, mono_sw_asymmetry_factor
+ real(jprb):: cloud_inhom_decorr_scaling, cloud_fraction_threshold
+ real(jprb):: clear_to_thick_fraction, max_gas_od_3d, max_cloud_od
+ real(jprb):: cloud_mixing_ratio_threshold, overhead_sun_factor
+ real(jprb):: max_3d_transfer_rate, min_cloud_effective_size
+ real(jprb):: overhang_factor, encroachment_scaling
+ character(511) :: directory_name, aerosol_optics_override_file_name
+ character(511) :: liq_optics_override_file_name, ice_optics_override_file_name
+ character(511) :: cloud_pdf_override_file_name
+ character(63) :: liquid_model_name, ice_model_name, gas_model_name
+ character(63) :: sw_solver_name, lw_solver_name, overlap_scheme_name
+ character(63) :: sw_entrapment_name, sw_encroachment_name, cloud_pdf_shape_name
+ integer :: i_aerosol_type_map(NMaxAerosolTypes) ! More than 256 is an error
+
+ logical :: do_nearest_spectral_sw_albedo = .true.
+ logical :: do_nearest_spectral_lw_emiss = .true.
+ real(jprb) :: sw_albedo_wavelength_bound(NMaxAlbedoIntervals-1)
+ real(jprb) :: lw_emiss_wavelength_bound( NMaxAlbedoIntervals-1)
+ integer :: i_sw_albedo_index(NMaxAlbedoIntervals)
+ integer :: i_lw_emiss_index (NMaxAlbedoIntervals)
+
+ integer :: iunit ! Unit number of namelist file
+
+ namelist /radiation/ do_sw, do_lw, do_sw_direct, &
+ & do_3d_effects, do_lw_side_emissivity, do_clear, &
+ & do_save_radiative_properties, sw_entrapment_name, sw_encroachment_name, &
+ & do_3d_lw_multilayer_effects, do_fu_lw_ice_optics_bug, &
+ & do_save_spectral_flux, do_save_gpoint_flux, &
+ & do_surface_sw_spectral_flux, do_lw_derivatives, &
+ & do_lw_aerosol_scattering, do_lw_cloud_scattering, &
+ & n_regions, directory_name, gas_model_name, &
+ & ice_optics_override_file_name, liq_optics_override_file_name, &
+ & aerosol_optics_override_file_name, cloud_pdf_override_file_name, &
+ & liquid_model_name, ice_model_name, max_3d_transfer_rate, &
+ & min_cloud_effective_size, overhang_factor, encroachment_scaling, &
+ & use_canopy_full_spectrum_sw, use_canopy_full_spectrum_lw, &
+ & do_canopy_fluxes_sw, do_canopy_fluxes_lw, &
+ & do_canopy_gases_sw, do_canopy_gases_lw, &
+ & do_sw_delta_scaling_with_gases, overlap_scheme_name, &
+ & sw_solver_name, lw_solver_name, use_beta_overlap, &
+ & use_expm_everywhere, iverbose, iverbosesetup, &
+ & cloud_inhom_decorr_scaling, cloud_fraction_threshold, &
+ & clear_to_thick_fraction, max_gas_od_3d, max_cloud_od, &
+ & cloud_mixing_ratio_threshold, overhead_sun_factor, &
+ & n_aerosol_types, i_aerosol_type_map, use_aerosols, &
+ & mono_lw_wavelength, mono_lw_total_od, mono_sw_total_od, &
+ & mono_lw_single_scattering_albedo, mono_sw_single_scattering_albedo, &
+ & mono_lw_asymmetry_factor, mono_sw_asymmetry_factor, &
+ & cloud_pdf_shape_name, &
+ & do_nearest_spectral_sw_albedo, do_nearest_spectral_lw_emiss, &
+ & sw_albedo_wavelength_bound, lw_emiss_wavelength_bound, &
+ & i_sw_albedo_index, i_lw_emiss_index
+
+ real(jprb) :: hook_handle
+
+ if (lhook) call dr_hook('radiation_config:read',0,hook_handle)
+
+ ! Copy default values from the original structure
+ do_sw = this%do_sw
+ do_lw = this%do_lw
+ do_sw_direct = this%do_sw_direct
+ do_3d_effects = this%do_3d_effects
+ do_3d_lw_multilayer_effects = this%do_3d_lw_multilayer_effects
+ do_lw_side_emissivity = this%do_lw_side_emissivity
+ do_clear = this%do_clear
+ do_lw_aerosol_scattering = this%do_lw_aerosol_scattering
+ do_lw_cloud_scattering = this%do_lw_cloud_scattering
+ do_sw_delta_scaling_with_gases = this%do_sw_delta_scaling_with_gases
+ do_fu_lw_ice_optics_bug = this%do_fu_lw_ice_optics_bug
+ do_canopy_fluxes_sw = this%do_canopy_fluxes_sw
+ do_canopy_fluxes_lw = this%do_canopy_fluxes_lw
+ use_canopy_full_spectrum_sw = this%use_canopy_full_spectrum_sw
+ use_canopy_full_spectrum_lw = this%use_canopy_full_spectrum_lw
+ do_canopy_gases_sw = this%do_canopy_gases_sw
+ do_canopy_gases_lw = this%do_canopy_gases_lw
+ n_regions = this%nregions
+ directory_name = this%directory_name
+ cloud_pdf_override_file_name = this%cloud_pdf_override_file_name
+ liq_optics_override_file_name = this%liq_optics_override_file_name
+ ice_optics_override_file_name = this%ice_optics_override_file_name
+ aerosol_optics_override_file_name = this%aerosol_optics_override_file_name
+ use_expm_everywhere = this%use_expm_everywhere
+ use_aerosols = this%use_aerosols
+ do_save_radiative_properties = this%do_save_radiative_properties
+ do_save_spectral_flux = this%do_save_spectral_flux
+ do_save_gpoint_flux = this%do_save_gpoint_flux
+ do_lw_derivatives = this%do_lw_derivatives
+ do_surface_sw_spectral_flux = this%do_surface_sw_spectral_flux
+ iverbose = this%iverbose
+ iverbosesetup = this%iverbosesetup
+ cloud_fraction_threshold = this%cloud_fraction_threshold
+ cloud_mixing_ratio_threshold = this%cloud_mixing_ratio_threshold
+ use_beta_overlap = this%use_beta_overlap
+ cloud_inhom_decorr_scaling = this%cloud_inhom_decorr_scaling
+ clear_to_thick_fraction = this%clear_to_thick_fraction
+ overhead_sun_factor = this%overhead_sun_factor
+ max_gas_od_3d = this%max_gas_od_3d
+ max_cloud_od = this%max_cloud_od
+ max_3d_transfer_rate = this%max_3d_transfer_rate
+ min_cloud_effective_size = this%min_cloud_effective_size
+ overhang_factor = this%overhang_factor
+ encroachment_scaling = -1.0_jprb
+ gas_model_name = '' !DefaultGasModelName
+ liquid_model_name = '' !DefaultLiquidModelName
+ ice_model_name = '' !DefaultIceModelName
+ sw_solver_name = '' !DefaultSwSolverName
+ lw_solver_name = '' !DefaultLwSolverName
+ sw_entrapment_name = ''
+ sw_encroachment_name = ''
+ overlap_scheme_name = ''
+ cloud_pdf_shape_name = ''
+ n_aerosol_types = this%n_aerosol_types
+ mono_lw_wavelength = this%mono_lw_wavelength
+ mono_lw_total_od = this%mono_lw_total_od
+ mono_sw_total_od = this%mono_sw_total_od
+ mono_lw_single_scattering_albedo = this%mono_lw_single_scattering_albedo
+ mono_sw_single_scattering_albedo = this%mono_sw_single_scattering_albedo
+ mono_lw_asymmetry_factor = this%mono_lw_asymmetry_factor
+ mono_sw_asymmetry_factor = this%mono_sw_asymmetry_factor
+ i_aerosol_type_map = this%i_aerosol_type_map
+ do_nearest_spectral_sw_albedo = this%do_nearest_spectral_sw_albedo
+ do_nearest_spectral_lw_emiss = this%do_nearest_spectral_lw_emiss
+ sw_albedo_wavelength_bound = this%sw_albedo_wavelength_bound
+ lw_emiss_wavelength_bound = this%lw_emiss_wavelength_bound
+ i_sw_albedo_index = this%i_sw_albedo_index
+ i_lw_emiss_index = this%i_lw_emiss_index
+
+ if (present(file_name) .and. present(unit)) then
+ write(nulerr,'(a)') '*** Error: cannot specify both file_name and unit in call to config_type%read'
+ call radiation_abort('Radiation configuration error')
+ else if (.not. present(file_name) .and. .not. present(unit)) then
+ write(nulerr,'(a)') '*** Error: neither file_name nor unit specified in call to config_type%read'
+ call radiation_abort('Radiation configuration error')
+ end if
+
+ if (present(file_name)) then
+ ! Open the namelist file
+ iunit = nulrad
+ open(unit=iunit, iostat=iosopen, file=trim(file_name))
+ else
+ ! Assume that iunit represents and open file
+ iosopen = 0
+ iunit = unit
+ end if
+
+ if (iosopen /= 0) then
+ ! An error occurred opening the file
+ if (present(is_success)) then
+ is_success = .false.
+ ! We now continue the subroutine so that the default values
+ ! are placed in the config structure
+ else
+ write(nulerr,'(a,a,a)') '*** Error: namelist file "', &
+ & trim(file_name), '" not found'
+ call radiation_abort('Radiation configuration error')
+ end if
+ else
+ read(unit=iunit, iostat=iosread, nml=radiation)
+ if (iosread /= 0) then
+ ! An error occurred reading the file
+ if (present(is_success)) then
+ is_success = .false.
+ ! We now continue the subroutine so that the default values
+ ! are placed in the config structure
+ else if (present(file_name)) then
+ write(nulerr,'(a,a,a)') '*** Error reading namelist "radiation" from file "', &
+ & trim(file_name), '"'
+ close(unit=iunit)
+ call radiation_abort('Radiation configuration error')
+ else
+ write(nulerr,'(a,i0)') '*** Error reading namelist "radiation" from unit ', &
+ & iunit
+ call radiation_abort('Radiation configuration error')
+ end if
+ end if
+
+ if (present(file_name)) then
+ close(unit=iunit)
+ end if
+ end if
+
+ ! Copy namelist data into configuration object
+
+ ! Start with verbosity levels, which should be within limits
+ if (iverbose < 0) then
+ iverbose = 0
+ end if
+ this%iverbose = iverbose
+
+ if (iverbosesetup < 0) then
+ iverbosesetup = 0
+ end if
+ this%iverbosesetup = iverbosesetup
+
+ this%do_lw = do_lw
+ this%do_sw = do_sw
+ this%do_clear = do_clear
+ this%do_sw_direct = do_sw_direct
+ this%do_3d_effects = do_3d_effects
+ this%do_3d_lw_multilayer_effects = do_3d_lw_multilayer_effects
+ this%do_lw_side_emissivity = do_lw_side_emissivity
+ this%use_expm_everywhere = use_expm_everywhere
+ this%use_aerosols = use_aerosols
+ this%do_lw_cloud_scattering = do_lw_cloud_scattering
+ this%do_lw_aerosol_scattering = do_lw_aerosol_scattering
+ this%nregions = n_regions
+ this%do_surface_sw_spectral_flux = do_surface_sw_spectral_flux
+ this%do_sw_delta_scaling_with_gases = do_sw_delta_scaling_with_gases
+ this%do_fu_lw_ice_optics_bug = do_fu_lw_ice_optics_bug
+ this%do_canopy_fluxes_sw = do_canopy_fluxes_sw
+ this%do_canopy_fluxes_lw = do_canopy_fluxes_lw
+ this%use_canopy_full_spectrum_sw = use_canopy_full_spectrum_sw
+ this%use_canopy_full_spectrum_lw = use_canopy_full_spectrum_lw
+ this%do_canopy_gases_sw = do_canopy_gases_sw
+ this%do_canopy_gases_lw = do_canopy_gases_lw
+ this%mono_lw_wavelength = mono_lw_wavelength
+ this%mono_lw_total_od = mono_lw_total_od
+ this%mono_sw_total_od = mono_sw_total_od
+ this%mono_lw_single_scattering_albedo = mono_lw_single_scattering_albedo
+ this%mono_sw_single_scattering_albedo = mono_sw_single_scattering_albedo
+ this%mono_lw_asymmetry_factor = mono_lw_asymmetry_factor
+ this%mono_sw_asymmetry_factor = mono_sw_asymmetry_factor
+ this%use_beta_overlap = use_beta_overlap
+ this%cloud_inhom_decorr_scaling = cloud_inhom_decorr_scaling
+ this%clear_to_thick_fraction = clear_to_thick_fraction
+ this%overhead_sun_factor = overhead_sun_factor
+ this%max_gas_od_3d = max_gas_od_3d
+ this%max_cloud_od = max_cloud_od
+ this%max_3d_transfer_rate = max_3d_transfer_rate
+ this%min_cloud_effective_size = max(1.0e-6_jprb, min_cloud_effective_size)
+ if (encroachment_scaling >= 0.0_jprb) then
+ this%overhang_factor = encroachment_scaling
+ if (iverbose >= 1) then
+ write(nulout, '(a)') 'Warning: radiation namelist parameter "encroachment_scaling" is deprecated: use "overhang_factor"'
+ end if
+ else
+ this%overhang_factor = overhang_factor
+ end if
+ this%directory_name = directory_name
+ this%cloud_pdf_override_file_name = cloud_pdf_override_file_name
+ this%liq_optics_override_file_name = liq_optics_override_file_name
+ this%ice_optics_override_file_name = ice_optics_override_file_name
+ this%aerosol_optics_override_file_name = aerosol_optics_override_file_name
+ this%cloud_fraction_threshold = cloud_fraction_threshold
+ this%cloud_mixing_ratio_threshold = cloud_mixing_ratio_threshold
+ this%n_aerosol_types = n_aerosol_types
+ this%do_save_radiative_properties = do_save_radiative_properties
+ this%do_lw_derivatives = do_lw_derivatives
+ this%do_save_spectral_flux = do_save_spectral_flux
+ this%do_save_gpoint_flux = do_save_gpoint_flux
+ this%do_nearest_spectral_sw_albedo = do_nearest_spectral_sw_albedo
+ this%do_nearest_spectral_lw_emiss = do_nearest_spectral_lw_emiss
+ this%sw_albedo_wavelength_bound = sw_albedo_wavelength_bound
+ this%lw_emiss_wavelength_bound = lw_emiss_wavelength_bound
+ this%i_sw_albedo_index = i_sw_albedo_index
+ this%i_lw_emiss_index = i_lw_emiss_index
+
+ if (do_save_gpoint_flux) then
+ ! Saving the fluxes every g-point overrides saving as averaged
+ ! in a band, but this%do_save_spectral_flux needs to be TRUE as
+ ! it is tested inside the solver routines to decide whether to
+ ! save anything
+ this%do_save_spectral_flux = .true.
+ end if
+
+ ! Determine liquid optics model
+ call get_enum_code(liquid_model_name, LiquidModelName, &
+ & 'liquid_model_name', this%i_liq_model)
+
+ ! Determine ice optics model
+ call get_enum_code(ice_model_name, IceModelName, &
+ & 'ice_model_name', this%i_ice_model)
+
+ ! Determine gas optics model
+ call get_enum_code(gas_model_name, GasModelName, &
+ & 'gas_model_name', this%i_gas_model)
+
+ ! Determine solvers
+ call get_enum_code(sw_solver_name, SolverName, &
+ & 'sw_solver_name', this%i_solver_sw)
+ call get_enum_code(lw_solver_name, SolverName, &
+ & 'lw_solver_name', this%i_solver_lw)
+
+ if (len_trim(sw_encroachment_name) > 1) then
+ call get_enum_code(sw_encroachment_name, EncroachmentName, &
+ & 'sw_encroachment_name', this%i_3d_sw_entrapment)
+ write(nulout, '(a)') 'Warning: radiation namelist string "sw_encroachment_name" is deprecated: use "sw_entrapment_name"'
+ else
+ call get_enum_code(sw_entrapment_name, EntrapmentName, &
+ & 'sw_entrapment_name', this%i_3d_sw_entrapment)
+ end if
+
+ ! Determine overlap scheme
+ call get_enum_code(overlap_scheme_name, OverlapName, &
+ & 'overlap_scheme_name', this%i_overlap_scheme)
+
+ ! Determine cloud PDF shape
+ call get_enum_code(cloud_pdf_shape_name, PdfShapeName, &
+ & 'cloud_pdf_shape_name', this%i_cloud_pdf_shape)
+
+ this%i_aerosol_type_map = 0
+ if (this%use_aerosols) then
+ this%i_aerosol_type_map(1:n_aerosol_types) &
+ & = i_aerosol_type_map(1:n_aerosol_types)
+ end if
+
+ ! Will clouds be used at all?
+ if ((this%do_sw .and. this%i_solver_sw /= ISolverCloudless) &
+ & .or. (this%do_lw .and. this%i_solver_lw /= ISolverCloudless)) then
+ this%do_clouds = .true.
+ else
+ this%do_clouds = .false.
+ end if
+
+ ! Normal subroutine exit
+ if (present(is_success)) then
+ is_success = .true.
+ end if
+
+ if (lhook) call dr_hook('radiation_config:read',1,hook_handle)
+
+ end subroutine read_config_from_namelist
+
+
+ !---------------------------------------------------------------------
+ ! This routine is called by radiation_interface:setup_radiation and
+ ! it converts the user specified options into some more specific
+ ! data such as data file names
+ subroutine consolidate_config(this)
+
+ use yomhook, only : lhook, dr_hook
+ use radiation_io, only : nulout, nulerr, radiation_abort
+
+ class(config_type), intent(inout) :: this
+
+ real(jprb) :: hook_handle
+
+ if (lhook) call dr_hook('radiation_config:consolidate',0,hook_handle)
+
+ ! Check consistency of models
+ if (this%do_canopy_fluxes_sw .and. .not. this%do_surface_sw_spectral_flux) then
+ if (this%iverbosesetup >= 1) then
+ write(nulout,'(a)') 'Warning: turning on do_surface_sw_spectral_flux as required by do_canopy_fluxes_sw'
+ end if
+ this%do_surface_sw_spectral_flux = .true.
+ end if
+
+ ! Will clouds be used at all?
+ if ((this%do_sw .and. this%i_solver_sw /= ISolverCloudless) &
+ & .or. (this%do_lw .and. this%i_solver_lw /= ISolverCloudless)) then
+ this%do_clouds = .true.
+ else
+ this%do_clouds = .false.
+ end if
+
+ ! SPARTACUS only works with Exp-Ran overlap scheme
+ if (( this%i_solver_sw == ISolverSPARTACUS &
+ & .or. this%i_solver_lw == ISolverSPARTACUS &
+ & .or. this%i_solver_sw == ISolverTripleclouds &
+ & .or. this%i_solver_lw == ISolverTripleclouds) &
+ & .and. this%i_overlap_scheme /= IOverlapExponentialRandom) then
+ write(nulerr,'(a)') '*** Error: SPARTACUS/Tripleclouds solvers can only do Exponential-Random overlap'
+ call radiation_abort('Radiation configuration error')
+
+ end if
+
+ ! Set aerosol optics file name
+ if (len_trim(this%aerosol_optics_override_file_name) > 0) then
+ if (this%aerosol_optics_override_file_name(1:1) == '/') then
+ this%aerosol_optics_file_name = trim(this%aerosol_optics_override_file_name)
+ else
+ this%aerosol_optics_file_name = trim(this%directory_name) &
+ & // '/' // trim(this%aerosol_optics_override_file_name)
+ end if
+ else
+ ! In the IFS, the aerosol optics file should be specified in
+ ! ifs/module/radiation_setup.F90, not here
+ this%aerosol_optics_file_name &
+ & = trim(this%directory_name) // "/aerosol_ifs_rrtm_45R2.nc"
+ end if
+
+ ! Set liquid optics file name
+ if (len_trim(this%liq_optics_override_file_name) > 0) then
+ if (this%liq_optics_override_file_name(1:1) == '/') then
+ this%liq_optics_file_name = trim(this%liq_optics_override_file_name)
+ else
+ this%liq_optics_file_name = trim(this%directory_name) &
+ & // '/' // trim(this%liq_optics_override_file_name)
+ end if
+ else if (this%i_liq_model == ILiquidModelSOCRATES) then
+ this%liq_optics_file_name &
+ & = trim(this%directory_name) // "/socrates_droplet_scattering_rrtm.nc"
+ else if (this%i_liq_model == ILiquidModelSlingo) then
+ this%liq_optics_file_name &
+ & = trim(this%directory_name) // "/slingo_droplet_scattering_rrtm.nc"
+ end if
+
+ ! Set ice optics file name
+ if (len_trim(this%ice_optics_override_file_name) > 0) then
+ if (this%ice_optics_override_file_name(1:1) == '/') then
+ this%ice_optics_file_name = trim(this%ice_optics_override_file_name)
+ else
+ this%ice_optics_file_name = trim(this%directory_name) &
+ & // '/' // trim(this%ice_optics_override_file_name)
+ end if
+ else if (this%i_ice_model == IIceModelFu) then
+ this%ice_optics_file_name &
+ & = trim(this%directory_name) // "/fu_ice_scattering_rrtm.nc"
+ else if (this%i_ice_model == IIceModelBaran) then
+ this%ice_optics_file_name &
+ & = trim(this%directory_name) // "/baran_ice_scattering_rrtm.nc"
+ else if (this%i_ice_model == IIceModelBaran2016) then
+ this%ice_optics_file_name &
+ & = trim(this%directory_name) // "/baran2016_ice_scattering_rrtm.nc"
+ else if (this%i_ice_model == IIceModelBaran2017) then
+ this%ice_optics_file_name &
+ & = trim(this%directory_name) // "/baran2017_ice_scattering_rrtm.nc"
+ else if (this%i_ice_model == IIceModelYi) then
+ this%ice_optics_file_name &
+ & = trim(this%directory_name) // "/yi_ice_scattering_rrtm.nc"
+ else if (this%i_ice_model == IIceModelShapes) then
+ this%ice_optics_file_name &
+ & = trim(this%directory_name) // "/" // CPRISTINE_ICE_LIMA // "_ice_scattering_rrtm.nc"
+ end if
+
+ ! Set cloud-water PDF look-up table file name
+ if (len_trim(this%cloud_pdf_override_file_name) > 0) then
+ if (this%cloud_pdf_override_file_name(1:1) == '/') then
+ this%cloud_pdf_file_name = trim(this%cloud_pdf_override_file_name)
+ else
+ this%cloud_pdf_file_name = trim(this%directory_name) &
+ & // '/' // trim(this%cloud_pdf_override_file_name)
+ end if
+ elseif (this%i_cloud_pdf_shape == IPdfShapeLognormal) then
+ this%cloud_pdf_file_name = trim(this%directory_name) // "/mcica_lognormal.nc"
+ else
+ this%cloud_pdf_file_name = trim(this%directory_name) // "/mcica_gamma.nc"
+ end if
+
+ ! Aerosol data
+ if (this%n_aerosol_types < 0 &
+ & .or. this%n_aerosol_types > NMaxAerosolTypes) then
+ write(nulerr,'(a,i0)') '*** Error: number of aerosol types must be between 0 and ', &
+ & NMaxAerosolTypes
+ call radiation_abort('Radiation configuration error')
+ end if
+
+ if (this%use_aerosols .and. this%n_aerosol_types == 0) then
+ if (this%iverbosesetup >= 2) then
+ write(nulout, '(a)') 'Aerosols on but n_aerosol_types=0: optical properties to be computed outside ecRad'
+ end if
+ end if
+
+ ! In the monochromatic case we need to override the liquid, ice
+ ! and aerosol models to ensure compatibility
+ if (this%i_gas_model == IGasModelMonochromatic) then
+ this%i_liq_model = ILiquidModelMonochromatic
+ this%i_ice_model = IIceModelMonochromatic
+ this%use_aerosols = .false.
+ end if
+
+ ! McICA solver currently can't store full profiles of spectral fluxes
+ if (this%i_solver_sw == ISolverMcICA) then
+ this%do_save_spectral_flux = .false.
+ end if
+
+ if (this%i_solver_sw == ISolverSPARTACUS .and. this%do_sw_delta_scaling_with_gases) then
+ write(nulerr,'(a)') '*** Error: SW delta-Eddington scaling with gases not possible with SPARTACUS solver'
+ call radiation_abort('Radiation configuration error')
+ end if
+
+ if ((this%do_lw .and. this%do_sw) .and. &
+ & ( ( this%i_solver_sw == ISolverHomogeneous &
+ & .and. this%i_solver_lw /= ISolverHomogeneous) &
+ & .or. ( this%i_solver_sw /= ISolverHomogeneous &
+ & .and. this%i_solver_lw == ISolverHomogeneous) &
+ & ) ) then
+ write(nulerr,'(a)') '*** Error: if one solver is "Homogeneous" then the other must be'
+ call radiation_abort('Radiation configuration error')
+ end if
+
+ ! Set is_homogeneous if the active solvers are homogeneous, since
+ ! this affects how "in-cloud" water contents are computed
+ if ( (this%do_sw .and. this%i_solver_sw == ISolverHomogeneous) &
+ & .or. (this%do_lw .and. this%i_solver_lw == ISolverHomogeneous)) then
+ this%is_homogeneous = .true.
+ end if
+
+ this%is_consolidated = .true.
+
+ if (lhook) call dr_hook('radiation_config:consolidate',1,hook_handle)
+
+ end subroutine consolidate_config
+
+
+ !---------------------------------------------------------------------
+ ! This subroutine sets members of the configuration object via
+ ! optional arguments, and any member not specified is left
+ ! untouched. Therefore, this should be called after taking data from
+ ! the namelist.
+ subroutine set_config(config, directory_name, &
+ & do_lw, do_sw, &
+ & do_lw_aerosol_scattering, do_lw_cloud_scattering, &
+ & do_sw_direct)
+
+ class(config_type), intent(inout):: config
+ character(len=*), intent(in), optional :: directory_name
+ logical, intent(in), optional :: do_lw, do_sw
+ logical, intent(in), optional :: do_lw_aerosol_scattering
+ logical, intent(in), optional :: do_lw_cloud_scattering
+ logical, intent(in), optional :: do_sw_direct
+
+ if (present(do_lw)) then
+ config%do_lw = do_lw
+ end if
+
+ if(present(do_sw)) then
+ config%do_sw = do_sw
+ end if
+
+ if (present(do_sw_direct)) then
+ config%do_sw_direct = do_sw_direct
+ end if
+
+ if (present(directory_name)) then
+ config%directory_name = trim(directory_name)
+ end if
+
+ if (present(do_lw_aerosol_scattering)) then
+ config%do_lw_aerosol_scattering = .true.
+ end if
+
+ if (present(do_lw_cloud_scattering)) then
+ config%do_lw_cloud_scattering = .true.
+ end if
+
+ end subroutine set_config
+
+
+ !---------------------------------------------------------------------
+ ! Print configuration information to standard output
+ subroutine print_config(this, iverbose)
+
+ use radiation_io, only : nulout
+
+ class(config_type), intent(in) :: this
+
+ integer, optional, intent(in) :: iverbose
+ integer :: i_local_verbose
+
+ if (present(iverbose)) then
+ i_local_verbose = iverbose
+ else
+ i_local_verbose = this%iverbose
+ end if
+
+ if (i_local_verbose >= 2) then
+ !---------------------------------------------------------------------
+ write(nulout, '(a)') 'General settings:'
+ write(nulout, '(a,a,a)') ' Data files expected in "', &
+ & trim(this%directory_name), '"'
+ call print_logical(' Clear-sky calculations are', 'do_clear', this%do_clear)
+ call print_logical(' Saving intermediate radiative properties', &
+ & 'do_save_radiative_properties', this%do_save_radiative_properties)
+ call print_logical(' Saving spectral flux profiles', &
+ & 'do_save_spectral_flux', this%do_save_spectral_flux)
+ call print_enum(' Gas model is', GasModelName, 'i_gas_model', &
+ & this%i_gas_model)
+ call print_logical(' Aerosols are', 'use_aerosols', this%use_aerosols)
+ call print_logical(' Clouds are', 'do_clouds', this%do_clouds)
+
+ !---------------------------------------------------------------------
+ write(nulout, '(a)') 'Surface settings:'
+ if (this%do_sw) then
+ call print_logical(' Saving surface shortwave spectral fluxes', &
+ & 'do_surface_sw_spectral_flux', this%do_surface_sw_spectral_flux)
+ call print_logical(' Saving surface shortwave fluxes in abledo bands', &
+ & 'do_canopy_fluxes_sw', this%do_canopy_fluxes_sw)
+ end if
+ if (this%do_lw) then
+ call print_logical(' Saving surface longwave fluxes in emissivity bands', &
+ & 'do_canopy_fluxes_lw', this%do_canopy_fluxes_lw)
+ call print_logical(' Longwave derivative calculation is', &
+ & 'do_lw_derivatives',this%do_lw_derivatives)
+ end if
+ if (this%do_sw) then
+ call print_logical(' Nearest-neighbour spectral albedo mapping', &
+ & 'do_nearest_spectral_sw_albedo', this%do_nearest_spectral_sw_albedo)
+ end if
+ if (this%do_lw) then
+ call print_logical(' Nearest-neighbour spectral emissivity mapping', &
+ & 'do_nearest_spectral_lw_emiss', this%do_nearest_spectral_lw_emiss)
+ end if
+ !---------------------------------------------------------------------
+ if (this%do_clouds) then
+ write(nulout, '(a)') 'Cloud settings:'
+ call print_real(' Cloud fraction threshold', &
+ & 'cloud_fraction_threshold', this%cloud_fraction_threshold)
+ call print_real(' Cloud mixing-ratio threshold', &
+ & 'cloud_mixing_ratio_threshold', this%cloud_mixing_ratio_threshold)
+ call print_enum(' Liquid optics scheme is', LiquidModelName, &
+ & 'i_liq_model',this%i_liq_model)
+ call print_enum(' Ice optics scheme is', IceModelName, &
+ & 'i_ice_model',this%i_ice_model)
+ if (this%i_ice_model == IIceModelFu) then
+ call print_logical(' Longwave ice optics bug in Fu scheme is', &
+ & 'do_fu_lw_ice_optics_bug',this%do_fu_lw_ice_optics_bug)
+ end if
+ call print_enum(' Cloud overlap scheme is', OverlapName, &
+ & 'i_overlap_scheme',this%i_overlap_scheme)
+ call print_logical(' Use "beta" overlap parameter is', &
+ & 'use_beta_overlap', this%use_beta_overlap)
+ call print_enum(' Cloud PDF shape is', PdfShapeName, &
+ & 'i_cloud_pdf_shape',this%i_cloud_pdf_shape)
+ call print_real(' Cloud inhom decorrelation scaling', &
+ & 'cloud_inhom_decorr_scaling', this%cloud_inhom_decorr_scaling)
+ end if
+
+ !---------------------------------------------------------------------
+ write(nulout, '(a)') 'Solver settings:'
+ if (this%do_sw) then
+ call print_enum(' Shortwave solver is', SolverName, &
+ & 'i_solver_sw', this%i_solver_sw)
+
+ if (this%i_gas_model == IGasModelMonochromatic) then
+ call print_real(' Shortwave atmospheric optical depth', &
+ & 'mono_sw_total_od', this%mono_sw_total_od)
+ call print_real(' Shortwave particulate single-scattering albedo', &
+ & 'mono_sw_single_scattering_albedo', &
+ & this%mono_sw_single_scattering_albedo)
+ call print_real(' Shortwave particulate asymmetry factor', &
+ & 'mono_sw_asymmetry_factor', &
+ & this%mono_sw_asymmetry_factor)
+ end if
+ call print_logical(' Shortwave delta scaling after merge with gases', &
+ & 'do_sw_delta_scaling_with_gases', &
+ & this%do_sw_delta_scaling_with_gases)
+ else
+ call print_logical(' Shortwave calculations are','do_sw',this%do_sw)
+ end if
+
+ if (this%do_lw) then
+ call print_enum(' Longwave solver is', SolverName, 'i_solver_lw', &
+ & this%i_solver_lw)
+
+ if (this%i_gas_model == IGasModelMonochromatic) then
+ if (this%mono_lw_wavelength > 0.0_jprb) then
+ call print_real(' Longwave effective wavelength (m)', &
+ & 'mono_lw_wavelength', this%mono_lw_wavelength)
+ else
+ write(nulout,'(a)') ' Longwave fluxes are broadband (mono_lw_wavelength<=0)'
+ end if
+ call print_real(' Longwave atmospheric optical depth', &
+ & 'mono_lw_total_od', this%mono_lw_total_od)
+ call print_real(' Longwave particulate single-scattering albedo', &
+ & 'mono_lw_single_scattering_albedo', &
+ & this%mono_lw_single_scattering_albedo)
+ call print_real(' Longwave particulate asymmetry factor', &
+ & 'mono_lw_asymmetry_factor', &
+ & this%mono_lw_asymmetry_factor)
+ end if
+ call print_logical(' Longwave cloud scattering is', &
+ & 'do_lw_cloud_scattering',this%do_lw_cloud_scattering)
+ call print_logical(' Longwave aerosol scattering is', &
+ & 'do_lw_aerosol_scattering',this%do_lw_aerosol_scattering)
+ else
+ call print_logical(' Longwave calculations are','do_lw', this%do_lw)
+ end if
+
+ if (this%i_solver_sw == ISolverSpartacus &
+ & .or. this%i_solver_lw == ISolverSpartacus) then
+ write(nulout, '(a)') ' SPARTACUS options:'
+ call print_integer(' Number of regions', 'n_regions', this%nregions)
+ call print_real(' Max cloud optical depth per layer', &
+ & 'max_cloud_od', this%max_cloud_od)
+ call print_enum(' Shortwave entrapment is', EntrapmentName, &
+ & 'i_3d_sw_entrapment', this%i_3d_sw_entrapment)
+ call print_logical(' Multilayer longwave horizontal transport is', &
+ 'do_3d_lw_multilayer_effects', this%do_3d_lw_multilayer_effects)
+ call print_logical(' Use matrix exponential everywhere is', &
+ & 'use_expm_everywhere', this%use_expm_everywhere)
+ call print_logical(' 3D effects are', 'do_3d_effects', &
+ & this%do_3d_effects)
+
+ if (this%do_3d_effects) then
+ call print_logical(' Longwave side emissivity parameterization is', &
+ & 'do_lw_side_emissivity', this%do_lw_side_emissivity)
+ call print_real(' Clear-to-thick edge fraction is', &
+ & 'clear_to_thick_fraction', this%clear_to_thick_fraction)
+ call print_real(' Overhead sun factor is', &
+ & 'overhead_sun_factor', this%overhead_sun_factor)
+ call print_real(' Max gas optical depth for 3D effects', &
+ & 'max_gas_od_3d', this%max_gas_od_3d)
+ call print_real(' Max 3D transfer rate', &
+ & 'max_3d_transfer_rate', this%max_3d_transfer_rate)
+ call print_real(' Min cloud effective size (m)', &
+ & 'min_cloud_effective_size', this%min_cloud_effective_size)
+ call print_real(' Overhang factor', &
+ & 'overhang_factor', this%overhang_factor)
+ end if
+ end if
+
+ end if
+
+ end subroutine print_config
+
+
+
+ !---------------------------------------------------------------------
+ ! In order to estimate UV and photosynthetically active radiation,
+ ! we need weighted sum of fluxes considering wavelength range
+ ! required. This routine returns information for how to correctly
+ ! weight output spectral fluxes for a range of input wavelengths.
+ ! Note that this is approximate; internally it may be assumed that
+ ! the energy is uniformly distributed in wavenumber space, for
+ ! example. If the character string "weighting_name" is present, and
+ ! iverbose>=2, then information on the weighting will be provided on
+ ! nulout.
+ subroutine get_sw_weights(this, wavelength1, wavelength2, &
+ & nweights, iband, weight, weighting_name)
+
+ use parkind1, only : jprb
+ use radiation_io, only : nulout, nulerr, radiation_abort
+
+ class(config_type), intent(in) :: this
+ ! Range of wavelengths to get weights for (m)
+ real(jprb), intent(in) :: wavelength1, wavelength2
+ ! Output number of weights needed
+ integer, intent(out) :: nweights
+ ! Only write to the first nweights of these arrays: they contain
+ ! the indices to the non-zero bands, and the weight in each of
+ ! those bands
+ integer, intent(out) :: iband(:)
+ real(jprb), intent(out) :: weight(:)
+ character(len=*), optional, intent(in) :: weighting_name
+
+ ! Internally we deal with wavenumber
+ real(jprb) :: wavenumber1, wavenumber2 ! cm-1
+
+ integer :: jband ! Loop index for spectral band
+
+ if (this%n_bands_sw <= 0) then
+ write(nulerr,'(a)') '*** Error: get_sw_weights called before number of shortwave bands set'
+ call radiation_abort()
+ end if
+
+ ! Convert wavelength range (m) to wavenumber (cm-1)
+ wavenumber1 = 0.01_jprb / wavelength2
+ wavenumber2 = 0.01_jprb / wavelength1
+
+ nweights = 0
+
+ do jband = 1,this%n_bands_sw
+ if (wavenumber1 < this%wavenumber2_sw(jband) &
+ & .and. wavenumber2 > this%wavenumber1_sw(jband)) then
+ nweights = nweights+1
+ iband(nweights) = jband
+ weight(nweights) = (min(wavenumber2,this%wavenumber2_sw(jband)) &
+ & - max(wavenumber1,this%wavenumber1_sw(jband))) &
+ & / (this%wavenumber2_sw(jband) - this%wavenumber1_sw(jband))
+ end if
+ end do
+
+ if (nweights == 0) then
+ write(nulerr,'(a,e8.4,a,e8.4,a)') '*** Error: wavelength range ', &
+ & wavelength1, ' to ', wavelength2, ' m is outside shortwave band'
+ call radiation_abort()
+ else if (this%iverbosesetup >= 2 .and. present(weighting_name)) then
+ write(nulout,'(a,a,a,f6.0,a,f6.0,a)') 'Spectral weights for ', &
+ & weighting_name, ' (', wavenumber1, ' to ', &
+ & wavenumber2, ' cm-1):'
+ do jband = 1, nweights
+ write(nulout, '(a,i0,a,f6.0,a,f6.0,a,f8.4)') ' Shortwave band ', &
+ & iband(jband), ' (', this%wavenumber1_sw(iband(jband)), ' to ', &
+ & this%wavenumber2_sw(iband(jband)), ' cm-1): ', weight(jband)
+ end do
+ end if
+
+ end subroutine get_sw_weights
+
+
+ !---------------------------------------------------------------------
+ ! The input shortwave surface albedo coming in is likely to be in
+ ! different spectral intervals to the gas model in the radiation
+ ! scheme. We assume that the input albedo is defined within
+ ! "ninterval" spectral intervals covering the wavelength range 0 to
+ ! infinity, but allow for the possibility that two intervals may be
+ ! indexed back to the same albedo band.
+ subroutine define_sw_albedo_intervals(this, ninterval, wavelength_bound, &
+ & i_intervals, do_nearest)
+
+ use radiation_io, only : nulerr, radiation_abort
+
+ class(config_type), intent(inout) :: this
+ ! Number of spectral intervals in which albedo is defined
+ integer, intent(in) :: ninterval
+ ! Monotonically increasing wavelength bounds between intervals,
+ ! not including the outer bounds (which are assumed to be zero and
+ ! infinity)
+ real(jprb), intent(in) :: wavelength_bound(ninterval-1)
+ ! The albedo indices corresponding to each interval
+ integer, intent(in) :: i_intervals(ninterval)
+ logical, optional, intent(in) :: do_nearest
+
+ if (ninterval > NMaxAlbedoIntervals) then
+ write(nulerr,'(a,i0,a,i0)') '*** Error: ', ninterval, &
+ & ' albedo intervals exceeds maximum of ', NMaxAlbedoIntervals
+ call radiation_abort();
+ end if
+
+ if (present(do_nearest)) then
+ this%do_nearest_spectral_sw_albedo = do_nearest
+ else
+ this%do_nearest_spectral_sw_albedo = .false.
+ end if
+ this%sw_albedo_wavelength_bound(1:ninterval-1) = wavelength_bound(1:ninterval-1)
+ this%sw_albedo_wavelength_bound(ninterval:) = -1.0_jprb
+ this%i_sw_albedo_index(1:ninterval) = i_intervals(1:ninterval)
+ this%i_sw_albedo_index(ninterval+1:) = 0
+
+ if (this%is_consolidated) then
+ call this%consolidate_intervals(.true., &
+ & this%do_nearest_spectral_sw_albedo, &
+ & this%sw_albedo_wavelength_bound, this%i_sw_albedo_index, &
+ & this%wavenumber1_sw, this%wavenumber2_sw, &
+ & this%i_albedo_from_band_sw, this%sw_albedo_weights)
+ end if
+
+ end subroutine define_sw_albedo_intervals
+
+
+ !---------------------------------------------------------------------
+ ! As define_sw_albedo_intervals but for longwave emissivity
+ subroutine define_lw_emiss_intervals(this, ninterval, wavelength_bound, &
+ & i_intervals, do_nearest)
+
+ use radiation_io, only : nulerr, radiation_abort
+
+ class(config_type), intent(inout) :: this
+ ! Number of spectral intervals in which emissivity is defined
+ integer, intent(in) :: ninterval
+ ! Monotonically increasing wavelength bounds between intervals,
+ ! not including the outer bounds (which are assumed to be zero and
+ ! infinity)
+ real(jprb), intent(in) :: wavelength_bound(ninterval-1)
+ ! The emissivity indices corresponding to each interval
+ integer, intent(in) :: i_intervals(ninterval)
+ logical, optional, intent(in) :: do_nearest
+
+ if (ninterval > NMaxAlbedoIntervals) then
+ write(nulerr,'(a,i0,a,i0)') '*** Error: ', ninterval, &
+ & ' emissivity intervals exceeds maximum of ', NMaxAlbedoIntervals
+ call radiation_abort();
+ end if
+
+ if (present(do_nearest)) then
+ this%do_nearest_spectral_lw_emiss = do_nearest
+ else
+ this%do_nearest_spectral_lw_emiss = .false.
+ end if
+ this%lw_emiss_wavelength_bound(1:ninterval-1) = wavelength_bound(1:ninterval-1)
+ this%lw_emiss_wavelength_bound(ninterval:) = -1.0_jprb
+ this%i_lw_emiss_index(1:ninterval) = i_intervals(1:ninterval)
+ this%i_lw_emiss_index(ninterval+1:) = 0
+
+ if (this%is_consolidated) then
+ call this%consolidate_intervals(.false., &
+ & this%do_nearest_spectral_lw_emiss, &
+ & this%lw_emiss_wavelength_bound, this%i_lw_emiss_index, &
+ & this%wavenumber1_lw, this%wavenumber2_lw, &
+ & this%i_emiss_from_band_lw, this%lw_emiss_weights)
+ end if
+
+ end subroutine define_lw_emiss_intervals
+
+
+ !---------------------------------------------------------------------
+ ! This routine consolidates either the input shortwave albedo
+ ! intervals with the shortwave bands, or the input longwave
+ ! emissivity intervals with the longwave bands, depending on the
+ ! arguments provided.
+ subroutine consolidate_intervals(this, is_sw, do_nearest, &
+ & wavelength_bound, i_intervals, wavenumber1, wavenumber2, &
+ & i_mapping, weights)
+
+ use radiation_io, only : nulout, nulerr, radiation_abort
+
+ class(config_type), intent(inout) :: this
+ ! Is this the shortwave? Otherwise longwave
+ logical, intent(in) :: is_sw
+ ! Do we find the nearest albedo interval to the centre of each
+ ! band, or properly weight the contributions? This can be modified
+ ! if there is only one albedo intervals.
+ logical, intent(inout) :: do_nearest
+ ! Monotonically increasing wavelength bounds between intervals,
+ ! not including the outer bounds (which are assumed to be zero and
+ ! infinity)
+ real(jprb), intent(in) :: wavelength_bound(NMaxAlbedoIntervals-1)
+ ! The albedo band indices corresponding to each interval
+ integer, intent(in) :: i_intervals(NMaxAlbedoIntervals)
+ ! Start and end wavenumber bounds for the ecRad bands (cm-1)
+ real(jprb), intent(in) :: wavenumber1(:), wavenumber2(:)
+
+ ! if do_nearest is TRUE then the result is expressed in i_mapping,
+ ! which will be allocated to have the same length as wavenumber1,
+ ! and contain the index of the albedo interval corresponding to
+ ! that band
+ integer, allocatable, intent(inout) :: i_mapping(:)
+ ! ...otherwise the result is expressed in "weights", of
+ ! size(n_intervals, n_bands) containing how much of each interval
+ ! contributes to each band.
+ real(jprb), allocatable, intent(inout) :: weights(:,:)
+
+ ! Number and loop index of ecRad bands
+ integer :: nband, jband
+ ! Number and index of albedo/emissivity intervals
+ integer :: ninterval, iinterval
+ ! Sometimes an albedo or emissivity value will be used in more
+ ! than one interval, so nvalue indicates how many values will
+ ! actually be provided
+ integer :: nvalue
+ ! Wavenumber bounds of the albedo/emissivity interval
+ real(jprb) :: wavenumber1_albedo, wavenumber2_albedo
+ ! Reciprocal of the wavenumber range of the ecRad band
+ real(jprb) :: recip_dwavenumber ! cm
+ ! Midpoint/bound of wavenumber band
+ real(jprb) :: wavenumber_mid, wavenumber_bound ! cm-1
+
+ nband = size(wavenumber1)
+
+ ! Count the number of albedo/emissivity intervals
+ ninterval = 0
+ do iinterval = 1,NMaxAlbedoIntervals
+ if (i_intervals(iinterval) > 0) then
+ ninterval = iinterval
+ else
+ exit
+ end if
+ end do
+
+ if (ninterval < 2) then
+ ! Zero or one albedo/emissivity intervals found, so we index all
+ ! bands to one interval
+ if (allocated(i_mapping)) then
+ deallocate(i_mapping)
+ end if
+ allocate(i_mapping(nband))
+ i_mapping(:) = 1
+ do_nearest = .true.
+ ninterval = 1
+ nvalue = 1
+ else
+ ! Check wavelength is monotonically increasing
+ do jband = 2,ninterval-1
+ if (wavelength_bound(jband) <= wavelength_bound(jband-1)) then
+ if (is_sw) then
+ write(nulerr, '(a,a)') '*** Error: wavelength bounds for shortwave albedo intervals ', &
+ & 'must be monotonically increasing'
+ else
+ write(nulerr, '(a,a)') '*** Error: wavelength bounds for longwave emissivity intervals ', &
+ & 'must be monotonically increasing'
+ end if
+ call radiation_abort()
+ end if
+ end do
+
+ ! What is the maximum index, indicating the number of
+ ! albedo/emissivity values to expect?
+ nvalue = maxval(i_intervals(1:ninterval))
+
+ if (do_nearest) then
+ ! Simpler nearest-neighbour mapping from band to
+ ! albedo/emissivity interval
+ if (allocated(i_mapping)) then
+ deallocate(i_mapping)
+ end if
+ allocate(i_mapping(nband))
+
+ ! Loop over bands
+ do jband = 1,nband
+ ! Compute mid-point of band in wavenumber space (cm-1)
+ wavenumber_mid = 0.5_jprb * (wavenumber1(jband) &
+ & + wavenumber2(jband))
+ iinterval = 1
+ ! Convert wavelength (m) into wavenumber (cm-1) at the lower
+ ! bound of the albedo interval
+ wavenumber_bound = 0.01_jprb / wavelength_bound(iinterval)
+ ! Find the albedo interval that has the largest overlap with
+ ! the band; this approach assumes that the albedo intervals
+ ! are larger than the spectral bands
+ do while (wavenumber_bound >= wavenumber_mid &
+ & .and. iinterval < ninterval)
+ iinterval = iinterval + 1
+ if (iinterval < ninterval) then
+ wavenumber_bound = 0.01_jprb / wavelength_bound(iinterval)
+ else
+ ! For the last interval there is no lower bound
+ wavenumber_bound = 0.0_jprb
+ end if
+ end do
+ ! Save the index of the band corresponding to the albedo
+ ! interval and move onto the next band
+ i_mapping(jband) = i_intervals(iinterval)
+ end do
+ else
+ ! More accurate weighting
+ if (allocated(weights)) then
+ deallocate(weights)
+ end if
+ allocate(weights(nvalue,nband))
+ weights(:,:) = 0.0_jprb
+
+ ! Loop over bands
+ do jband = 1,nband
+ recip_dwavenumber = 1.0_jprb / (wavenumber2(jband) &
+ & - wavenumber1(jband))
+ ! Find the first overlapping albedo band
+ iinterval = 1
+ ! Convert wavelength (m) into wavenumber (cm-1) at the lower
+ ! bound (in wavenumber space) of the albedo/emissivty interval
+ wavenumber1_albedo = 0.01_jprb / wavelength_bound(iinterval)
+ do while (wavenumber1_albedo >= wavenumber2(jband) &
+ & .and. iinterval < ninterval)
+ iinterval = iinterval + 1
+ wavenumber1_albedo = 0.01_jprb / wavelength_bound(iinterval)
+ end do
+
+ wavenumber2_albedo = wavenumber2(jband)
+
+ ! Add all overlapping bands
+ do while (wavenumber2_albedo > wavenumber1(jband) &
+ & .and. iinterval <= ninterval)
+ weights(i_intervals(iinterval),jband) &
+ & = weights(i_intervals(iinterval),jband) &
+ & + recip_dwavenumber &
+ & * (min(wavenumber2_albedo,wavenumber2(jband)) &
+ & - max(wavenumber1_albedo,wavenumber1(jband)))
+ wavenumber2_albedo = wavenumber1_albedo
+ iinterval = iinterval + 1
+ if (iinterval < ninterval) then
+ wavenumber1_albedo = 0.01_jprb / wavelength_bound(iinterval)
+ else
+ wavenumber1_albedo = 0.0_jprb
+ end if
+ end do
+ end do
+ end if
+ end if
+
+ ! Define how many bands to use for reporting surface downwelling
+ ! fluxes for canopy radiation scheme
+ if (is_sw) then
+ if (this%use_canopy_full_spectrum_sw) then
+ this%n_canopy_bands_sw = this%n_g_sw
+ else
+ this%n_canopy_bands_sw = nvalue
+ end if
+ else
+ if (this%use_canopy_full_spectrum_lw) then
+ this%n_canopy_bands_lw = this%n_g_lw
+ else
+ this%n_canopy_bands_lw = nvalue
+ end if
+ end if
+
+ if (this%iverbosesetup >= 2) then
+ if (.not. do_nearest) then
+ if (is_sw) then
+ write(nulout, '(a,i0,a,i0,a)') 'Weighting of ', nvalue, ' albedo values in ', &
+ & nband, ' shortwave bands (wavenumber ranges in cm-1):'
+ else
+ write(nulout, '(a,i0,a,i0,a)') 'Weighting of ', nvalue, ' emissivity values in ', &
+ & nband, ' longwave bands (wavenumber ranges in cm-1):'
+ end if
+ do jband = 1,nband
+ write(nulout,'(i6,a,i6,a)',advance='no') nint(wavenumber1(jband)), ' to', &
+ & nint(wavenumber2(jband)), ':'
+ do iinterval = 1,nvalue
+ write(nulout,'(f5.2)',advance='no') weights(iinterval,jband)
+ end do
+ write(nulout, '()')
+ end do
+ else if (ninterval <= 1) then
+ if (is_sw) then
+ write(nulout, '(a)') 'All shortwave bands will use the same albedo'
+ else
+ write(nulout, '(a)') 'All longwave bands will use the same emissivty'
+ end if
+ else
+ if (is_sw) then
+ write(nulout, '(a,i0,a)',advance='no') 'Mapping from ', nband, &
+ & ' shortwave bands to albedo intervals:'
+ else
+ write(nulout, '(a,i0,a)',advance='no') 'Mapping from ', nband, &
+ & ' longwave bands to emissivity intervals:'
+ end if
+ do jband = 1,nband
+ write(nulout,'(a,i0)',advance='no') ' ', i_mapping(jband)
+ end do
+ write(nulout, '()')
+ end if
+ end if
+
+ end subroutine consolidate_intervals
+
+
+ !---------------------------------------------------------------------
+ ! Return the 0-based index for str in enum_str, or abort if it is
+ ! not found
+ subroutine get_enum_code(str, enum_str, var_name, icode)
+
+ use radiation_io, only : nulerr, radiation_abort
+
+ character(len=*), intent(in) :: str
+ character(len=*), intent(in) :: enum_str(0:)
+ character(len=*), intent(in) :: var_name
+ integer, intent(out) :: icode
+
+ integer :: jc
+ logical :: is_not_found
+
+ ! If string is empty then we don't modify icode but assume it has
+ ! a sensible default value
+ if (len_trim(str) > 1) then
+ is_not_found = .true.
+
+ do jc = 0,size(enum_str)-1
+ if (trim(str) == trim(enum_str(jc))) then
+ icode = jc
+ is_not_found = .false.
+ exit
+ end if
+ end do
+ if (is_not_found) then
+ write(nulerr,'(a,a,a,a,a)',advance='no') '*** Error: ', trim(var_name), &
+ & ' must be one of: "', enum_str(0), '"'
+ do jc = 1,size(enum_str)-1
+ write(nulerr,'(a,a,a)',advance='no') ', "', trim(enum_str(jc)), '"'
+ end do
+ write(nulerr,'(a)') ''
+ call radiation_abort('Radiation configuration error')
+ end if
+ end if
+
+ end subroutine get_enum_code
+
+
+ !---------------------------------------------------------------------
+ ! Print one line of information: logical
+ subroutine print_logical(message_str, name, val)
+ use radiation_io, only : nulout
+ character(len=*), intent(in) :: message_str
+ character(len=*), intent(in) :: name
+ logical, intent(in) :: val
+ character(4) :: on_or_off
+ character(NPrintStringLen) :: str
+ if (val) then
+ on_or_off = ' ON '
+ else
+ on_or_off = ' OFF'
+ end if
+ write(str, '(a,a4)') message_str, on_or_off
+ write(nulout,'(a,a,a,a,l1,a)') str, ' (', name, '=', val,')'
+ end subroutine print_logical
+
+
+ !---------------------------------------------------------------------
+ ! Print one line of information: integer
+ subroutine print_integer(message_str, name, val)
+ use radiation_io, only : nulout
+ character(len=*), intent(in) :: message_str
+ character(len=*), intent(in) :: name
+ integer, intent(in) :: val
+ character(NPrintStringLen) :: str
+ write(str, '(a,a,i0)') message_str, ' = ', val
+ write(nulout,'(a,a,a,a)') str, ' (', name, ')'
+ end subroutine print_integer
+
+
+ !---------------------------------------------------------------------
+ ! Print one line of information: real
+ subroutine print_real(message_str, name, val)
+ use parkind1, only : jprb
+ use radiation_io, only : nulout
+ character(len=*), intent(in) :: message_str
+ character(len=*), intent(in) :: name
+ real(jprb), intent(in) :: val
+ character(NPrintStringLen) :: str
+ write(str, '(a,a,g8.3)') message_str, ' = ', val
+ write(nulout,'(a,a,a,a)') str, ' (', name, ')'
+ end subroutine print_real
+
+
+ !---------------------------------------------------------------------
+ ! Print one line of information: enum
+ subroutine print_enum(message_str, enum_str, name, val)
+ use radiation_io, only : nulout
+ character(len=*), intent(in) :: message_str
+ character(len=*), intent(in) :: enum_str(0:)
+ character(len=*), intent(in) :: name
+ integer, intent(in) :: val
+ character(NPrintStringLen) :: str
+ write(str, '(a,a,a,a)') message_str, ' "', trim(enum_str(val)), '"'
+ write(nulout,'(a,a,a,a,i0,a)') str, ' (', name, '=', val,')'
+ end subroutine print_enum
+
+
+ !---------------------------------------------------------------------
+ ! Return .true. if 1D allocatable array "var" is out of physical
+ ! range specified by boundmin and boundmax, and issue a warning.
+ ! "do_fix" determines whether erroneous values are fixed to lie
+ ! within the physical range. To check only a subset of the array,
+ ! specify i1 and i2 for the range.
+ function out_of_bounds_1d(var, var_name, boundmin, boundmax, do_fix, i1, i2) result (is_bad)
+
+ use radiation_io, only : nulout
+
+ real(jprb), allocatable, intent(inout) :: var(:)
+ character(len=*), intent(in) :: var_name
+ real(jprb), intent(in) :: boundmin, boundmax
+ logical, intent(in) :: do_fix
+ integer, optional, intent(in) :: i1, i2
+
+ logical :: is_bad
+
+ real(jprb) :: varmin, varmax
+
+ is_bad = .false.
+
+ if (allocated(var)) then
+
+ if (present(i1) .and. present(i2)) then
+ varmin = minval(var(i1:i2))
+ varmax = maxval(var(i1:i2))
+ else
+ varmin = minval(var)
+ varmax = maxval(var)
+ end if
+
+ if (varmin < boundmin .or. varmax > boundmax) then
+ write(nulout,'(a,a,a,g12.4,a,g12.4,a,g12.4,a,g12.4)',advance='no') &
+ & '*** Warning: ', var_name, ' range', varmin, ' to', varmax, &
+ & ' is out of physical range', boundmin, 'to', boundmax
+ is_bad = .true.
+ if (do_fix) then
+ if (present(i1) .and. present(i2)) then
+ var(i1:i2) = max(boundmin, min(boundmax, var(i1:i2)))
+ else
+ var = max(boundmin, min(boundmax, var))
+ end if
+ write(nulout,'(a)') ': corrected'
+ else
+ write(nulout,'(1x)')
+ end if
+ end if
+
+ end if
+
+ end function out_of_bounds_1d
+
+
+ !---------------------------------------------------------------------
+ ! Return .true. if 2D allocatable array "var" is out of physical
+ ! range specified by boundmin and boundmax, and issue a warning. To
+ ! check only a subset of the array, specify i1 and i2 for the range
+ ! of the first dimension and j1 and j2 for the range of the second.
+ function out_of_bounds_2d(var, var_name, boundmin, boundmax, do_fix, &
+ & i1, i2, j1, j2) result (is_bad)
+
+ use radiation_io, only : nulout
+
+ real(jprb), allocatable, intent(inout) :: var(:,:)
+ character(len=*), intent(in) :: var_name
+ real(jprb), intent(in) :: boundmin, boundmax
+ logical, intent(in) :: do_fix
+ integer, optional, intent(in) :: i1, i2, j1, j2
+
+ ! Local copies of indices
+ integer :: ii1, ii2, jj1, jj2
+
+ logical :: is_bad
+
+ real(jprb) :: varmin, varmax
+
+ is_bad = .false.
+
+ if (allocated(var)) then
+
+ if (present(i1) .and. present(i2)) then
+ ii1 = i1
+ ii2 = i2
+ else
+ ii1 = lbound(var,1)
+ ii2 = ubound(var,1)
+ end if
+ if (present(j1) .and. present(j2)) then
+ jj1 = j1
+ jj2 = j2
+ else
+ jj1 = lbound(var,2)
+ jj2 = ubound(var,2)
+ end if
+ varmin = minval(var(ii1:ii2,jj1:jj2))
+ varmax = maxval(var(ii1:ii2,jj1:jj2))
+
+ if (varmin < boundmin .or. varmax > boundmax) then
+ write(nulout,'(a,a,a,g12.4,a,g12.4,a,g12.4,a,g12.4)',advance='no') &
+ & '*** Warning: ', var_name, ' range', varmin, ' to', varmax,&
+ & ' is out of physical range', boundmin, 'to', boundmax
+ is_bad = .true.
+ if (do_fix) then
+ var(ii1:ii2,jj1:jj2) = max(boundmin, min(boundmax, var(ii1:ii2,jj1:jj2)))
+ write(nulout,'(a)') ': corrected'
+ else
+ write(nulout,'(1x)')
+ end if
+ end if
+
+ end if
+
+ end function out_of_bounds_2d
+
+
+ !---------------------------------------------------------------------
+ ! Return .true. if 3D allocatable array "var" is out of physical
+ ! range specified by boundmin and boundmax, and issue a warning. To
+ ! check only a subset of the array, specify i1 and i2 for the range
+ ! of the first dimension, j1 and j2 for the second and k1 and k2 for
+ ! the third.
+ function out_of_bounds_3d(var, var_name, boundmin, boundmax, do_fix, &
+ & i1, i2, j1, j2, k1, k2) result (is_bad)
+
+ use radiation_io, only : nulout
+
+ real(jprb), allocatable, intent(inout) :: var(:,:,:)
+ character(len=*), intent(in) :: var_name
+ real(jprb), intent(in) :: boundmin, boundmax
+ logical, intent(in) :: do_fix
+ integer, optional, intent(in) :: i1, i2, j1, j2, k1, k2
+
+ ! Local copies of indices
+ integer :: ii1, ii2, jj1, jj2, kk1, kk2
+
+ logical :: is_bad
+
+ real(jprb) :: varmin, varmax
+
+ is_bad = .false.
+
+ if (allocated(var)) then
+
+ if (present(i1) .and. present(i2)) then
+ ii1 = i1
+ ii2 = i2
+ else
+ ii1 = lbound(var,1)
+ ii2 = ubound(var,1)
+ end if
+ if (present(j1) .and. present(j2)) then
+ jj1 = j1
+ jj2 = j2
+ else
+ jj1 = lbound(var,2)
+ jj2 = ubound(var,2)
+ end if
+ if (present(k1) .and. present(k2)) then
+ kk1 = k1
+ kk2 = k2
+ else
+ kk1 = lbound(var,3)
+ kk2 = ubound(var,3)
+ end if
+ varmin = minval(var(ii1:ii2,jj1:jj2,kk1:kk2))
+ varmax = maxval(var(ii1:ii2,jj1:jj2,kk1:kk2))
+
+ if (varmin < boundmin .or. varmax > boundmax) then
+ write(nulout,'(a,a,a,g12.4,a,g12.4,a,g12.4,a,g12.4)',advance='no') &
+ & '*** Warning: ', var_name, ' range', varmin, ' to', varmax,&
+ & ' is out of physical range', boundmin, 'to', boundmax
+ is_bad = .true.
+ if (do_fix) then
+ var(ii1:ii2,jj1:jj2,kk1:kk2) = max(boundmin, min(boundmax, &
+ & var(ii1:ii2,jj1:jj2,kk1:kk2)))
+ write(nulout,'(a)') ': corrected'
+ else
+ write(nulout,'(1x)')
+ end if
+ end if
+
+ end if
+
+ end function out_of_bounds_3d
+
+
+end module radiation_config
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_delta_eddington.h b/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_delta_eddington.h
new file mode 100644
index 0000000000000000000000000000000000000000..04f43bafde36958c84e50a5662009d817975b3a2
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_delta_eddington.h
@@ -0,0 +1,93 @@
+! radiation_delta_eddington.h - Delta-Eddington scaling
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author: Robin Hogan
+! Email: r.j.hogan@ecmwf.int
+!
+! This file is intended to be included inside a module to ensure that
+! these simple functions may be inlined
+
+!---------------------------------------------------------------------
+! Perform in-place delta-Eddington scaling of the phase function
+elemental subroutine delta_eddington(od, ssa, g)
+
+ use parkind1, only : jprb
+
+ ! Total optical depth, single scattering albedo and asymmetry
+ ! factor
+ real(jprb), intent(inout) :: od, ssa, g
+
+ ! Fraction of the phase function deemed to be in the forward lobe
+ ! and therefore treated as if it is not scattered at all
+ real(jprb) :: f
+
+ f = g*g
+ od = od * (1.0_jprb - ssa*f)
+ ssa = ssa * (1.0_jprb - f) / (1.0_jprb - ssa*f)
+ g = g / (1.0_jprb + g)
+
+end subroutine delta_eddington
+
+
+!---------------------------------------------------------------------
+! Perform in-place delta-Eddington scaling of the phase function, but
+! using extensive variables (i.e. the scattering optical depth,
+! scat_od, rather than the single-scattering albedo, and the
+! scattering-optical-depth-multiplied-by-asymmetry-factor, scat_od_g,
+! rather than the asymmetry factor.
+elemental subroutine delta_eddington_extensive(od, scat_od, scat_od_g)
+
+ use parkind1, only : jprb
+
+ ! Total optical depth, scattering optical depth and asymmetry factor
+ ! multiplied by the scattering optical depth
+ real(jprb), intent(inout) :: od, scat_od, scat_od_g
+
+ ! Fraction of the phase function deemed to be in the forward lobe
+ ! and therefore treated as if it is not scattered at all
+ real(jprb) :: f, g
+
+ if (scat_od > 0.0_jprb) then
+ g = scat_od_g / scat_od
+ else
+ g = 0.0
+ end if
+
+ f = g*g
+ od = od - scat_od * f
+ scat_od = scat_od * (1.0_jprb - f)
+ scat_od_g = scat_od * g / (1.0_jprb + g)
+
+end subroutine delta_eddington_extensive
+
+
+!---------------------------------------------------------------------
+! Perform in-place delta-Eddington scaling of the phase function,
+! using the scattering optical depth rather than the single scattering
+! albedo
+elemental subroutine delta_eddington_scat_od(od, scat_od, g)
+
+ use parkind1, only : jprb
+
+ ! Total optical depth, scattering optical depth and asymmetry factor
+ real(jprb), intent(inout) :: od, scat_od, g
+
+ ! Fraction of the phase function deemed to be in the forward lobe
+ ! and therefore treated as if it is not scattered at all
+ real(jprb) :: f
+
+ f = g*g
+ od = od - scat_od * f
+ scat_od = scat_od * (1.0_jprb - f)
+ g = g / (1.0_jprb + g)
+
+end subroutine delta_eddington_scat_od
+
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_ice_optics_shapes.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_ice_optics_shapes.F90
new file mode 100644
index 0000000000000000000000000000000000000000..011f2666e762e97b6c081ef98f0b1710620277db
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/radiation/radiation_ice_optics_shapes.F90
@@ -0,0 +1,142 @@
+! radiation_ice_optics_shapes.F90 -
+!
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Authors: Marie Taufour
+! Email: marie.taufour@aero.obs-mip.fr
+!
+! The reference for this ice optics parameterization is ....
+
+module radiation_ice_optics_shapes
+
+ implicit none
+ public
+
+ ! The number of ice coefficients depends on the parameterization
+ integer, parameter :: NIceOpticsCoeffsShapesSW = 69
+ integer, parameter :: NIceOpticsCoeffsShapesLW = 69
+
+ integer, parameter :: NSingleCoeffs = 23
+
+contains
+
+ !---------------------------------------------------------------------
+ ! Compute shortwave ice-particle scattering properties using Yi et
+ ! al. (2013) parameterization
+ subroutine calc_ice_optics_shapes_sw(nb, coeff, ice_wp, &
+ & re, od, scat_od, g)
+
+ use parkind1, only : jprb, jpim
+ !use yomhook, only : lhook, dr_hook
+
+ ! Number of bands
+ integer, intent(in) :: nb
+ ! Coefficients read from a data file
+ real(jprb), intent(in) :: coeff(:,:)
+ ! Ice water path (kg m-2)
+ real(jprb), intent(in) :: ice_wp
+ ! Effective radius (m)
+ real(jprb), intent(in) :: re
+ ! Total optical depth, scattering optical depth and asymmetry factor
+ real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+
+ ! Yi's effective diameter (microns)
+ real(jprb) :: de_um
+ ! Ice water path in g m-2
+ real (jprb) :: iwp_gm_2
+ ! LUT temp variables
+ real(jprb) :: wts_1, wts_2
+ integer(jpim) :: lu_idx
+ real(kind=jprb), parameter :: lu_scale = 0.2_jprb
+ real(kind=jprb), parameter :: lu_offset = 1.0_jprb
+ !real(jprb) :: hook_handle
+
+ !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_sw',0,hook_handle)
+
+ ! Convert to effective diameter using the relationship in the IFS
+ !de_um = re * (1.0e6_jprb / 0.64952_jprb)
+ de_um = re * 2.0e6_jprb
+
+ ! limit de_um to validity of LUT
+ de_um = max(de_um,10.0_jprb)
+ de_um = min(de_um,119.99_jprb) !avoid greater than or equal to 120 um
+
+ iwp_gm_2 = ice_wp * 1000.0_jprb
+
+ lu_idx = floor(de_um * lu_scale - lu_offset)
+ wts_2 = (de_um * lu_scale - lu_offset) - lu_idx
+ wts_1 = 1.0_jprb - wts_2
+ od = 0.001_jprb * iwp_gm_2 * &
+ & ( wts_1 * coeff(1:nb,lu_idx) + wts_2 * coeff(1:nb,lu_idx+1) )
+ scat_od = od * &
+ & ( wts_1 * coeff(1:nb,lu_idx+NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+NSingleCoeffs+1) )
+ g = wts_1 * coeff(1:nb,lu_idx+2*NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+2*NSingleCoeffs+1)
+
+ !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_sw',1,hook_handle)
+
+ end subroutine calc_ice_optics_shapes_sw
+
+
+ !---------------------------------------------------------------------
+ ! Compute longwave ice-particle scattering properties using .....
+ subroutine calc_ice_optics_shapes_lw(nb, coeff, ice_wp, &
+ & re, od, scat_od, g)
+
+ use parkind1, only : jprb, jpim
+ !use yomhook, only : lhook, dr_hook
+
+ ! Number of bands
+ integer, intent(in) :: nb
+ ! Coefficients read from a data file
+ real(jprb), intent(in) :: coeff(:,:)
+ ! Ice water path (kg m-2)
+ real(jprb), intent(in) :: ice_wp
+ ! Effective radius (m)
+ real(jprb), intent(in) :: re
+ ! Total optical depth, scattering optical depth and asymmetry factor
+ real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
+
+ ! Yi's effective diameter (microns)
+ real(jprb) :: de_um
+ ! Ice water path in g m-2
+ real (jprb) :: iwp_gm_2
+ ! LUT temp variables
+ real(jprb) :: wts_1, wts_2
+ integer(jpim) :: lu_idx
+ real(kind=jprb), parameter :: lu_scale = 0.2_jprb
+ real(kind=jprb), parameter :: lu_offset = 1.0_jprb
+ !real(jprb) :: hook_handle
+
+ !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_sw',0,hook_handle)
+
+ ! Convert to effective diameter using the relationship in the IFS
+ !de_um = re * (1.0e6_jprb / 0.64952_jprb)
+ de_um = re * 2.0e6_jprb
+
+ ! limit de_um to validity of LUT
+ de_um = max(de_um,10.0_jprb)
+ de_um = min(de_um,119.99_jprb) !avoid greater than or equal to 120 um
+
+ iwp_gm_2 = ice_wp * 1000.0_jprb
+
+ lu_idx = floor(de_um * lu_scale - lu_offset)
+ wts_2 = (de_um * lu_scale - lu_offset) - lu_idx
+ wts_1 = 1.0_jprb - wts_2
+ od = 0.001_jprb * iwp_gm_2 * &
+ & ( wts_1 * coeff(1:nb,lu_idx) + wts_2 * coeff(1:nb,lu_idx+1) )
+ scat_od = od * &
+ & ( wts_1 * coeff(1:nb,lu_idx+NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+NSingleCoeffs+1) )
+ g = wts_1 * coeff(1:nb,lu_idx+2*NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+2*NSingleCoeffs+1)
+
+ !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_lw',1,hook_handle)
+
+ end subroutine calc_ice_optics_shapes_lw
+
+end module radiation_ice_optics_shapes
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index af05775a2b95509532bbd908220dd6903b158828..a559613545d75c5813985ec8cbe715c7b435442e 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2024 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.
@@ -20,6 +20,7 @@
! P. Wautelet 07/12/2020: add support for partial write of fields (optional argument: koffset, not all subroutines, no LFI spport)
! P. Wautelet 14/01/2021: add IO_Field_write_byname_N4 and IO_Field_write_byfield_N4 subroutines
! P. Wautelet 07/04/2023: correct IO_Field_user_write examples
+! P. Wautelet 08/01/2024: add zero-size check for monoprocess runs
!-----------------------------------------------------------------
#define MNH_SCALARS_IN_SPLITFILES 0
@@ -673,6 +674,12 @@ end subroutine IO_Ndimlist_reduce
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
+ IF ( SIZE(PFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
if ( Present( koffset ) ) then
!if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, pfield, koffset, iresp_lfi )
if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, pfield, koffset, iresp_nc4 )
@@ -821,6 +828,12 @@ end subroutine IO_Ndimlist_reduce
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
+ IF ( SIZE(PFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X2','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
Allocate( tzfield, source = tpfield )
@@ -1102,6 +1115,12 @@ end subroutine IO_Ndimlist_reduce
IF (IRESP==0) THEN
IF (GSMONOPROC .AND. TPFILE%NSUBFILES_IOZ==0 ) THEN ! sequential execution
+ IF ( SIZE(PFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
Allocate( tzfield, source = tpfield )
@@ -1537,6 +1556,12 @@ end subroutine IO_Ndimlist_reduce
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
+ IF ( SIZE(PFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X4','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
Allocate( tzfield, source = tpfield )
@@ -1742,6 +1767,12 @@ end subroutine IO_Ndimlist_reduce
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
+ IF ( SIZE(PFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X5','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
Allocate( tzfield, source = tpfield )
@@ -1910,6 +1941,12 @@ end subroutine IO_Ndimlist_reduce
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
+ IF ( SIZE(PFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X6','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,iresp_lfi)
IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,iresp_nc4)
ELSE
@@ -2110,6 +2147,12 @@ end subroutine IO_Ndimlist_reduce
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
+ IF ( SIZE(KFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_N1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,iresp_lfi)
IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,iresp_nc4)
ELSE ! multiprocesses execution
@@ -2233,6 +2276,12 @@ end subroutine IO_Ndimlist_reduce
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
+ IF ( SIZE(KFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_N2','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
Allocate( tzfield, source = tpfield )
if ( tpfile%ldimreduced ) then
@@ -2411,6 +2460,12 @@ end subroutine IO_Ndimlist_reduce
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
+ IF ( SIZE(KFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_N3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
Allocate( tzfield, source = tpfield )
if ( tpfile%ldimreduced ) then
@@ -2591,6 +2646,12 @@ end subroutine IO_Ndimlist_reduce
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
+ IF ( SIZE(KFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_N4','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
Allocate( tzfield, source = tpfield )
@@ -2876,6 +2937,12 @@ end subroutine IO_Ndimlist_reduce
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
+ IF ( SIZE(OFIELD) == 0 ) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_L1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,OFIELD,iresp_lfi)
IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,OFIELD,iresp_nc4)
ELSE ! multiprocesses execution
diff --git a/src/MNH/call_rttov11.f90 b/src/MNH/call_rttov11.f90
deleted file mode 100644
index c949ca4ebf02ce76697e879545f78ad7a8cd8e18..0000000000000000000000000000000000000000
--- a/src/MNH/call_rttov11.f90
+++ /dev/null
@@ -1,619 +0,0 @@
-!MNH_LIC Copyright 2003-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_CALL_RTTOV11
-! ########################
-INTERFACE
-!
- SUBROUTINE CALL_RTTOV11(KDLON, KFLEV, PEMIS, PTSRAD, &
- PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
- OUSERI, KRTTOVINFO, TPFILE )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-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
-!
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD !RADiative Surface Temperature
-!
-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) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PULVLKB ! U-wind at KB level
-REAL, DIMENSION(:,:), INTENT(IN) :: PVLVLKB ! V-wind at KB level
-!
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
- ! liquid and solid condensate (OUSERI=.TRUE.)
- ! or only liquid condensate (OUSERI=.FALSE.)
-!
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KRTTOVINFO ! platform, satelit, sensor,
- ! and selection calculations
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
-!
-END SUBROUTINE CALL_RTTOV11
-END INTERFACE
-END MODULE MODI_CALL_RTTOV11
-! #####################################################################
-SUBROUTINE CALL_RTTOV11(KDLON, KFLEV, PEMIS, PTSRAD, &
- PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
- OUSERI, KRTTOVINFO, TPFILE )
-! #####################################################################
-!!
-!!**** *CALL_RTTOV* -
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! See Chaboureau and Pinty, 2006
-!! Validation of a cirrus parameterization with Meteosat Second Generation
-!! observations. Geophys. Res. Let., doi:10.1029/2005GL024725
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Chaboureau *L.A.*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 11/12/03
-!! JP Chaboureau 27/03/2008 Vectorization
-!! JP Chaboureau 02/11/2009 move GANGL deallocation outside the sensor loop
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! JP Chaboureau 30/05/2017 exclude the first layer when considering clouds
-!! 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
-! JP Chaboureau 26/10/2020: calculate all IR intruments; deallocate MW tabs
-!!----------------------------------------------------------------------------
-!!
-!!* 0. DECLARATIONS
-!! ------------
-!!
-USE MODD_CST
-USE MODD_PARAMETERS
-USE MODD_GRID_n
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
-USE MODD_LUNIT_n
-USE MODD_DEEP_CONVECTION_n
-USE MODD_REF_n
-USE MODD_RADIATIONS_n, ONLY : XSEA
-!
-USE MODN_CONF
-!
-USE MODI_DETER_ANGLE
-USE MODI_PINTER
-!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_ll
-USE MODE_MSG
-USE MODE_POS
-!
-#ifdef MNH_RTTOV_11
-USE rttov_const, ONLY : &
- & sensor_id, sensor_id_ir, sensor_id_hi, sensor_id_mw, &
- & q_mixratio_to_ppmv, tmin, tmax, qmin, qmax, pmin, pmax
-USE rttov_types
-USE parkind1, ONLY: jpim, jprb, jplm
-!
-IMPLICIT NONE
-!
-! -----------------------------------------------------------------------------
-#include "rttov_direct.interface"
-#include "rttov_read_coefs.interface"
-#include "rttov_alloc_transmission.interface"
-#include "rttov_dealloc_coefs.interface"
-#include "rttov_read_scattcoeffs.interface"
-#include "rttov_dealloc_scattcoeffs.interface"
-#include "rttov_scatt_setupindex.interface"
-#include "rttov_scatt.interface"
-#include "rttov_scatt_ad.interface"
-#include "rttov_alloc_rad.interface"
-#include "rttov_init_rad.interface"
-#include "rttov_alloc_prof.interface"
-#include "rttov_alloc_scatt_prof.interface"
-#endif
-!!!
-!!!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
-!!!
-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
-!!!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD !RADiative Surface Temperature
- !
-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) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PULVLKB ! U-wind at KB level
-REAL, DIMENSION(:,:), INTENT(IN) :: PVLVLKB ! V-wind at KB level
-!!!
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
-! liquid and solid condensate (OUSERI=.TRUE.)
-! or only liquid condensate (OUSERI=.FALSE.)
-!!!
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KRTTOVINFO ! platform, satelit, sensor,
- ! and selection calculations
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
-!
-#ifdef MNH_RTTOV_11
-!!!
-!!!* 0.2 DECLARATIONS OF LOCAL VARIABLES
-!!!
-!!!
-INTEGER, PARAMETER :: JPNSAT=3 ! No. of Satellite required
- !
-INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JKF,JSAT,JC ! loop indexes
- !
-INTEGER :: IJSAT ! number of columns/=NUNDEF which
- ! have to be treated in the table KRTTOVINFO(:,:)
-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 :: IKR ! real array size for the third index
-INTEGER (Kind=jpim) :: iwp_levels ! equal to IKR (call to rttov_scatt)
-INTEGER :: IIJ ! reformatted array index
-INTEGER :: IKSTAE ! level number of the STAndard atmosphere array
-INTEGER :: IKUP ! vertical level above which STAndard atmosphere data
-
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZBT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZANTMP, ZUTH
-REAL :: ZZH, zdeg_to_rad, zrad_to_deg, zbeta, zalpha
-
-! Other arrays for zenithal solar angle
-! REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOSZEN, ZSINZEN, ZAZIMSOL
-
-! -----------------------------------------------------------------------------
-REAL, DIMENSION(1) :: ZANGL, ZLON, ZLAT !Satellite zenith angle, longitude, latitude (deg)
-REAL :: ZANGS !Solar zenith angle (deg)
-! -----------------------------------------------------------------------------
-! INDEXES AND TEMPORAL ARRAYS FOR VECTORIZATION
-INTEGER :: JIS, IBEG, IEND, IDIM, ICPT
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMSURFP
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAVP, ZCVP
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSAVP, ZSSVP, ZAPP, ZAP_HLP
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZTMP, ZZTMPP
-REAL, DIMENSION(:), ALLOCATABLE :: ZANGLP, ZREMISP
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GANGL
-! -----------------------------------------------------------------------------
-INTEGER :: INRAD = 2 ! INRAD=1 RADIANCE; INRAD=2 BRIGHTNESS TEMPERATURE
-! -----------------------------------------------------------------------------
-! Realistic maximum values for hydrometeor content in kg/kg
-REAL :: ZRCMAX = 5.0E-03, ZRRMAX = 5.0E-03, ZRIMAX = 2.0E-03, ZRSMAX = 5.0E-03
-! -----------------------------------------------------------------------------
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMSURF !Surface type index
-
-INTEGER :: IKFBOT, IKFTOP, INDEX, ISUM, JLEV, JCH, IWATER, ICAN
-REAL, DIMENSION(:), ALLOCATABLE :: ZTEXTR, ZQVEXTR !Array used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZQVSAT, ZVINT !Array used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZPSUM, ZTSUM, ZQVSUM, ZO3SUM !Array used in interpolation
-REAL :: zconst, ZPS, ZTGRAD, ZQGRAD, ZOGRAD !variables used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZPIN, ZFIN, ZOUT
-! at the open of the file LFI routines
-CHARACTER(LEN=8) :: YINST
-CHARACTER(LEN=4) :: YBEG, YEND
-CHARACTER(LEN=2) :: YCHAN, YTWO
-CHARACTER(LEN=1) :: YONE
-
-INTEGER, PARAMETER :: JPPLAT=16
-
-CHARACTER(LEN=3), DIMENSION(JPPLAT) :: YPLAT= (/ &
- 'N ','D ','MET','GO ','GMS','FY2','TRM','ERS', &
- 'EOS','MTP','ENV','MSG','FY1','ADS','MTS','CRL' /)
-CHARACTER(LEN=2), DIMENSION(2) :: YLBL_MVIRI = (/ 'WV', 'IR'/)
-CHARACTER(LEN=3), DIMENSION(7) :: YLBL_SSMI = (/ &
- '19V','19H','22V','37V','37H','85V','85H'/)
-CHARACTER(LEN=3), DIMENSION(9) :: YLBL_TMI = (/ &
- '10V','10H','19V','19H','22V','37V','37H','85V','85H'/)
-CHARACTER(LEN=3), DIMENSION(8) :: YLBL_SEVIRI = (/ &
- '039', '062','073','087','097','108','120','134'/)
-CHARACTER(LEN=3), DIMENSION(4) :: YLBL_GOESI = (/ &
- '039', '067','107','120'/)
-
-! -----------------------------------------------------------------------------
-LOGICAL (kind=jplm) , ALLOCATABLE :: calcemis (:)
-INTEGER (kind=jpim) , ALLOCATABLE :: frequencies (:)
-TYPE (rttov_chanprof) , ALLOCATABLE :: chanprof (:) ! Channel and profile indices
-TYPE (profile_type) , ALLOCATABLE :: profiles (:), profiles_k (:)
-TYPE (profile_cloud_type) , ALLOCATABLE :: cld_profiles(:), cld_profiles_k(:)
-TYPE(rttov_emissivity), ALLOCATABLE :: emissivity(:) ! Input/output surface emissivity
-LOGICAL(KIND=jplm), ALLOCATABLE :: calcrefl(:) ! Flag to indicate calculation of BRDF within RTTOV
-TYPE(rttov_reflectance), ALLOCATABLE :: reflectance(:) ! Input/output surface BRDF
- TYPE(transmission_type) :: transmission ! Output transmittances
- INTEGER(KIND=jpim) :: asw
-
-integer (kind=jpim) :: errorstatus
-type (radiance_type) :: radiance, radiance_k
-type (rttov_options) :: opts ! Defaults to everything optional switched off
-type (rttov_options_scatt) :: opts_scatt
-type (rttov_coefs ) :: coef_rttov
-type (rttov_scatt_coef) :: coef_scatt
-
-integer (kind=jpim) :: instrument (3)
-integer (kind=jpim) :: ilev, iprof, ichan, nprof, nchan, nlev, nchannels
-real (kind=jprb) :: zenangle
-integer (kind=jpim), parameter :: fin = 10
-character (len=256) :: outstring
-! -----------------------------------------------------------------------------
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZTEMP
-TYPE(TFIELDMETADATA) :: TZFIELD
-!-------------------------------------------------------------------------------
-!
-!* 0. ARRAYS BOUNDS INITIALIZATION
-!
-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
-
-errorstatus = 0
-nlev=IKE-IKB+1
-nprof=1
-ZTEMP = PTHT * ( PPABST/XP00 ) ** (XRD/XCPD)
-DO JSAT=1,SIZE(KRTTOVINFO,2)
- IF (KRTTOVINFO(1,JSAT) /= NUNDEF) THEN
- IJSAT = JSAT
- END IF
-END DO
-
-! -----------------------------------------------------------------------------
-! *** LOOP OVER SENSORS ***
-! -----------------------------------------------------------------------------
-DO JSAT=1,IJSAT ! loop over sensors
-
- instrument(1)=KRTTOVINFO(1,JSAT)
- instrument(2)=KRTTOVINFO(2,JSAT)
- instrument(3)=KRTTOVINFO(3,JSAT)
-! PRINT *,' JSAT=',JSAT, instrument
-
- IF( sensor_id( instrument(3) ) /= sensor_id_mw) THEN
- opts % rt_ir % addsolar = .FALSE. ! Do not include solar radiation
- opts % interpolation % addinterp = .TRUE. ! Allow interpolation of input profile
- opts % interpolation % interp_mode = 1 ! Set interpolation method
- opts % rt_all % addrefrac = .FALSE. ! Do not include refraction in path calc
- opts % rt_ir % addclouds = .TRUE. ! Include cloud effects
- opts % rt_ir % addaerosl = .FALSE. ! Don't include aerosol effects
- opts % rt_ir % ozone_data = .FALSE. ! Set the relevant flag to .TRUE.
- opts % rt_ir % co2_data = .FALSE. ! when supplying a profile of the
- opts % rt_ir % n2o_data = .FALSE. ! given trace gas (ensure the
- opts % rt_ir % ch4_data = .FALSE. ! coef file supports the gas)
- opts % rt_ir % co_data = .FALSE. !
-! opts % rt_mw % clw_data = .FALSE. !
-! opts%rt_ir%user_cld_opt_param = .FALSE.
- ELSE
- opts % rt_ir % addclouds = .FALSE. ! Include cloud effects
- END IF
- opts % config % verbose = .FALSE. ! Enable printing of warnings
- opts % config % do_checkinput = .FALSE.
-
-
-! Read and initialise coefficients
-! -----------------------------------------------------------------------------
- CALL rttov_read_coefs (errorstatus, coef_rttov, opts, instrument=instrument)
- IF(errorstatus /= 0) THEN
- WRITE(*,*) 'error rttov_readcoeffs :',errorstatus
- CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV11','error rttov_readcoeffs')
- ENDIF
-! CALL rttov_initcoeffs (errorstatus,coef_rttov)
-! IF( errorstatus/= 0) THEN
-! WRITE(*,*) 'error rttov_initcoeffs :',errorstatus
-! CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV11','error rttov_initcoeffs')
-! ENDIF
-
-! Read coef file for cloud/rain absorption/scattering
- IF( coef_rttov%coef%id_sensor == sensor_id_mw) THEN
- CALL rttov_read_scattcoeffs (errorstatus, coef_rttov%coef, coef_scatt)
- END IF
-
- nchan = coef_rttov%coef%fmv_chn ! number of channels on instrument
- nchannels = nprof * nchan ! total channels to simulate
-
- ALLOCATE(ZBT(IIU,IJU,nchannels))
- ZBT(:,:,:)=999.
-! PRINT *,'ncan=',nchan,' nchannels=',nchannels
-
- ALLOCATE (chanprof (nchannels))
- ALLOCATE (frequencies (nchannels))
- ALLOCATE (emissivity (nchannels))
- ALLOCATE (calcemis (nchannels))
- ALLOCATE (profiles (nprof))
- ALLOCATE (cld_profiles (nprof))
-! Request RTTOV / FASTEM to calculate surface emissivity
- calcemis = .TRUE.
- emissivity % emis_in = 0.0_JPRB
-
- IF( coef_rttov%coef% id_sensor /= sensor_id_mw) calcemis = .FALSE.
-
-! IF( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
-! ! Allocate arrays for surface reflectance
-! ALLOCATE(calcrefl(nchannels))
-! ALLOCATE(reflectance(nchannels))
-! END IF
-
-! Setup indices
- IF( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
- DO JCH=1,nchannels
- chanprof(JCH)%prof = 1
- chanprof(JCH)%chan = JCH
- END DO
- ELSE
- CALL rttov_scatt_setupindex ( &
- & nprof, & ! in
- & nchan, & ! in
- & coef_rttov%coef, & ! in
- & nchannels, & ! in
- & chanprof, & ! out
- & frequencies) ! out
- END IF
-
- asw = 1_jpim ! Switch for allocation passed into RTTOV subroutines
-
-! Allocate profiles (input) and radiance (output) structures
- CALL rttov_alloc_prof(errorstatus, nprof, profiles, nlev, opts,asw,coef_rttov,init = .TRUE._jplm)
- IF( coef_rttov%coef% id_sensor == sensor_id_mw) THEN
-! CALL rttov_alloc_opt_param( &
-! & errorstatus, &
-! & cld_opt_param, &
-! & nchanprof, &
-! & nlevels-1_jpim, &
-! & nphangle, &
-! & asw)
-! ELSE
- CALL rttov_alloc_scatt_prof( nprof, cld_profiles, nlev, .FALSE._jplm, 1_jpim, init = .TRUE._jplm)
- END IF
-
- CALL rttov_alloc_rad (errorstatus, nchannels, radiance, nlev-1_jpim,asw)
-! WRITE(*,*) 'error rttov_alloc_rad :',errorstatus
- ! Allocate transmittance structure
- CALL rttov_alloc_transmission( &
- & errorstatus, &
- & transmission, &
- & nlev-1_jpim, &
- & nchannels, &
- & asw, &
- & init=.TRUE.)
-
- profiles(1) % zenangle = 0. ! zenith
- cld_profiles(1) % use_totalice = .FALSE.
- profiles(1) % skin % fastem(:) = &
-! RTTOV 8.5 example
-! (/ 3.0_JPRB, 5.0_JPRB, 15.0_JPRB, 0.1_JPRB, 0.3_JPRB /)
-! Bare soil see Table 3 svr rttov7)
- (/ 2.3_JPRB, 1.9_JPRB, 21.8_JPRB, 0.0_JPRB, 0.5_JPRB /)
-
- profiles(1) % nlevels = nlev
- profiles(1) % nlayers = nlev-1
-
- ! Ensure the options and coefficients are consistent
- CALL rttov_user_options_checkinput(errorstatus, opts, coef_rttov)
- IF (errorstatus /= 0) THEN
- call Print_msg( NVERB_FATAL, 'GEN', 'CALL_RTTOV11', 'error in rttov options' )
- ENDIF
-
-!! opts%interpolation%reg_limit_extrap = .TRUE.
-!! profiles(1)%gas_units = 1 ! kg/kg over moist air
-! PRINT *,'nlev=',nlev,' tmax=',tmax,' tmin=',tmin,' qmax=',qmax,' qmin=',qmin
-! PRINT *, coef_rttov%coef % nlevels
- DO JI=IIB,IIE
- DO JJ=IJB,IJE
- ZANGL = XUNDEF
- ZLON = XLON(JI,JJ)
- ZLAT = XLAT(JI,JJ)
- IF (KRTTOVINFO(1,JSAT) == 2) THEN ! DMSP PLATFORM
- ZANGL=53.1 ! see Saunders, 2002, RTTOV7 - science/validation rep, page 8
- ELSEIF (KRTTOVINFO(1,JSAT) == 3) THEN ! METEOSAT PLATFORM
- CALL DETER_ANGLE(5, 1, ZLAT, ZLON, ZANGL)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
- ELSEIF (KRTTOVINFO(1,JSAT) == 12) THEN ! MSG PLATFORM
- CALL DETER_ANGLE(6, 1, ZLAT, ZLON, ZANGL)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
- ELSEIF (KRTTOVINFO(1,JSAT) == 4) THEN ! GOES-E PLATFORM
- CALL DETER_ANGLE(1, 1, ZLAT, ZLON, ZANGL)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
- ELSEIF (KRTTOVINFO(1,JSAT) == 7) THEN ! TRMM PLATFORM
- ZANGL=52.3
- ELSE
- ZANGL=0.
- ENDIF
-! Coefficients computed from transmittances for 6 viewing angles in the range
-! 0 to 63.6 deg (Saunders, 2002, RTTOV7 - science/validation rep., page 3)
- profiles(1) % zenangle = MIN(ZANGL(1),65.)
-
- DO JK=IKB,IKE ! nlevels
- JKRAD = nlev-JK+2 !INVERSION OF VERTICAL LEVELS!
-! PRINT *,'jk=',jk,' jkrad=',jkrad
- profiles(1) % p(JKRAD) = PPABST(JI,JJ,JK)*0.01
- profiles(1) % t(JKRAD) = MIN(tmax,MAX(tmin,ZTEMP(JI,JJ,JK)))
-! PRINT *,'jk=',JK,' ZTEMP=',ZTEMP(JI,JJ,JK),' t=',profiles(1) % t(JKRAD)
- profiles(1) % q(JKRAD) = MIN(qmax,MAX(qmin,PRT(JI,JJ,JK,1)*q_mixratio_to_ppmv))
-! PRINT *,JK,profiles(1) % p(JKRAD) ,profiles(1) % t(JKRAD) ,profiles(1) % q(JKRAD)
- END DO
- profiles(1) % elevation = 0.5*( PZZ(JI,JJ,1)+PZZ(JI,JJ,IKB) )
- profiles(1) % skin % t = MIN(tmax,MAX(tmin,PTSRAD(JI,JJ)))
- profiles(1) % s2m % t = MIN(tmax,MAX(tmin,ZTEMP(JI,JJ,IKB)))
- profiles(1) % s2m % q = MIN(qmax,MAX(qmin,PRT(JI,JJ,1,IKB)*q_mixratio_to_ppmv))
- profiles(1) % s2m % u = PULVLKB(JI,JJ) ! 2m wind speed u (m/s)
- profiles(1) % s2m % v = PVLVLKB(JI,JJ) ! 2m wind speed v (m/s)
- profiles(1) % s2m % p = PPABST(JI,JJ,IKB)*0.01
- IF (NINT(XSEA(JI,JJ)).EQ.0.) THEN
- profiles(1) % skin % surftype = 0 ! Surface Mask 0=land, 1=sea, 2=sea-ice
- ELSE
- profiles(1) % skin % surftype = 1
- profiles(1) % skin % watertype = 1 ! Ocean water
- END IF
- profiles(1) % ctp = 500.0_JPRB ! Not used but still required by RTTOV
- IF( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
- profiles(1)%ish = 2 ! Aggregates
- profiles(1)%idg = 4 ! McFarquar et al (2003)
- DO JK=IKB+1,IKE-1 ! nlayers
- JKRAD = nlev-JK+1 !INVERSION OF VERTICAL LEVELS!
- profiles(1) %cfrac(JKRAD) = PCLDFR(JI,JJ,JK)
- profiles(1) %cloud(1,JKRAD) = PRT(JI,JJ,JK,2)*XRHODREF(JI,JJ,JK)*1.0E03
- IF( OUSERI ) THEN
- profiles(1) %cloud(6,JKRAD) = (PRT(JI,JJ,JK,4)+PRT(JI,JJ,JK,5)) \
- *XRHODREF(JI,JJ,JK)*1.0E03
- END IF
- END DO
- ELSE
- DO JK=IKB,IKE
- JKRAD = nlev-JK+2 !INVERSION OF VERTICAL LEVELS!
- cld_profiles(1) %ph (JKRAD) = 0.5*( PPABST(JI,JJ,JK) + PPABST(JI,JJ,JK+1) )*0.01
- cld_profiles(1) %cc(JKRAD) = PCLDFR(JI,JJ,JK)
- cld_profiles(1) %clw(JKRAD) = MIN(ZRCMAX,PRT(JI,JJ,JK,2))
- cld_profiles(1) %rain(JKRAD) = MIN(ZRRMAX,PRT(JI,JJ,JK,3))
- IF( OUSERI ) THEN
- cld_profiles(1) %ciw(JKRAD) = MIN(ZRIMAX,PRT(JI,JJ,JK,4))
- cld_profiles(1) %sp(JKRAD) = MIN(ZRSMAX,PRT(JI,JJ,JK,5)+PRT(JI,JJ,JK,6))
- END IF
- END DO
- cld_profiles (1) % ph (nlev+1) = profiles (1) % s2m % p
-! PRINT *,nlev+1,' cld_profiles(1) % ph (nlev+1) =',cld_profiles(1) % ph (nlev+1)
- END IF
-
- DO JCH=1,nchannels
- IF (.NOT.calcemis(JCH)) emissivity(JCH)%emis_in = PEMIS(JI,JJ)
- END DO
-
-! write(*,*) 'Calling forward model'
-
-! Forward model run
- IF ( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
- CALL rttov_direct( &
- & errorstatus, &! out error flag
- & chanprof, &! in channel and profile index structure
- & opts, &! in options structure
- & profiles, &! in profile array
- & coef_rttov, &! in coefficients strucutre
- & transmission, &! inout compscauted transmittances
- & radiance, &! inout computed radiances
- & calcemis = calcemis, &! in flag for internal emissivity calcs
- & emissivity = emissivity) !, &! inout input/output emissivities per channel
-! & calcrefl = calcrefl, &! in flag for internal BRDF calcs
-! & reflectance = reflectance) ! inout input/output BRDFs per channel
- ELSE
- CALL rttov_scatt ( &
- & errorstatus, &! out
- & opts_scatt, &! in
- & nlev, &! in
- & chanprof, &! in
- & frequencies, &! in
- & profiles, &! in
- & cld_profiles, &! in
- & coef_rttov, &! in
- & coef_scatt, &! in
- & calcemis, &! in
- & emissivity, &! in
- & radiance) ! out
- END IF
-! STOP
- DO JCH=1,nchannels
- ZBT(JI,JJ,JCH)= radiance % bt(JCH)
- END DO
- END DO
- END DO
-! -----------------------------------------------------------------------------
-! LATERAL BOUNDARY FILLING
- IF (LWEST_ll() .AND.CLBCX(1)/='CYCL') ZOUT(IIB-1,:,:) = ZOUT(IIB,:,:)
- IF (LEAST_ll() .AND.CLBCX(1)/='CYCL') ZOUT(IIE+1,:,:) = ZOUT(IIE,:,:)
- IF (LSOUTH_ll().AND.CLBCY(1)/='CYCL') ZOUT(:,IJB-1,:) = ZOUT(:,IJB,:)
- IF (LNORTH_ll().AND.CLBCY(1)/='CYCL') ZOUT(:,IJE+1,:) = ZOUT(:,IJE,:)
-! -----------------------------------------------------------------------------
- YBEG=' '
- IF (KRTTOVINFO(1,JSAT) <= 2 .OR. KRTTOVINFO(1,JSAT) == 4) THEN ! NOAA
- WRITE(YTWO,'(I2.2)') KRTTOVINFO(2,JSAT)
- YBEG=TRIM(YPLAT(KRTTOVINFO(1,JSAT)))//YTWO
- ELSEIF (KRTTOVINFO(1,JSAT) <= JPPLAT) THEN
- WRITE(YONE,'(I1.1)') KRTTOVINFO(2,JSAT)
- YBEG=TRIM(YPLAT(KRTTOVINFO(1,JSAT)))//YONE
- ELSE
- YBEG='XXXX'
- END IF
- WRITE(YTWO,'(I2.2)') KRTTOVINFO(3,JSAT)
-
- DO JCH=1,nchannels
- YEND=' '
- WRITE(YCHAN,'(I2.2)') JCH
- IF (KRTTOVINFO(3,JSAT) == 0) THEN ! HIRS
- YEND='H'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 3) THEN ! AMSU-A
- YEND='A'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 4) THEN ! AMSU-B
- YEND='B'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 6) THEN ! SSMI
- YEND=YLBL_SSMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 9) THEN ! TMI
- YEND=YLBL_TMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 20) THEN ! MVIRI
- YEND=YLBL_MVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 21) THEN ! SEVIRI
- YEND=YLBL_SEVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 22) THEN ! GOES-I
- YEND=YLBL_GOESI(JCH)
- ELSE
- YEND=YTWO//YCHAN
- END IF
-
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'BT', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'BT', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' BT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
-! PRINT *,'YRECFM='//TRIM(TZFIELD%CMNHNAME)
- CALL IO_Field_write(TPFILE,TZFIELD,ZBT(:,:,JCH))
- END DO
- DEALLOCATE(chanprof,frequencies,emissivity,calcemis,profiles)
- DEALLOCATE(ZBT)
- IF( coef_rttov%coef% id_sensor == sensor_id_mw) THEN
- CALL rttov_alloc_scatt_prof(nprof, cld_profiles, nlev, .FALSE., 0_jpim)
- CALL rttov_dealloc_scattcoeffs(coef_scatt)
- END IF
- DEALLOCATE(cld_profiles)
- CALL rttov_dealloc_coefs(errorstatus, coef_rttov)
-! IF( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
-! DEALLOCATE(calcrefl,reflectance)
-! END IF
-END DO
-
-#else
-PRINT *, "RTTOV 11.1 LIBRARY NOT AVAILABLE = ###CALL_RTTOV11####"
-#endif
-!
-END SUBROUTINE CALL_RTTOV11
diff --git a/src/MNH/call_rttov13.f90 b/src/MNH/call_rttov13.f90
index 8c681d530d6fbfa583f3019be5c2bf9cce7462c6..4ae377c93c73b369cb9b7de10963bc10d1c65983 100644
--- a/src/MNH/call_rttov13.f90
+++ b/src/MNH/call_rttov13.f90
@@ -247,6 +247,7 @@ CHARACTER(LEN=2), DIMENSION(6) :: YLBL_SAPHIR = (/ &
CHARACTER(LEN=4), DIMENSION(13) :: YLBL_ICI = (/ &
'1837','1833','1832','243V','243H','3259','3253','3251','4487','4483','4481','664V','664H'/)
CHARACTER(LEN=4), DIMENSION(2) :: YLBL_DPR = (/ '13', '35' /)
+CHARACTER(LEN=4), DIMENSION(1) :: YLBL_CPR = (/ '94' /)
CHARACTER(LEN=4), DIMENSION(13) :: YLBL_GMI = (/ &
'10V','10H','18V','18H','23V','36V','36H','89V','89H','166V','166H','1833','1837'/)
@@ -354,7 +355,7 @@ DO JSAT=1,IJSAT ! loop over sensors
opts % rt_ir % addaerosl = .FALSE. ! Do not include aerosol effects
opts % rt_ir % addclouds = .FALSE. ! Do not include cloud effects
opts % rt_mw % clw_data = .FALSE. ! Do not include cloud liquid water
- IF (KRTTOVINFO(3,JSAT).EQ.105.OR.KRTTOVINFO(3,JSAT).EQ.106) radar = .TRUE.
+ IF (KRTTOVINFO(3,JSAT).EQ.105.OR.KRTTOVINFO(3,JSAT).EQ.107) radar = .TRUE.
END IF
! Read and initialise coefficients
@@ -750,6 +751,9 @@ DO JSAT=1,IJSAT ! loop over sensors
ELSEIF (KRTTOVINFO(3,JSAT) == 105) THEN ! DPR
YBEG='dpr'
YEND=YLBL_DPR(JCH)
+ ELSEIF (KRTTOVINFO(3,JSAT) == 107) THEN ! CPR
+ YBEG='cpr'
+ YEND=YLBL_CPR(JCH)
ELSE
YEND=YTWO//YCHAN
END IF
diff --git a/src/MNH/call_rttov8.f90 b/src/MNH/call_rttov8.f90
deleted file mode 100644
index ab370816e9fbd8998e73ed1420898793511151f9..0000000000000000000000000000000000000000
--- a/src/MNH/call_rttov8.f90
+++ /dev/null
@@ -1,1806 +0,0 @@
-!MNH_LIC Copyright 2003-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_CALL_RTTOV8
-! #######################
-INTERFACE
-!
- SUBROUTINE CALL_RTTOV8(KDLON, KFLEV, KSTATM, PEMIS, PTSRAD, PSTATM, &
- PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
- OUSERI, KRTTOVINFO, TPFILE )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-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
-!
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
-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) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PULVLKB ! U-wind at KB level
-REAL, DIMENSION(:,:), INTENT(IN) :: PVLVLKB ! V-wind at KB level
-!
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
- ! liquid and solid condensate (OUSERI=.TRUE.)
- ! or only liquid condensate (OUSERI=.FALSE.)
-!
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KRTTOVINFO ! platform, satelit, sensor,
- ! and selection calculations
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
-!
-END SUBROUTINE CALL_RTTOV8
-END INTERFACE
-END MODULE MODI_CALL_RTTOV8
-! #####################################################################
-SUBROUTINE CALL_RTTOV8(KDLON, KFLEV, KSTATM, PEMIS, PTSRAD, PSTATM, &
- PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
- OUSERI, KRTTOVINFO, TPFILE )
-! #####################################################################
-!!
-!!**** *CALL_RTTOV* -
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! See Chaboureau and Pinty, 2006
-!! Validation of a cirrus parameterization with Meteosat Second Generation
-!! observations. Geophys. Res. Let., doi:10.1029/2005GL024725
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Chaboureau *L.A.*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 11/12/03
-!! JP Chaboureau 27/03/2008 Vectorization
-!! JP Chaboureau 02/11/2009 move GANGL deallocation outside the sensor loop
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!----------------------------------------------------------------------------
-!!
-!!* 0. DECLARATIONS
-!! ------------
-!!
-USE MODD_CST
-USE MODD_FIELD, only: TFIELDMETADATA
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_GRID_n
-USE MODD_DEEP_CONVECTION_n
-USE MODD_REF_n
-USE MODD_RADIATIONS_n, ONLY : XSEA
-!
-USE MODN_CONF
-!
-USE MODD_RAD_TRANSF
-!
-USE MODI_DETER_ANGLE
-USE MODI_PINTER
-!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_ll
-USE MODE_MSG
-USE MODE_POS
-!
-#ifdef MNH_RTTOV_8
-USE rttov_const, ONLY : &
- & gas_id_watervapour ,&
- & errorstatus_success,&
- & errorstatus_warning,&
- & errorstatus_fatal,&
- & sensor_id_mw, &
- & npolar_return, &
- & npolar_compute
-
-
-USE rttov_types, ONLY : &
- & geometry_type ,&
- & rttov_coef ,&
- & rttov_scatt_coef ,&
- & profile_type ,&
- & profile_cloud_type ,&
- & transmission_type ,&
- & radiance_cloud_type
-
-USE MOD_CPARAM, ONLY : jppf ! Max no. profiles
-
-USE parkind1, ONLY : jpim ,jprb
-!
-IMPLICIT NONE
-!
-! -----------------------------------------------------------------------------
-INTERFACE
-
-!!! #include "rttov_setupindex.interface
-SUBROUTINE rttov_setupindex (&
- & mchan, & ! in
- & nprofiles, & ! in
- & nfrequencies, & ! in
- & nchannels, & ! in
- & nbtout, & ! in
- & coef, & ! in
- & surfem, & ! in
- & lprofiles, & ! out
- & channels, & ! out
- & polarisations, & ! out
- & emissivity) ! out
-! Imported Type Definitions:
-USE rttov_types, ONLY : &
- rttov_coef
-USE rttov_const, ONLY : &
- sensor_id_mw, &
- npolar_return, &
- npolar_compute
-
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-! Subroutine arguments
-INTEGER(Kind=jpim), INTENT(in) :: nprofiles ! Number of profiles
-INTEGER(Kind=jpim), INTENT(in) :: mchan(nprofiles) ! nfrequencies/nprofiles
-INTEGER(Kind=jpim), INTENT(in) :: nchannels ! Number of radiances computed
-INTEGER(Kind=jpim), INTENT(in) :: nfrequencies ! Number of frequencies
-! (= channels used * profiles)
-INTEGER(Kind=jpim), INTENT(in) :: nbtout ! Number of BTs returned
-INTEGER(Kind=jpim), INTENT(out) :: channels(nfrequencies) ! Channel indices
-INTEGER(Kind=jpim), INTENT(out) :: polarisations(nchannels,3) ! Channel indices
-INTEGER(Kind=jpim), INTENT(out) :: lprofiles(nfrequencies) ! Profiles indices
-REAL(Kind=jprb), INTENT(in) :: surfem(nchannels) ! Input surface emissivity
-REAL(Kind=jprb), INTENT(out) :: emissivity(nchannels) ! Surface emissivity array for RTTOV
-TYPE( rttov_coef ), INTENT (in) :: coef ! coefficients
-END SUBROUTINE rttov_setupindex
-!
-!!! #include "rttov_setupchan.interface"
-SUBROUTINE rttov_setupchan (&
- & nprofiles, & ! in
- & nchan, & ! in
- & coef, & ! in
- & nfrequencies, & ! out
- & nchannels, & ! out
- & nbtout) ! out
- ! Imported Type Definitions:
-USE rttov_types, ONLY : &
- rttov_coef
-USE rttov_const, ONLY : &
- sensor_id_mw, &
- npolar_return, &
- npolar_compute
-USE parkind1, ONLY : jpim
-IMPLICIT NONE
-! Subroutine arguments
-INTEGER(Kind=jpim), INTENT(in) :: nprofiles ! Number of profiles
-INTEGER(Kind=jpim), INTENT(in) :: nchan(nprofiles) ! Number of channels requested
-TYPE( rttov_coef ), INTENT (in) :: coef ! coefficients
-INTEGER(Kind=jpim), INTENT(out) :: nchannels ! Number of radiances computed
-INTEGER(Kind=jpim), INTENT(out) :: nfrequencies ! Number of frequencies
-! (= channels used * profiles)
-INTEGER(Kind=jpim), INTENT(out) :: nbtout ! Number of BTs returned
-END SUBROUTINE rttov_setupchan
-!
-!!! #include "rttov_scatt_setupindex.interface"
-SUBROUTINE rttov_scatt_setupindex (nprofiles, n_chan, coef, nchannels, &
- & lsprofiles,lsprofiles2, frequencies, nbtout)
-USE parkind1 , ONLY: jpim, jprb
-USE rttov_const, ONLY : npolar_return, npolar_compute, &
- & inst_id_ssmi
-USE rttov_types, ONLY : rttov_coef
-IMPLICIT NONE
-INTEGER (kind=jpim), INTENT ( in) :: nprofiles
-INTEGER (kind=jpim), INTENT ( in) :: nchannels
-INTEGER (kind=jpim), INTENT ( in) :: nbtout
-INTEGER (kind=jpim), INTENT ( in) :: n_chan (nprofiles)
-TYPE (rttov_coef), INTENT ( in) :: coef
-INTEGER (kind=jpim), INTENT (out), DIMENSION (nchannels) :: lsprofiles
-INTEGER (kind=jpim), INTENT (out), DIMENSION (nbtout) :: lsprofiles2
-INTEGER (kind=jpim), INTENT (out), DIMENSION (nchannels) :: frequencies
-END SUBROUTINE rttov_scatt_setupindex
-!
-!!! #include "rttov_cld.interface"
-SUBROUTINE rttov_cld( &
- errorstatus, & ! out
- nfrequencies, & ! in
- nchannels, & ! in
- nbtout, & ! in
- nprofiles, & ! in
- channels, & ! in
- polarisations, & ! in
- lprofiles, & ! in
- profiles, & ! inout (to invalid clw absorption)
- cld_profiles, & ! in
- coef, & ! in
- calcemis, & ! in
- emissivity, & ! inout
- cld_radiance ) ! inout
-USE rttov_const, ONLY : &
- errorstatus_success ,&
- errorstatus_fatal ,&
- overlap_scheme
-USE rttov_types, ONLY : &
- rttov_coef ,&
- geometry_Type ,&
- profile_Type ,&
- profile_cloud_Type ,&
- transmission_Type ,&
- radiance_Type ,&
- radiance_cloud_Type
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-INTEGER(Kind=jpim), INTENT(in) :: nbtout ! Number of output radiances
-INTEGER(Kind=jpim), INTENT(in) :: nfrequencies ! Number of output radiances
-INTEGER(Kind=jpim), INTENT(in) :: nchannels
-INTEGER(Kind=jpim), INTENT(in) :: nprofiles
-INTEGER(Kind=jpim), INTENT(in) :: channels(nfrequencies)
-INTEGER(Kind=jpim), INTENT(in) :: polarisations(nchannels,3) ! Channel indices
-INTEGER(Kind=jpim), INTENT(in) :: lprofiles(nfrequencies)
-TYPE(profile_Type), INTENT(inout) :: profiles(nprofiles) ! Profiles on RTTOV levels
-TYPE(profile_cloud_Type), INTENT(in) :: cld_profiles(nprofiles) ! Cloud profiles on NWP levels
-TYPE(rttov_coef), INTENT(in) :: coef ! Coefficients
-LOGICAL, INTENT(in) :: calcemis(nchannels) ! switch for emmissivity calc.
-REAL(Kind=jprb), INTENT(inout) :: emissivity(nchannels) ! surface emmissivity
-TYPE(radiance_cloud_Type), INTENT(inout) :: cld_radiance ! radiances (mw/cm-1/ster/sq.m)
-INTEGER(Kind=jpim), INTENT(out) :: errorstatus(nprofiles) ! return flag
-END SUBROUTINE rttov_cld
-
-!!! #include "rttov_cld_k.interface"
-SUBROUTINE Rttov_cld_k ( &
- errorstatus, & ! out
- nfrequencies, & ! in
- nchannels, & ! in
- nbtout, & ! in
- nprofiles, & ! in
- channels, & ! in
- polarisations, & ! in
- lprofiles, & ! in
- profiles, & ! in
- cld_profiles, & ! in
- coef, & ! in
- switchrad, & ! in
- calcemis, & ! in
- emissivity, & ! inout
- profiles_k , & ! inout
- cld_profiles_k ,& ! inout
- emissivity_k , & ! inout
- cld_radiance) ! inout
-USE rttov_const, ONLY : &
- errorstatus_success ,&
- errorstatus_fatal ,&
- overlap_scheme
-USE rttov_types, ONLY : &
- rttov_coef ,&
- geometry_Type ,&
- profile_Type ,&
- profile_cloud_Type ,&
- radiance_cloud_Type
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-INTEGER(Kind=jpim), INTENT(in) :: nfrequencies
-INTEGER(Kind=jpim), INTENT(in) :: nchannels
-INTEGER(Kind=jpim), INTENT(in) :: nbtout
-INTEGER(Kind=jpim), INTENT(in) :: nprofiles
-INTEGER(Kind=jpim), INTENT(in) :: channels(nfrequencies)
-INTEGER(Kind=jpim), INTENT(in) :: polarisations(nchannels,3)
-INTEGER(Kind=jpim), INTENT(in) :: lprofiles(nfrequencies)
-LOGICAL, INTENT(in) :: switchrad ! true if input is BT
-TYPE(profile_Type), INTENT(inout) :: profiles(nprofiles)
-TYPE(profile_cloud_Type), INTENT(in) :: cld_profiles(nprofiles)
-TYPE(rttov_coef), INTENT(in) :: coef
-LOGICAL, INTENT(in) :: calcemis(nchannels)
-REAL(Kind=jprb), INTENT(inout) :: emissivity(nchannels)
-TYPE(radiance_cloud_type), INTENT(inout) :: cld_radiance! in because of meme allocation
-TYPE(profile_Type), INTENT(inout) :: profiles_k(nchannels)
-TYPE(profile_cloud_Type), INTENT(inout) :: cld_profiles_k(nchannels)
-REAL(Kind=jprb), INTENT(inout) :: emissivity_k(nchannels)
-INTEGER(Kind=jpim), INTENT(out) :: errorstatus(nprofiles)
-END SUBROUTINE Rttov_cld_k
-
-
-!!! #include "rttov_scatt.interface"
-SUBROUTINE rttov_scatt(&
- & errorstatus,&
- & nwp_levels,&
- & nrt_levels,&
- & nfrequencies,&
- & nchannels,&
- & nbtout,&
- & nprofiles,&
- & polarisations,&
- & channels,&
- & frequencies,&
- & lprofiles,&
- & lsprofiles,&
- & profiles,&
- & cld_profiles,&
- & coef_rttov,&
- & coef_scatt,&
- & calcemiss,&
- & emissivity_in,&
- & cld_radiance )
-USE rttov_types, ONLY :&
- & rttov_coef ,&
- & rttov_scatt_coef ,&
- & geometry_Type ,&
- & profile_Type ,&
- & profile_cloud_Type ,&
- & profile_scatt_aux ,&
- & transmission_Type ,&
- & radiance_Type ,&
- & radiance_cloud_Type
-USE parkind1, ONLY : jpim ,jprb
-INTEGER (Kind=jpim), INTENT (in) :: nwp_levels
-INTEGER (Kind=jpim), INTENT (in) :: nrt_levels
-INTEGER (Kind=jpim), INTENT (in) :: nprofiles
-INTEGER (Kind=jpim), INTENT (in) :: nfrequencies
-INTEGER (Kind=jpim), INTENT (in) :: nchannels
-INTEGER (Kind=jpim), INTENT (in) :: nbtout
-INTEGER (Kind=jpim), INTENT (in) :: channels (nfrequencies)
-INTEGER (Kind=jpim), INTENT (in) :: frequencies (nchannels)
-INTEGER (Kind=jpim), INTENT (in) :: polarisations (nchannels,3)
-INTEGER (Kind=jpim), INTENT (in) :: lprofiles (nfrequencies)
-INTEGER (Kind=jpim), INTENT (in) :: lsprofiles (nchannels)
-INTEGER (Kind=jpim), INTENT (out) :: errorstatus (nprofiles)
-LOGICAL, INTENT (in) :: calcemiss (nchannels)
-REAL (Kind=jprb), INTENT (in) :: emissivity_in (nchannels)
-TYPE (profile_Type), INTENT (inout) :: profiles (nprofiles)
-TYPE (rttov_coef), INTENT (in) :: coef_rttov
-TYPE (rttov_scatt_coef), INTENT (in) :: coef_scatt
-TYPE (profile_cloud_Type), INTENT (in) :: cld_profiles (nprofiles)
-TYPE (radiance_cloud_Type), INTENT (inout) :: cld_radiance
-END SUBROUTINE rttov_scatt
-
-!!! #include "rttov_readcoeffs.interface"
-SUBROUTINE rttov_readcoeffs (&
- & errorstatus, & ! out
- & coef, & ! out
- & instrument, & ! in Optional
- & kmyproc, & ! in Optional
- & kioproc, & ! in Optional
- & file_id, & ! in Optional
- & channels ) ! in Optional
-USE rttov_const, ONLY : &
- version ,&
- release ,&
- minor_version ,&
- rttov_magic_string ,&
- sensor_id_mw ,&
- sensor_id_ir ,&
- errorstatus_info ,&
- errorstatus_success ,&
- errorstatus_fatal ,&
- gas_id_mixed ,&
- gas_id_watervapour ,&
- gas_id_ozone ,&
- gas_id_wvcont ,&
- gas_id_co2 ,&
- gas_id_n2o ,&
- gas_id_co ,&
- gas_id_ch4 ,&
- gas_unit_specconc ,&
- gas_unit_ppmv ,&
- earthradius ,&
- gas_name ,&
- pressure_top
-USE rttov_types, ONLY : &
- rttov_coef
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-INTEGER(Kind=jpim), OPTIONAL, INTENT(in) :: kmyproc ! logical processor id
-INTEGER(Kind=jpim), OPTIONAL, INTENT(in) :: kioproc ! processor dedicated for io
-INTEGER(Kind=jpim), OPTIONAL, INTENT (in) :: instrument(3) ! (platform, satellite identification, instrument) number
-INTEGER(Kind=jpim), OPTIONAL, INTENT (in) :: file_id ! file logical unit number
-INTEGER(Kind=jpim), OPTIONAL, INTENT (in) :: channels(:) ! list of channels to extract
-INTEGER(Kind=jpim), INTENT (out) :: errorstatus ! return code
-TYPE( rttov_coef ), INTENT (out) :: coef ! coefficients
-END SUBROUTINE rttov_readcoeffs
-
-!!! #include "rttov_initcoeffs.interface"
-SUBROUTINE rttov_initcoeffs (&
- & errorstatus, &! out
- & coef, &! out
- & knproc, &! in Optional
- & kmyproc, &! in Optional
- & kioproc )! in Optional
-USE rttov_const, ONLY : &
- & sensor_id_mw ,&
- & errorstatus_info ,&
- & errorstatus_success ,&
- & errorstatus_fatal ,&
- & gas_id_mixed ,&
- & gas_id_watervapour ,&
- & gas_id_ozone ,&
- & gas_id_wvcont ,&
- & gas_id_co2 ,&
- & gas_id_n2o ,&
- & gas_id_co ,&
- & gas_id_ch4 ,&
- & gas_unit_specconc ,&
- & gas_unit_ppmv ,&
- & earthradius ,&
- & gas_name ,&
- & pressure_top
-! Imported Type Definitions:
-USE rttov_types, ONLY : &
- & rttov_coef
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-INTEGER(Kind=jpim), OPTIONAL, INTENT(in) :: knproc ! number of procs
-INTEGER(Kind=jpim), OPTIONAL, INTENT(in) :: kmyproc ! logical processor id
-INTEGER(Kind=jpim), OPTIONAL, INTENT(in) :: kioproc ! procs dedicated for io
-! scalar arguments with intent(out):
-INTEGER(Kind=jpim), INTENT (out) :: errorstatus ! return code
-TYPE( rttov_coef ), INTENT (out) :: coef ! coefficients
-END SUBROUTINE rttov_initcoeffs
-
-!!! #include "rttov_readscattcoeffs.interface"
-SUBROUTINE rttov_readscattcoeffs (&
- & errorstatus, &! out
- & coef_rttov, &! in
- & coef_scatt, &! out
- & file_id ) ! in Optional
-! Imported Type Definitions:
-USE rttov_types, ONLY : &
- & rttov_coef, &
- & rttov_scatt_coef
-USE rttov_const, ONLY : &
- & inst_name ,&
- & platform_name ,&
- & errorstatus_info ,&
- & errorstatus_success ,&
- & errorstatus_fatal
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-! subroutine arguments
-! scalar arguments with intent(out):
-INTEGER(Kind=jpim), INTENT (out) :: errorstatus ! return code
-! scalar arguments with optional intent(in):
-INTEGER(Kind=jpim), OPTIONAL, INTENT (in) :: file_id ! file logical unit number
-! array arguments with intent(in):
-TYPE( rttov_coef ), INTENT (in) :: coef_rttov ! clear-sky coefficients
-! array arguments with intent(out):
-TYPE( rttov_scatt_coef ), INTENT (out) :: coef_scatt ! coefficients
-END SUBROUTINE rttov_readscattcoeffs
-
-END INTERFACE
-!!! #include "rttov_opencoeff.interface"
-!!! #include "rttov_errorhandling.interface"
-!!! #include "rttov_dealloc_coef.interface"
-!!! #include "rttov_errorreport.interface"
-#endif
-!!!
-!!!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
-!!!
-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
-!!!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
-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) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PULVLKB ! U-wind at KB level
-REAL, DIMENSION(:,:), INTENT(IN) :: PVLVLKB ! V-wind at KB level
-!!!
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
-! liquid and solid condensate (OUSERI=.TRUE.)
-! or only liquid condensate (OUSERI=.FALSE.)
-!!!
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KRTTOVINFO ! platform, satelit, sensor,
- ! and selection calculations
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
-!
-#ifdef MNH_RTTOV_8
-!!!
-!!!* 0.2 DECLARATIONS OF LOCAL VARIABLES
-!!!
-!!!
-INTEGER, PARAMETER :: JPNSAT=3 ! No. of Satellite required
- !
-INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JKF,JSAT,JC ! loop indexes
- !
-INTEGER :: IJSAT ! number of columns/=NUNDEF which
- ! have to be treated in the table KRTTOVINFO(:,:)
-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 :: IKR ! real array size for the third index
-INTEGER (Kind=jpim) :: iwp_levels ! equal to IKR (call to rttov_scatt)
-INTEGER :: IIJ ! reformatted array index
-INTEGER :: IKSTAE ! level number of the STAndard atmosphere array
-INTEGER :: IKUP ! vertical level above which STAndard atmosphere data
-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 :: ZPAVE ! mean-layer pressure
-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 :: 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 :: ZULAT
-REAL, DIMENSION(:), ALLOCATABLE :: ZULON
-
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTBTMP
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZANTMP, ZUTH
-REAL :: ZZH, zdeg_to_rad, zrad_to_deg, zbeta, zalpha
-
-! Other arrays for zenithal solar angle
-! REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOSZEN, ZSINZEN, ZAZIMSOL
-
-! Other arrays for condensation
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMP ! Temperature
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZNCLD ! grid scale cloud fraction
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC ! grid scale r_c (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI ! grid scale r_i (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRR ! grid scale r_r (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRS ! grid scale r_s (kg/kg)
-! -----------------------------------------------------------------------------
-INTEGER, PARAMETER :: JPLEV=43, JPNAV=3, JPNSAV=5, JPNSSV=6, JPNCVCLD=6
-
-REAL, DIMENSION(JPLEV) :: ZPRES !Fixed level pressures used in RTTOV
-REAL, DIMENSION(JPLEV) :: ZPRES_INV
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAV !Profile array content
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSAV !Surface array content
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSSV !Surface Skin array content
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZAP !Full-level Model Pressure (hPa)
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZAP_HL !Half-level Model Pressure (hPa)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCV !Temperature and cloud variable
- !on full-level model
-REAL, DIMENSION(:), ALLOCATABLE :: ZANGL !Satellite zenith angle (deg)
-REAL, DIMENSION(:), ALLOCATABLE :: ZANGS !Solar zenith angle (deg)
-! -----------------------------------------------------------------------------
-! Jacobian fields
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMPK, ZWVAPK
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMPKP, ZTEMPKPP, ZWVAPKP, ZWVAPKPP
-! -----------------------------------------------------------------------------
-! INDEXES AND TEMPORAL ARRAYS FOR VECTORIZATION
-INTEGER :: JIS, IBEG, IEND, IDIM, ICPT
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMSURFP
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAVP, ZCVP
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSAVP, ZSSVP, ZAPP, ZAP_HLP
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZTMP, ZZTMPP
-REAL, DIMENSION(:), ALLOCATABLE :: ZANGLP, ZREMISP
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GANGL
-! -----------------------------------------------------------------------------
-INTEGER :: INRAD = 2 ! INRAD=1 RADIANCE; INRAD=2 BRIGHTNESS TEMPERATURE
-! -----------------------------------------------------------------------------
-! Realistic maximum values for hydrometeor content in kg/kg
-REAL :: ZRCMAX = 5.0E-03, ZRRMAX = 5.0E-03, ZRIMAX = 2.0E-03, ZRSMAX = 5.0E-03
-! -----------------------------------------------------------------------------
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMSURF !Surface type index
-
-INTEGER :: IKFBOT, IKFTOP, INDEX, ISUM, JLEV, JCH, IWATER, ICAN
-REAL, DIMENSION(:), ALLOCATABLE :: ZTEXTR, ZQVEXTR !Array used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZQVSAT, ZVINT !Array used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZPSUM, ZTSUM, ZQVSUM, ZO3SUM !Array used in interpolation
-REAL :: zconst, ZPS, ZTGRAD, ZQGRAD, ZOGRAD !variables used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZPIN, ZFIN, ZOUT
-! at the open of the file LFI routines
-CHARACTER(LEN=8) :: YINST
-CHARACTER(LEN=4) :: YBEG, YEND
-CHARACTER(LEN=2) :: YCHAN, YTWO
-CHARACTER(LEN=1) :: YONE
-
-INTEGER, PARAMETER :: JPPLAT=16
-
-CHARACTER(LEN=3), DIMENSION(JPPLAT) :: YPLAT= (/ &
- 'N ','D ','MET','GO ','GMS','FY2','TRM','ERS', &
- 'EOS','MTP','ENV','MSG','FY1','ADS','MTS','CRL' /)
-CHARACTER(LEN=2), DIMENSION(2) :: YLBL_MVIRI = (/ 'WV', 'IR'/)
-CHARACTER(LEN=3), DIMENSION(7) :: YLBL_SSMI = (/ &
- '19V','19H','22V','37V','37H','85V','85H'/)
-CHARACTER(LEN=3), DIMENSION(9) :: YLBL_TMI = (/ &
- '10V','10H','19V','19H','22V','37V','37H','85V','85H'/)
-CHARACTER(LEN=3), DIMENSION(8) :: YLBL_SEVIRI = (/ &
- '039', '062','073','087','097','108','120','134'/)
-CHARACTER(LEN=3), DIMENSION(4) :: YLBL_GOESI = (/ &
- '039', '067','107','120'/)
-
-! -----------------------------------------------------------------------------
-!*JPC*VECTORIZATION
-!! One profile per run
-!! INTEGER (Kind=jpim) :: nprofiles = 1
-INTEGER (Kind=jpim) :: nprofiles, ntruepro
-!*JPC*VECTORIZATION
-
-! RTTOV_readcoeffs interface
-! ====================
-INTEGER(Kind=jpim) :: errorstatus
-INTEGER(Kind=jpim) :: instrument(3)
-TYPE( rttov_coef ) :: coef ! coefficients
-TYPE( rttov_scatt_coef ) :: coef_scatt
-
-! RTTOV interface
-! ====================
-INTEGER(Kind=jpim), ALLOCATABLE :: rttov_errorstatus(:) ! rttov error return code
-INTEGER(Kind=jpim) :: nfrequencies
-INTEGER(Kind=jpim) :: nchannels
-INTEGER(Kind=jpim) :: nbtout
-INTEGER(Kind=jpim), ALLOCATABLE :: channels (:), n_chan(:)
-INTEGER(Kind=jpim), ALLOCATABLE :: polarisations (:,:)
-INTEGER(Kind=jpim), ALLOCATABLE :: frequencies (:)
-INTEGER(Kind=jpim), ALLOCATABLE :: lprofiles (:),lsprofiles(:),lsprofiles2(:)
-TYPE(profile_Type), ALLOCATABLE :: profiles(:)
-TYPE(profile_cloud_type), ALLOCATABLE :: cld_profiles(:)
-TYPE(transmission_type) :: transmission
-LOGICAL :: addcloud = .FALSE.
-LOGICAL, ALLOCATABLE :: calcemis(:)
-REAL(Kind=jprb), ALLOCATABLE :: emissivity (:)
-TYPE(radiance_cloud_type) :: radiance
-
-REAL(Kind=jprb), ALLOCATABLE :: input_emissivity (:)
-CHARACTER (len=6) :: NameOfRoutine = 'tstrad'
-! RTTOV K/AD interface
-! ====================
-LOGICAL :: switchrad ! true if input is BT
-TYPE(profile_Type), ALLOCATABLE :: profiles_k(:)
-TYPE(profile_cloud_Type), ALLOCATABLE :: cld_profiles_k(:)
-REAL(Kind=jprb), ALLOCATABLE :: emissivity_k (:)
-
-! variables for input
-! ====================
-! Parameter for WV conversion used in all tstrad suite
-REAL(Kind=jprb), PARAMETER :: q_mixratio_to_ppmv = 1.60771704e+6_JPRB
-REAL(Kind=jprb), PARAMETER :: o3_mixratio_to_ppmv = 6.03504e+5_JPRB
-INTEGER(Kind=jpim) :: alloc_status(40)
-
-CHARACTER(LEN=:), ALLOCATABLE :: YMNHNAME, YUNITS, YCOMMENT
-TYPE(TFIELDMETADATA) :: TZFIELD
-
-! - End of header --------------------------------------------------------
-!!!----------------------------------------------------------------------------
-!!!
-!!!* 1. INITIALIZATION OF CONSTANTS FOR TRANSFERT CODE
-!!! ----------------------------------------------
-!!!
-
-! JPC from refprof.dat
-ZPRES=(/ 0.100, 0.290, 0.690, 1.420, 2.611, 4.407, &
- 6.950, 10.370, 14.810, 20.400, 27.260, 35.510, &
- 45.290, 56.730, 69.970, 85.180, 102.050, 122.040, &
- 143.840, 167.950, 194.360, 222.940, 253.710, 286.600, &
- 321.500, 358.280, 396.810, 436.950, 478.540, 521.460, &
- 565.540, 610.600, 656.430, 702.730, 749.120, 795.090, &
- 839.950, 882.800, 922.460, 957.440, 985.880, 1005.430, &
- 1013.250 /)
-
-DO JK=1,JPLEV
- JKRAD=JPLEV-JK+1
- ZPRES_INV(JK)=ZPRES(JKRAD)*100. ! Conversion from hPa to Pa
-END DO
-
-errorstatus = 0
-alloc_status(:) = 0
-
-PRINT *,'NB OF SAT SIZE(KRTTOVINFO,1)=',SIZE(KRTTOVINFO,1)
-PRINT *,'NB OF SAT SIZE(KRTTOVINFO,2)=',SIZE(KRTTOVINFO,2)
-DO JSAT=1,SIZE(KRTTOVINFO,2)
- IF (KRTTOVINFO(1,JSAT) /= NUNDEF) THEN
- IJSAT = JSAT
- END IF
-END DO
-
-JSAT=1
-instrument(1)=KRTTOVINFO(1,JSAT)
-instrument(2)=KRTTOVINFO(2,JSAT)
-instrument(3)=KRTTOVINFO(3,JSAT)
-PRINT *,'range(KRTTOVINFO(3,JSAT)) ',range(KRTTOVINFO(3,JSAT))
-PRINT *,'range(instrument(3)) ',range(instrument(3))
-CALL rttov_readcoeffs (errorstatus, coef, instrument)
-CALL rttov_initcoeffs (errorstatus, coef)
-
-switchrad = INRAD == 2
-PRINT *,' RADIANCE OR TB CALCULATION: INRAD=',INRAD,' switchrad=',switchrad
-
-!!!----------------------------------------------------------------------------
-!!!
-!!!* 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
-IKR = IKE - IKB +1
-
-IKSTAE = SIZE(PSTATM,1)
-IKUP = IKE-JPVEXT+1
-
-!*JPC*VECTORIZATION
-! Determine the number of profiles per RTTOV run
-nprofiles = JPPF
-!*JPC*VECTORIZATION
-
-
-!!!----------------------------------------------------------------------------
-!!!
-!!!* 3. INITIALIZES THE MEAN-LAYER VARIABLES
-!!! ------------------------------------
-
-ALLOCATE(ZEXNT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
-ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-
-! Pressure
-ALLOCATE(ZPAVE(KDLON,KFLEV))
-DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZPAVE(IIJ,JKRAD) = PPABST(JI,JJ,JK)*0.01 !Pressure in hPa
- END DO
- END DO
-END DO
-
-! Temperature
-ALLOCATE(ZTEMP(IIU,IJU,IKU))
-ZTEMP=PTHT*ZEXNT
-ALLOCATE(ZTAVE(KDLON,KFLEV))
-DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZTAVE(IIJ,JKRAD) = ZTEMP(JI,JJ,JK)
- END DO
- END DO
-END DO
-
-! Water vapor
-ALLOCATE(ZQVAVE(KDLON,KFLEV))
-ZQVAVE(:,:) = 0.0
-IF( SIZE(PRT(:,:,:,:),4) >= 1 ) THEN
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZQVAVE(IIJ,JKRAD) = PRT(JI,JJ,JK,1)
- END DO
- END DO
- END DO
-END IF
-
-! Ozone
-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 = (JI-JPHEXT) + (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
-
-! Standard atmosphere extension
-DO JK=IKUP,KFLEV
- JK1 = (KSTATM-1)+(JK-IKUP)
- JK2 = JK1+1
- ZPAVE(:,JK) = 0.5*( PSTATM(JK1,2)+PSTATM(JK2,2) )
- 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))
- JK1 = (KSTATM)+(JK-IKUP)
- ZO3AVE(:,JK) = ZSTAOZ(JK1)
-END DO
-!!!
-!!!----------------------------------------------------------------------------
-!!!
-!!!* 4. INTERPOLATES THE ATMOSPHERIC VARIABLES ONTO THE RTTOV GRID
-! ----------------------------------------------------------
-!!!WITH INVERSION OF VERTICAL LEVELS!
-
-ALLOCATE(ZAV(JPLEV,JPNAV,KDLON))
-
-ALLOCATE(ZTEXTR(JPLEV))
-ALLOCATE(ZQVEXTR(JPLEV))
-ALLOCATE(ZVINT(JPLEV))
-ISUM=JPLEV+KFLEV
-ALLOCATE(ZPSUM(ISUM))
-ALLOCATE(ZTSUM(ISUM))
-ALLOCATE(ZQVSUM(ISUM))
-ALLOCATE(ZO3SUM(ISUM))
-ALLOCATE(ZQVSAT(ISUM))
-ZPSUM(:)=0.
-ZTSUM(:)=0.
-ZQVSUM(:)=0.
-ZO3SUM(:)=0.
-ZQVSAT(:)=0.
-zconst= 287./1005.
-IWATER = coef % fmv_gas_pos( gas_id_watervapour )
-DO JI=IIB,IIE
- DO JJ=IJB,IJE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZPS=XP00*0.01 * & !Surface Pressure in hPa
- (0.5*(ZEXNT(JI,JJ,IKB)+ZEXNT(JI,JJ,IKB-1)))**(XCPD/XRD)
- DO JK=1,KFLEV
- JKRAD = KFLEV-JK+1 !INVERSION OF VERTICAL LEVELS!
- ZPSUM(JKRAD)=ZPAVE(IIJ,JK)
- ZTSUM(JKRAD)=ZTAVE(IIJ,JK)
- ZQVSUM(JKRAD)=ZQVAVE(IIJ,JK)
- ZO3SUM(JKRAD)=ZO3AVE(IIJ,JK)
- END DO
- ZTSUM(KFLEV+1)=ZTAVE(IIJ,1)
- ZQVSUM(KFLEV+1)=ZQVAVE(IIJ,1)
- IKFBOT=0
- DO JKF=1,JPLEV
- IF (ZPRES(JKF) > ZPS) THEN
- IKFBOT=JKF
- EXIT
- END IF
- END DO
- INDEX = KFLEV
- IF (IKFBOT /= 0) THEN
-!!!-----Extrapolates temperature below surface pressure-------------------
- INDEX=JPLEV-IKFBOT+1
- INDEX=INDEX+KFLEV+1
- ZTSUM((KFLEV+2):INDEX) = PTSRAD(JI,JJ)
- ZPSUM((KFLEV+1))=ZPS
- ZPSUM((KFLEV+2):INDEX)=ZPRES(IKFBOT:JPLEV)
- ZO3SUM((KFLEV+2):INDEX)=ZO3AVE(IIJ,1)
- END IF
-!!!-----Extrapolates profile above highest declared level-----------------
-!!!----- => linear extrapolation -----------------------------------------
- IKFTOP = 1
- DO JLEV=1,INDEX
- IF(ZPRES(JLEV) >= ZPAVE(IIJ,KFLEV) ) EXIT
- IKFTOP = IKFTOP + 1
- END DO
- IF (IKFTOP /= 1) THEN
- ZTGRAD = (ZTSUM(1) - ZTSUM(2)) / (ZPSUM(1)-ZPSUM(2))
- ZQGRAD = (ZQVSUM(1) - ZQVSUM(2)) / (ZPSUM(1)-ZPSUM(2))
- ZOGRAD = (ZO3SUM(1) - ZO3SUM(2)) / (ZPSUM(1)-ZPSUM(2))
- DO JLEV=INDEX, 1, -1
- ZTSUM(JLEV+IKFTOP-1) = ZTSUM(JLEV)
- ZQVSUM(JLEV+IKFTOP-1) = ZQVSUM(JLEV)
- ZO3SUM(JLEV+IKFTOP-1) = ZO3SUM(JLEV)
- ZPSUM(JLEV+IKFTOP-1) = ZPSUM(JLEV)
- END DO
- INDEX = INDEX + IKFTOP-1
- DO JLEV=1,IKFTOP-1
- ZPSUM(JLEV) = ZPRES(JLEV)
- ZTSUM(JLEV) = ZTSUM(IKFTOP) &
- + ZTGRAD * (ZPSUM(JLEV) - ZPSUM(IKFTOP))
- ZQVSUM(JLEV) = ZQVSUM(IKFTOP) &
- + ZQGRAD * (ZPSUM(JLEV) - ZPSUM(IKFTOP))
- ZO3SUM(JLEV) = ZO3SUM(IKFTOP) &
- + ZOGRAD * (ZPSUM(JLEV) - ZPSUM(IKFTOP))
- END DO
- ENDIF
-!!!-----Interpolates to given pressure grid-------------------------------
- ALLOCATE(ZPIN(INDEX))
- ALLOCATE(ZFIN(INDEX))
- ALLOCATE(ZOUT(JPLEV))
- DO JLEV=1,INDEX
- JKRAD=INDEX-JLEV+1
- ZPIN(JKRAD) = ZPSUM(JLEV)*100.
- ZFIN(JKRAD) = ZTSUM(JLEV)
- END DO
- CALL PINTER(ZFIN, ZPIN, ZFIN, ZFIN, ZOUT, ZPRES_INV, &
- 1, 1, INDEX, 1, JPLEV, 'LOG', 'RHU.')
- DO JLEV=1,JPLEV
- JKRAD=JPLEV-JLEV+1
- ZVINT(JKRAD) = ZOUT(JLEV)
- END DO
- ZAV(:,1,IIJ)= ZVINT(:) ! temperature K
- DO JLEV=1,INDEX
- JKRAD=INDEX-JLEV+1
- ZFIN(JKRAD) = ZQVSUM(JLEV)
- END DO
- CALL PINTER(ZFIN, ZPIN, ZFIN, ZFIN, ZOUT, ZPRES_INV, &
- 1, 1, INDEX, 1, JPLEV, 'LOG', 'RHU.')
- DO JLEV=1,JPLEV
- JKRAD=JPLEV-JLEV+1
- ZVINT(JKRAD) = ZOUT(JLEV)
- END DO
- ZAV(:,2,IIJ)= ZVINT(:)*q_mixratio_to_ppmv ! water vapor mr ppmv
- DO JLEV=1,INDEX
- JKRAD=INDEX-JLEV+1
- ZFIN(JKRAD) = ZO3SUM(JLEV)
- END DO
- CALL PINTER(ZFIN, ZPIN, ZFIN, ZFIN, ZOUT, ZPRES_INV, &
- 1, 1, INDEX, 1, JPLEV, 'LOG', 'RHU.')
- DO JLEV=1,JPLEV
- JKRAD=JPLEV-JLEV+1
- ZVINT(JKRAD) = ZOUT(JLEV)
- END DO
- ZAV(:,3,IIJ)= ZVINT(:)*o3_mixratio_to_ppmv ! ozone mixing ratio ppmv
- DO JLEV=1,JPLEV
- ZAV(JLEV,1,IIJ)= MAX(coef%lim_prfl_tmin(JLEV), &
- MIN(coef%lim_prfl_tmax(JLEV),ZAV(JLEV,1,IIJ)))
- ZAV(JLEV,2,IIJ)= MAX(coef%lim_prfl_gmin(JLEV,IWATER), &
- MIN(coef%lim_prfl_gmax(JLEV,IWATER),ZAV(JLEV,2,IIJ)))
- END DO
- DEALLOCATE(ZPIN,ZFIN,ZOUT)
- END DO
-END DO
-DEALLOCATE(ZVINT)
-DEALLOCATE(ZPAVE,ZTAVE,ZQVAVE,ZO3AVE)
-!
-!--------------------------------------------------------------------------
-!
-!* 6. CALLS THE RTTOV RADIATION CODE
-! ------------------------------
-!
-!* 6.1 INITIALIZES 2D AND SURFACE FIELDS
-!
-!
-ALLOCATE(ZANGS(KDLON))
-ZANGS(:)=0. ! zenithal solar angle not used
-!
-ALLOCATE(IMSURF(KDLON))
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- IMSURF(IIJ) = NINT(XSEA(JI,JJ)) ! Surface Mask 0=land, 1=sea, 2=sea-ice
- END DO
-END DO
-!
-ALLOCATE(ZSAV(JPNSAV,KDLON)) ! Surface 2m array contents
-! fields taken at first level rather than at 2m
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZSAV(1,IIJ) = ZTEMP(JI,JJ,IKB) ! 2m temperature (K)
- ZSAV(2,IIJ) = PRT(JI,JJ,IKB,1)*q_mixratio_to_ppmv ! 2m water vapor (ppmv)
- ZSAV(3,IIJ) = XP00*0.01 * & !Surface Pressure in hPa
- (0.5*(ZEXNT(JI,JJ,IKB)+ZEXNT(JI,JJ,IKB-1)))**(XCPD/XRD)
- ZSAV(4,IIJ) = PULVLKB(JI,JJ) ! 2m wind speed u (m/s)
- ZSAV(5,IIJ) = PVLVLKB(JI,JJ) ! 2m wind speed v (m/s)
- END DO
-END DO
-!
-ALLOCATE(ZSSV(JPNSSV,KDLON)) !Surface skin array contents
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZSSV(1,IIJ) = PTSRAD(JI,JJ)
- ZSSV(2,IIJ) = 2.3 ! FASTEM-2 land coef (Bare soil see Table 3 svr)
- ZSSV(3,IIJ) = 1.9 ! FASTEM-2 land coef
- ZSSV(4,IIJ) = 21.8 ! FASTEM-2 land coef
- ZSSV(5,IIJ) = 0.0 ! FASTEM-2 land coef
- ZSSV(6,IIJ) = 0.5 ! FASTEM-2 land coef
- END DO
-END DO
-!
-!
-ALLOCATE(ZAP(KDLON,IKR))
-DO JK=IKB,IKE
- JKRAD = IKE-JK+1 !INVERSION OF VERTICAL LEVELS!
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZAP(IIJ,JKRAD)=PPABST(JI,JJ,JK)*0.01 !Pressure in hPa
- END DO
- END DO
-END DO
-!
-!
-ALLOCATE(ZAP_HL(KDLON,IKR+1))
-DO JK=IKB,IKE+1
- JKRAD = IKE-JK+2 !INVERSION OF VERTICAL LEVELS!
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZAP_HL(IIJ,JKRAD)=XP00*0.01 * & !Pressure in hPa
- (0.5*(ZEXNT(JI,JJ,JK)+ZEXNT(JI,JJ,JK-1)))**(XCPD/XRD)
- END DO
- END DO
-END DO
-DEALLOCATE(ZEXNT)
-!
-!
-ALLOCATE(ZNCLD(IIU,IJU,IKU))
-ZNCLD=0.
-ALLOCATE(ZRC(IIU,IJU,IKU))
-ZRC=0.
-ALLOCATE(ZRI(IIU,IJU,IKU))
-ZRI=0.
-ALLOCATE(ZRR(IIU,IJU,IKU))
-ZRR=0.
-ALLOCATE(ZRS(IIU,IJU,IKU))
-ZRS=0.
-IF( SIZE(PRT(:,:,:,:),4) >= 3 ) THEN
- ZRC=PRT(:,:,:,2)
- ZRR=PRT(:,:,:,3)
- IF( OUSERI ) THEN
-! ice
- ZRI=PRT(:,:,:,4)
- ZRS=PRT(:,:,:,5)+PRT(:,:,:,6)
- END IF
- ZNCLD=PCLDFR
-END IF
-
-! temperature and cloud field on full-model levels
-ALLOCATE(ZCV(KDLON,IKR,JPNCVCLD))
-ZCV = 0.
-
-DO JK=IKB,IKE
- JKRAD = IKE-JK+1 !INVERSION OF VERTICAL LEVELS!
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZCV(IIJ,JKRAD,1)=ZTEMP(JI,JJ,JK) !Temperature (K)
- ZCV(IIJ,JKRAD,2)=ZNCLD(JI,JJ,JK) !Cloud cover (fraction)
- ZCV(IIJ,JKRAD,3)=MIN(ZRCMAX,ZRC(JI,JJ,JK)) !Cloud liquid water (kg/kg)
- ZCV(IIJ,JKRAD,4)=MIN(ZRIMAX,ZRI(JI,JJ,JK)) !Cloud ice water (kg/kg)
-! rttov_iniscatt modified
-! ZCV(IIJ,JKRAD,5)=ZRR(JI,JJ,JK) !rain (kg/m2/s)
-! ZCV(IIJ,JKRAD,6)=ZRS(JI,JJ,JK) !solid precipitation (kg/m2/s)
- ZCV(IIJ,JKRAD,5)=MIN(ZRRMAX,ZRR(JI,JJ,JK)) !rain (kg/kg)
- ZCV(IIJ,JKRAD,6)=MIN(ZRSMAX,ZRS(JI,JJ,JK)) !solid precipitation (kg/kg)
- END DO
- END DO
-END DO
-DEALLOCATE(ZTEMP,ZNCLD,ZRC,ZRI,ZRR,ZRS)
-!
-!
-ALLOCATE(ZREMIS(KDLON))
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZREMIS(IIJ) = PEMIS(JI,JJ)
- END DO
-END DO
-!
-ALLOCATE(ZULAT(KDLON))
-ALLOCATE(ZULON(KDLON))
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZULON(IIJ) = XLON(JI,JJ)
- ZULAT(IIJ) = XLAT(JI,JJ)
- END DO
-END DO
-!
-!* 6.2 CALLS THE RTTOV ROUTINES
-!
-!
-ALLOCATE( rttov_errorstatus(nprofiles))
-
-! Profiles on RTTOV pressure levels
-ALLOCATE( profiles(nprofiles))
-DO JI = 1, nprofiles
-! allocate model profiles atmospheric arrays with model levels dimension
- profiles(JI) % nlevels = coef % nlevels
- ALLOCATE( profiles(JI) % p ( coef % nlevels ) )
- ALLOCATE( profiles(JI) % t ( coef % nlevels ) )
- ALLOCATE( profiles(JI) % q ( coef % nlevels ) )
- ALLOCATE( profiles(JI) % o3 ( coef % nlevels ) )
- ALLOCATE( profiles(JI) % clw( coef % nlevels ) )
- profiles(JI) % p(:) = coef % ref_prfl_p(:)
-END DO
-! Cloud additional profiles
-ALLOCATE( cld_profiles(nprofiles))
-DO JI = 1, nprofiles
-! allocate model profiles atmospheric arrays with model levels dimension
- cld_profiles(JI) % nlevels = IKR
- ALLOCATE( cld_profiles(JI) % p ( IKR ) )
- ALLOCATE( cld_profiles(JI) % ph ( IKR+1 ) )
- ALLOCATE( cld_profiles(JI) % t ( IKR ) )
- ALLOCATE( cld_profiles(JI) % cc ( IKR ) )
- ALLOCATE( cld_profiles(JI) % clw( IKR ) )
- ALLOCATE( cld_profiles(JI) % ciw( IKR ) )
- ALLOCATE( cld_profiles(JI) % rain( IKR ) )
- ALLOCATE( cld_profiles(JI) % sp( IKR ) )
-END DO
-
-! -----------------------------------------------------------------------------
-! *** LOOP OVER SENSORS ***
-! -----------------------------------------------------------------------------
-DO JSAT=1,IJSAT ! loop over sensors
-
- instrument(1)=KRTTOVINFO(1,JSAT)
- instrument(2)=KRTTOVINFO(2,JSAT)
- instrument(3)=KRTTOVINFO(3,JSAT)
- PRINT *,' JSAT=',JSAT, instrument
-
-! Read and initialise coefficients
-! -----------------------------------------------------------------------------
- CALL rttov_readcoeffs (errorstatus, coef, instrument)
- IF(errorstatus /= 0) THEN
- WRITE(*,*) 'error rttov_readcoeffs :',errorstatus
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV8','error rttov_readcoeffs')
- ENDIF
- CALL rttov_initcoeffs (errorstatus,coef)
- IF(errorstatus /= 0) THEN
- WRITE(*,*) 'error rttov_initcoeffs :',errorstatus
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV8','error rttov_initcoeffs')
- ENDIF
-
- ! Read coef file for cloud/rain absorption/scattering
- IF( coef% id_sensor == sensor_id_mw) THEN
- CALL rttov_readscattcoeffs (errorstatus, coef, coef_scatt)
- ENDIF
-
- ALLOCATE(ZANGL(KDLON))
- ZANGL=XUNDEF
- IF (KRTTOVINFO(1,JSAT) == 1) THEN ! NOAA PLATFORM
- ZANGL=0.
- ELSEIF (KRTTOVINFO(1,JSAT) == 2) THEN ! DMSP PLATFORM
- ZANGL=53.1 ! see Saunders, 2002, RTTOV7 - science/validation rep, page 8
-! METEOSAT PLATFORM
- ELSEIF (KRTTOVINFO(1,JSAT) == 3) THEN
- CALL DETER_ANGLE(5, KDLON, ZULAT, ZULON, ZANGL)
-! Conversion from cosecant to angle (deg)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
-! MSG PLATFORM
- ELSEIF (KRTTOVINFO(1,JSAT) == 12) THEN
- CALL DETER_ANGLE(6, KDLON, ZULAT, ZULON, ZANGL)
-! Conversion from cosecant to angle (deg)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
- ELSEIF (KRTTOVINFO(1,JSAT) == 4) THEN ! GOES-E PLATFORM
- CALL DETER_ANGLE(1, KDLON, ZULAT, ZULON, ZANGL)
-! Conversion from cosecant to angle (deg)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
- ELSEIF (KRTTOVINFO(1,JSAT) == 7) THEN ! TRMM PLATFORM
- ZANGL=52.3 ! see Kummerow et al., J. Appl. Meteorol., Dec. 2000
- ENDIF
-! Coefficients computed from transmittances for 6 viewing angles in the range
-! 0 to 63.6 deg (Saunders, 2002, RTTOV7 - science/validation rep., page 3)
- WHERE (ZANGL > 65.) ZANGL=65.
-
- ALLOCATE(n_chan(nprofiles))
- n_chan=coef%fmv_chn
- CALL rttov_setupchan(nprofiles,n_chan,coef,nfrequencies,nchannels,nbtout)
-
- ALLOCATE( channels ( nfrequencies ) )
- ALLOCATE( lprofiles ( nfrequencies ) )
- ALLOCATE( lsprofiles ( nchannels ) )
- ALLOCATE( lsprofiles2 ( nbtout ) )
- ALLOCATE( emissivity ( nchannels ) )
- ALLOCATE( frequencies ( nchannels ) )
- ALLOCATE( polarisations ( nchannels ,3) )
- ALLOCATE( input_emissivity ( nchannels ) )
- ALLOCATE( calcemis ( nchannels ) )
-
- ALLOCATE( transmission % tau_surf ( nchannels ) )
- ALLOCATE( transmission % tau_layer ( coef % nlevels, nchannels ) )
- ALLOCATE( transmission % od_singlelayer( coef % nlevels, nchannels ) )
-
- calcemis(1:nchannels) = .TRUE.
- input_emissivity(1:nchannels) = 0.5
- emissivity(1:nchannels) = 0.
-
-! allocate radiance results arrays with number of channels
- ALLOCATE( radiance % clear ( nchannels ) )
- ALLOCATE( radiance % cloudy ( nchannels ) )
- ALLOCATE( radiance % total ( nchannels ) )
- ALLOCATE( radiance % bt ( nchannels ) )
- ALLOCATE( radiance % bt_clear ( nchannels ) )
- ALLOCATE( radiance % upclear ( nchannels ) )
- ALLOCATE( radiance % dnclear ( nchannels ) )
- ALLOCATE( radiance % reflclear( nchannels ) )
- ALLOCATE( radiance % overcast ( IKR, nchannels ) )
- ALLOCATE( radiance % downcld ( IKR, nchannels ) )
- ALLOCATE( radiance % cldemis ( IKR, nchannels ) )
- ALLOCATE( radiance % wtoa ( IKR, nchannels ) )
- ALLOCATE( radiance % wsurf ( IKR, nchannels ) )
- ALLOCATE( radiance % cs_wtoa ( nchannels ) )
- ALLOCATE( radiance % cs_wsurf ( nchannels ) )
- ALLOCATE( radiance % out ( nbtout ) )
- ALLOCATE( radiance % out_clear( nbtout ) )
- ALLOCATE( radiance % total_out( nbtout ) )
- ALLOCATE( radiance % clear_out( nbtout ) )
- ALLOCATE( radiance % freq_used( nchannels) )
-
-! Allocate new profiles for K code
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
-! Profiles on RTTOV pressure levels
- ALLOCATE( profiles_k(nchannels))
- DO JI = 1, nchannels
-! allocate model profiles atmospheric arrays with model levels dimension
- profiles_k(JI) % nlevels = coef % nlevels
- ALLOCATE( profiles_k(JI) % p ( coef % nlevels ) )
- ALLOCATE( profiles_k(JI) % t ( coef % nlevels ) )
- ALLOCATE( profiles_k(JI) % q ( coef % nlevels ) )
- ALLOCATE( profiles_k(JI) % o3 ( coef % nlevels ) )
- ALLOCATE( profiles_k(JI) % clw( coef % nlevels ) )
- profiles_k(JI) % p(:) = coef % ref_prfl_p(:)
- END DO
-! Cloud additional profiles
- ALLOCATE( cld_profiles_k(nchannels))
- DO JI = 1, nchannels
-! allocate model profiles atmospheric arrays with model levels dimension
- cld_profiles_k(JI) % nlevels = IKR
- ALLOCATE( cld_profiles_k(JI) % p ( IKR ) )
- ALLOCATE( cld_profiles_k(JI) % ph ( IKR+1 ) )
- ALLOCATE( cld_profiles_k(JI) % t ( IKR ) )
- ALLOCATE( cld_profiles_k(JI) % cc ( IKR ) )
- ALLOCATE( cld_profiles_k(JI) % clw( IKR ) )
- ALLOCATE( cld_profiles_k(JI) % ciw( IKR ) )
- END DO
- ALLOCATE( emissivity_k( nchannels ))
- END IF
-
-
-! fixed values
- profiles(1:nprofiles) % ozone_data = .TRUE.
- profiles(1:nprofiles) % co2_data = .FALSE.
- profiles(1:nprofiles) % clw_data = .FALSE.
- profiles(1:nprofiles) % s2m % o = 0.
- profiles(1:nprofiles) % azangle = 0. !!!!!! WARNING
- profiles(1:nprofiles) % ctp = 500._JPRB ! default value
- profiles(1:nprofiles) % cfraction = 0._JPRB ! default value
-! See rttov_emiscld.F90
- cld_profiles(1:nprofiles) % kice = 0 ! Hexagonal columns
-! cld_profiles(1:nprofiles) % kice = 1 ! Aggregates
-! cld_profiles(1:nprofiles) % kradip = 0 ! Ou-Liou
-! cld_profiles(1:nprofiles) % kradip = 1 ! Wyser
-! cld_profiles(1:nprofiles) % kradip = 2 ! Boudala et al.
- cld_profiles(1:nprofiles) % kradip = 3 ! McFarquhar
-
- PRINT *,'cld_profiles % kice = ',cld_profiles(1) % kice
- PRINT *,'cld_profiles % kradip = ',cld_profiles(1) % kradip
-
- CALL rttov_setupindex (n_chan,nprofiles,nfrequencies,nchannels,nbtout,coef, &
- & input_emissivity,lprofiles,channels,polarisations,emissivity)
-
-!!! Set up remaining indices
- IF( coef% id_sensor == sensor_id_mw) &
- CALL rttov_scatt_setupindex (nprofiles,n_chan,coef,nchannels, &
- & lsprofiles, lsprofiles2, frequencies,nbtout)
-
-!!! METEOSAT, GOES, OR MSG PLATFORM
- IF (KRTTOVINFO(1,JSAT) == 3 .OR. KRTTOVINFO(1,JSAT) == 4 &
- .OR. KRTTOVINFO(1,JSAT) == 12) &
- calcemis(1:nchannels) = .FALSE.
-
-
- ALLOCATE(GANGL(KDLON))
- GANGL(:) = .TRUE.
- WHERE( ZANGL(:) == XUNDEF)
- GANGL(:) = .FALSE.
- END WHERE
-
- IDIM = COUNT( GANGL(:) ) ! number of columns with a defined sat angle
-
- ALLOCATE(ZANGLP(IDIM))
- ZANGLP = PACK( ZANGL,MASK=GANGL )
-
- ALLOCATE(ZAVP(JPLEV,JPNAV,IDIM))
- DO JC=1,JPNAV
- DO JK=1,JPLEV
- ZAVP(JK,JC,:) = PACK( ZAV(JK,JC,:),MASK=GANGL )
- END DO
- END DO
-
- ALLOCATE(ZSAVP(JPNSAV,IDIM))
- DO JK=1,JPNSAV
- ZSAVP(JK,:) = PACK( ZSAV(JK,:),MASK=GANGL )
- END DO
-
- ALLOCATE(IMSURFP(IDIM))
- IMSURFP = PACK( IMSURF,MASK=GANGL )
-
- ALLOCATE(ZSSVP(JPNSSV,IDIM))
- DO JK=1,JPNSSV
- ZSSVP(JK,:) = PACK( ZSSV(JK,:),MASK=GANGL )
- END DO
-
- ALLOCATE(ZCVP(IDIM,IKR,JPNCVCLD))
- DO JC=1,JPNCVCLD
- DO JK=1,IKR
- ZCVP(:,JK,JC) = PACK( ZCV(:,JK,JC),MASK=GANGL )
- END DO
- END DO
-
- ALLOCATE(ZAPP(IDIM,IKR))
- DO JK=1,IKR
- ZAPP(:,JK) = PACK( ZAP(:,JK),MASK=GANGL )
- END DO
-
- ALLOCATE(ZAP_HLP(IDIM,IKR+1))
- DO JK=1,IKR+1
- ZAP_HLP(:,JK) = PACK( ZAP_HL(:,JK),MASK=GANGL )
- END DO
-
- ALLOCATE(ZREMISP(IDIM))
- ZREMISP = PACK( ZREMIS,MASK=GANGL )
-
- ALLOCATE(ZZTMP(coef%fmv_chn,KDLON))
- ALLOCATE(ZZTMPP(coef%fmv_chn,IDIM))
- ZZTMP=XUNDEF
- ZZTMPP=XUNDEF
-
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
- ALLOCATE(ZTEMPKP(coef%fmv_chn,KDLON,JPLEV))
- ALLOCATE(ZTEMPKPP(coef%fmv_chn,IDIM,JPLEV))
- ALLOCATE(ZWVAPKP(coef%fmv_chn,KDLON,JPLEV))
- ALLOCATE(ZWVAPKPP(coef%fmv_chn,IDIM,JPLEV))
- ZTEMPKP=XUNDEF
- ZTEMPKPP=XUNDEF
- ZWVAPKP=XUNDEF
- ZWVAPKPP=XUNDEF
- ENDIF
-
- DO JIS=1,IDIM,nprofiles
- IBEG = JIS
- IEND = MIN(JIS+nprofiles-1,IDIM)
- ntruepro=IEND-IBEG+1
-
- ICPT=IBEG
- DO JI=1,ntruepro
- profiles(JI) % t(:) = ZAVP(:,1,ICPT)
- profiles(JI) % q(:) = ZAVP(:,2,ICPT)
- profiles(JI) % o3(:) = ZAVP(:,3,ICPT)
-! Surface
- profiles(JI) % s2m % p = ZSAVP(3,ICPT)
- profiles(JI) % s2m % q = ZSAVP(2,ICPT)
- profiles(JI) % s2m % t = ZSAVP(1,ICPT)
- profiles(JI) % s2m % u = ZSAVP(4,ICPT)
- profiles(JI) % s2m % v = ZSAVP(5,ICPT)
- profiles(JI) % skin % surftype = IMSURFP(ICPT)
- profiles(JI) % skin % t = ZSSVP(1,ICPT)
- profiles(JI) % skin % fastem(:) = &
-! RTTOV 8.5 example
-! (/ 3.0_JPRB, 5.0_JPRB, 15.0_JPRB, 0.1_JPRB, 0.3_JPRB /)
-! Bare soil see Table 3 svr rttov7)
- (/ 2.3_JPRB, 1.9_JPRB, 21.8_JPRB, 0.0_JPRB, 0.5_JPRB /)
-! Angles
- profiles(JI) % zenangle = ZANGLP(ICPT)
-! Cloudy atmosphere on Meso-NH levels
- cld_profiles(JI) % p (:) = ZAPP(ICPT,:)
- cld_profiles(JI) % ph (:) = ZAP_HLP(ICPT,:)
- cld_profiles(JI) % t (:) = ZCVP(ICPT,:,1)
- cld_profiles(JI) % cc (:) = ZCVP(ICPT,:,2)
- cld_profiles(JI) % clw(:) = ZCVP(ICPT,:,3)
- cld_profiles(JI) % ciw(:) = ZCVP(ICPT,:,4)
- cld_profiles(JI) % rain(:) = ZCVP(ICPT,:,5)
- cld_profiles(JI) % sp(:) = ZCVP(ICPT,:,6)
- ICPT=ICPT+1
- END DO
-
- ICAN=0
- ICPT=IBEG
- DO JI=1,ntruepro
- DO JCH=1,coef%fmv_chn
- ICAN=ICAN+1
- IF (.NOT.calcemis(ICAN)) emissivity(ICAN) = ZREMISP(ICPT)
- END DO
- ICPT=ICPT+1
- END DO
-
- IF( coef% id_sensor /= sensor_id_mw) THEN
- CALL rttov_cld( &
- & rttov_errorstatus, &! out
- & nfrequencies, &! in
- & nchannels, &! in
- & nbtout, &! in
- & nprofiles, &! in
- & channels, &! in
- & polarisations, &! in
- & lprofiles, &! in
- & profiles, &! inout (to invalid clw absorption)
- & cld_profiles, &! in
- & coef, &! in
- & calcemis, &! in
- & emissivity, &! inout
- & radiance ) ! inout
- ELSE
- iwp_levels=IKR
- CALL rttov_scatt( &
- & rttov_errorstatus, &! out
- & iwp_levels, & ! in
- & coef%nlevels, & ! in
- & nfrequencies, &! in
- & nchannels, &! in
- & nbtout, &! in
- & nprofiles, &! in
- & polarisations, &! in
- & channels, & ! in
- & frequencies, & ! in
- & lprofiles, &! in
- & lsprofiles, & ! in
- & profiles, &! inout (to invalid clw absorption)
- & cld_profiles, &! in
- & coef, &! in
- & coef_scatt, &! in
- & calcemis, &! in
- & emissivity, &! inout
- & radiance ) ! inout
- END IF
-
- IF (INRAD==1) THEN
-! cloudy radiance for given cloud
- ICAN=0
- ICPT=IBEG
- DO JI=1,ntruepro
- DO JCH=1,coef%fmv_chn
- ICAN=ICAN+1
- ZZTMPP(JCH,ICPT) = radiance%total_out (ICAN)
- END DO
- ICPT=ICPT+1
- END DO
- ELSE
-! BT equivalent to total radiance
- ICAN=0
- ICPT=IBEG
- DO JI=1,ntruepro
- DO JCH=1,coef%fmv_chn
- ICAN=ICAN+1
- ZZTMPP(JCH,ICPT) = radiance%out (ICAN)
- END DO
- ICPT=ICPT+1
- END DO
- ENDIF
-! PRINT *,'size',coef%fmv_chn,IDIM,KDLON,SIZE(ZZTMPP,1),SIZE(ZZTMPP,2)
-! PRINT *,'ZZTMP min/max ',MINVAL(ZZTMPP(:,:)),MAXVAL(ZZTMPP(:,:))
-
-
-! Calling for K code
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
-!!! IF (JIS==1) THEN
-!! IF( coef% id_sensor /= sensor_id_mw) THEN
- CALL rttov_cld_k ( &
- & rttov_errorstatus, &! out
- & nfrequencies, &! in
- & nchannels, &! in
- & nbtout, &! in
- & nprofiles, &! in
- & channels, &! in
- & polarisations, &! in
- & lprofiles, &! in
- & profiles, &! in
- & cld_profiles, &! in
- & coef, &! in
- & switchrad, &! in
- & calcemis, &! in
- & emissivity, &! inout
- & profiles_k , &! inout
- & cld_profiles_k , &! inout
- & emissivity_k , &! inout
- & radiance) ! inout
-!!! ENDIF
-
- ICAN=0
- ICPT=IBEG
- DO JI=1,ntruepro
- DO JCH=1,coef%fmv_chn
- ICAN=ICAN+1
- DO JK=1,JPLEV
- ZTEMPKPP(JCH,ICPT,JK) = profiles_k(ICAN) % t (JK)
- ZWVAPKPP(JCH,ICPT,JK) = profiles_k(ICAN) % q (JK)
- END DO
- END DO
- ICPT=ICPT+1
- END DO
-! DO JK=1,JPLEV
-! PRINT *,JK,' temp ',MINVAL(ZTEMPKPP(:,:,JK)),MAXVAL(ZTEMPKPP(:,:,JK))
-! PRINT *,JK,' vap ',MINVAL(ZWVAPKPP(:,:,JK)),MAXVAL(ZWVAPKPP(:,:,JK))
-! END DO
- END IF
- END DO
-! Unpack the vector
- DO JCH=1,coef%fmv_chn
- ZZTMP(JCH,:) = UNPACK( ZZTMPP(JCH,:), MASK=GANGL, FIELD=XUNDEF )
- END DO
- DEALLOCATE(ZZTMPP,ZANGLP)
- DEALLOCATE(ZAVP,ZSAVP,IMSURFP,ZSSVP,ZCVP,ZAPP,ZAP_HLP,ZREMISP)
-! -----------------------------------------------------------------------------
-! Generate angle and BT images
- ALLOCATE(ZANTMP(IIU,IJU))
- ZANTMP = XUNDEF
- ALLOCATE(ZTBTMP(IIU,IJU,coef%fmv_chn))
- ZTBTMP = XUNDEF
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZANTMP(JI,JJ) = ZANGL(IIJ)
- ZTBTMP(JI,JJ,:) = ZZTMP(:,IIJ)
- END DO
- END DO
- DEALLOCATE(ZANGL,ZZTMP)
-! -----------------------------------------------------------------------------
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
- DO JCH=1,coef%fmv_chn
- DO JK=1,JPLEV
- ZTEMPKP(JCH,:,JK)=UNPACK(ZTEMPKPP(JCH,:,JK),MASK=GANGL,FIELD=XUNDEF )
- ZWVAPKP(JCH,:,JK)=UNPACK(ZWVAPKPP(JCH,:,JK),MASK=GANGL,FIELD=XUNDEF )
- END DO
- END DO
- DEALLOCATE(ZTEMPKPP,ZWVAPKPP)
- ENDIF
-! -----------------------------------------------------------------------------
- IF (KRTTOVINFO(3,JSAT) == 20) THEN ! MVIRI
- YINST='MVIRI'
-! YINST=inst_name(KRTTOVINFO(3,JSAT))
-! DO JK1=1,LEN_TRIM(inst_name(KRTTOVINFO(3,JSAT)))
-! YINST(JK1:JK1)=CHAR(ICHAR(YINST(JK1:JK1))-32)
-! END DO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YINST)//'_ANGL', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YINST)//'_ANGL', &
- CUNITS = 'degree', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YINST)//' ANGLE' &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT
- CALL IO_Field_write(TPFILE,TZFIELD,ZANTMP)
- END IF
- DEALLOCATE(ZANTMP)
-! -----------------------------------------------------------------------------
- YBEG=' '
- IF (KRTTOVINFO(1,JSAT) <= 2 .OR. KRTTOVINFO(1,JSAT) == 4) THEN ! NOAA
- WRITE(YTWO,'(I2.2)') KRTTOVINFO(2,JSAT)
- YBEG=TRIM(YPLAT(KRTTOVINFO(1,JSAT)))//YTWO
- ELSEIF (KRTTOVINFO(1,JSAT) <= JPPLAT) THEN
- WRITE(YONE,'(I1.1)') KRTTOVINFO(2,JSAT)
- YBEG=TRIM(YPLAT(KRTTOVINFO(1,JSAT)))//YONE
- ELSE
- YBEG='XXXX'
- END IF
- WRITE(YTWO,'(I2.2)') KRTTOVINFO(3,JSAT)
-!*JPC*VECTORIZATION
-! DO JCH=1,nbtout
- DO JCH=1,coef%fmv_chn
-!*JPC*VECTORIZATION
- YEND=' '
- WRITE(YCHAN,'(I2.2)') JCH
- IF (KRTTOVINFO(3,JSAT) == 0) THEN ! HIRS
- YEND='H'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 3) THEN ! AMSU-A
- YEND='A'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 4) THEN ! AMSU-B
- YEND='B'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 6) THEN ! SSMI
- YEND=YLBL_SSMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 9) THEN ! TMI
- YEND=YLBL_TMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 20) THEN ! MVIRI
- YEND=YLBL_MVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 21) THEN ! SEVIRI
- YEND=YLBL_SEVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 22) THEN ! GOES-I
- YEND=YLBL_GOESI(JCH)
- ELSE
- YEND=YTWO//YCHAN
- END IF
- IF (INRAD==1) THEN
- YMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'rad'
- YUNITS = 'mw/cm-1/ster/sq.m'
- YCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' rad'
- ELSE
- YMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'BT'
- YUNITS = 'K'
- YCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' BT'
- ENDIF
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM( YMNHNAME ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( YMNHNAME ), &
- CUNITS = TRIM( YUNITS ), &
- CDIR = 'XY', &
- CCOMMENT = TRIM( YCOMMENT ), &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT, &
- MINVAL(ZTBTMP(:,:,JCH),ZTBTMP(:,:,JCH)/=XUNDEF), &
- MAXVAL(ZTBTMP(:,:,JCH),ZTBTMP(:,:,JCH)/=XUNDEF)
- CALL IO_Field_write(TPFILE,TZFIELD,ZTBTMP(:,:,JCH))
- IF (KRTTOVINFO(3,JSAT) == 4.AND. JCH==3 ) THEN ! AMSU-B
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YBEG)//'_UTH', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YBEG)//'_UTH', &
- CUNITS = 'percent', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YBEG)//'_UTH', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
-! UTH computation from Buehler and John JGR 2005
- ZZH= 833000. ! (m) nominal altitude of the satellite
- zdeg_to_rad = XPI / 180.0
- zrad_to_deg = 180.0 / XPI
- zbeta = zdeg_to_rad*0.55 ! angle of incident radiation
-! viewing angle alpha
- zalpha = zrad_to_deg*ASIN(XRADIUS/(XRADIUS+zzh)*SIN(zbeta))
- ALLOCATE(ZUTH(IIU,IJU))
- ZUTH = XUNDEF
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IF (ZTBTMP(JI,JJ,JCH)/=XUNDEF) THEN
- ZUTH(JI,JJ) = 100.*COS(zdeg_to_rad*zalpha) &
- *EXP(18.341-0.0764737*ZTBTMP(JI,JJ,JCH))
- END IF
- END DO
- END DO
- CALL IO_Field_write(TPFILE,TZFIELD,ZUTH)
- DEALLOCATE(ZUTH)
- END IF
- END DO
-! -----------------------------------------------------------------------------
-! Jacobian fields
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
- ALLOCATE(ZTEMPK(IIU,IJU,IKU))
- ALLOCATE(ZWVAPK(IIU,IJU,IKU))
- ALLOCATE(ZFIN(JPLEV))
- DO JCH=1,coef%fmv_chn
- YEND=' '
- WRITE(YCHAN,'(I2.2)') JCH
- IF (KRTTOVINFO(3,JSAT) == 0) THEN ! HIRS
- YEND='H'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 3) THEN ! AMSU-A
- YEND='A'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 4) THEN ! AMSU-B
- YEND='B'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 6) THEN ! SSMI
- YEND=YLBL_SSMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 9) THEN ! TMI
- YEND=YLBL_TMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 20) THEN ! MVIRI
- YEND=YLBL_MVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 21) THEN ! SEVIRI
- YEND=YLBL_SEVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 22) THEN ! GOES-I
- YEND=YLBL_GOESI(JCH)
- ELSE
- YEND=YTWO//YCHAN
- END IF
- ZTEMPK = XUNDEF
- ZWVAPK = XUNDEF
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- DO JK=1,JPLEV
- JKRAD=JPLEV-JK+1
- ZFIN(JK)=ZTEMPKP(JCH,IIJ,JKRAD)
- END DO
- CALL PINTER(ZFIN, ZPRES_INV, ZFIN, ZFIN, &
- ZTEMPK(JI,JJ,IKB:IKE), PPABST(JI,JJ,IKB:IKE), &
- 1, 1, JPLEV, 1, IKR, 'LOG', 'RHU.')
- DO JK=1,JPLEV
- JKRAD=JPLEV-JK+1
- ZFIN(JK)=ZWVAPKP(JCH,IIJ,JKRAD)
- END DO
- CALL PINTER(ZFIN, ZPRES_INV, ZFIN, ZFIN, &
- ZWVAPK(JI,JJ,IKB:IKE), PPABST(JI,JJ,IKB:IKE), &
- 1, 1, JPLEV, 1, IKR, 'LOG', 'RHU.')
- END DO
- END DO
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'JAT', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'JAT', &
- CUNITS = 'K K-1', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' JATEMP', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT, &
- MINVAL(ZTEMPK(:,:,:),ZTEMPK(:,:,:)/=XUNDEF), &
- MAXVAL(ZTEMPK(:,:,:),ZTEMPK(:,:,:)/=XUNDEF)
- CALL IO_Field_write(TPFILE,TZFIELD,ZTEMPK(:,:,:))
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'JAV', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'JAV', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' JAWVAP', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- WHERE (ZWVAPK(:,:,:) /= XUNDEF) &
- ZWVAPK(:,:,:)=ZWVAPK(:,:,:)*(-0.1*PRT(:,:,:,1))
- PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT, &
- MINVAL(ZWVAPK(:,:,:),ZWVAPK(:,:,:)/=XUNDEF), &
- MAXVAL(ZWVAPK(:,:,:),ZWVAPK(:,:,:)/=XUNDEF)
- CALL IO_Field_write(TPFILE,TZFIELD,ZWVAPK(:,:,:))
- END DO
- DEALLOCATE(ZTEMPKP,ZWVAPKP,ZFIN)
- ENDIF
-! -----------------------------------------------------------------------------
- DEALLOCATE(GANGL,ZTBTMP)
- DEALLOCATE(channels,lprofiles,lsprofiles,lsprofiles2,emissivity,frequencies)
- DEALLOCATE(n_chan,polarisations,input_emissivity,calcemis)
- DEALLOCATE( transmission % tau_surf )
- DEALLOCATE( transmission % tau_layer )
- DEALLOCATE( transmission % od_singlelayer )
- DEALLOCATE(radiance % clear)
- DEALLOCATE( radiance % cloudy)
- DEALLOCATE( radiance % total )
- DEALLOCATE( radiance % bt )
- DEALLOCATE( radiance % bt_clear )
- DEALLOCATE( radiance % upclear )
- DEALLOCATE( radiance % dnclear )
- DEALLOCATE( radiance % reflclear )
- DEALLOCATE( radiance % overcast )
- DEALLOCATE( radiance % downcld )
- DEALLOCATE( radiance % cldemis )
- DEALLOCATE( radiance % wtoa )
- DEALLOCATE( radiance % wsurf )
- DEALLOCATE( radiance % cs_wtoa )
- DEALLOCATE( radiance % cs_wsurf )
- DEALLOCATE( radiance % out )
- DEALLOCATE( radiance % out_clear )
- DEALLOCATE( radiance % total_out )
- DEALLOCATE( radiance % clear_out )
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
- DEALLOCATE(ZTEMPK,ZWVAPK)
- DEALLOCATE( profiles_k)
- DEALLOCATE( cld_profiles_k)
- DEALLOCATE( emissivity_k)
- ENDIF
-END DO
-DEALLOCATE(ZULAT,ZULON,ZANGS,IMSURF)
-DEALLOCATE(ZAV,ZSAV,ZSSV,ZCV,ZAP,ZAP_HL)
-#else
-PRINT *, "RTTOV 8.7 LIBRARY NOT AVAILABLE = ###CALL_RTTOV8####"
-#endif
-!
-END SUBROUTINE CALL_RTTOV8
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 091e1faa0382764d736761b84ebad58a5bc58bea..9c51049af75258c04ed198e1930161d63e4c1722 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2024 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.
@@ -226,6 +226,7 @@ END MODULE MODI_DEFAULT_DESFM_n
! Delbeke/Vie 03/2022: KHKO option in LIMA
! P. Wautelet 27/04/2022: add namelist for profilers
! PA. Joulin 04/2023: add EOL/ADR
+! V. Masson 01/2024: aggregation of columns for radiation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index c37f6136c83fb3621712f9a34aee2fdd133e69cd..fd25ea531d56d9849962cdda587f46d2bebd84c6 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -199,7 +199,7 @@ REAL, DIMENSION(:,:,:,:),ALLOCATABLE :: ZWETDEPAER
TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL() !Namelist file
!
NAMELIST/NAM_DIAG/ CISO, LVAR_RS, LVAR_LS, &
- NCONV_KF, NRAD_3D, CRAD_SAT, NRTTOVINFO, LRAD_SUBG_COND, &
+ NCONV_KF, NRAD_3D, NRTTOVINFO, LRAD_SUBG_COND, &
LVAR_TURB,LTURBFLX,LTURBDIAG,LMFFLX,XDTSTEP, &
LVAR_MRW, LVAR_MRSV, LVAR_FRC, &
LTPZH, LMOIST_V, LMOIST_E,LMOIST_ES, &
@@ -248,7 +248,6 @@ LVAR_RS=.TRUE.
LVAR_LS=.FALSE.
NCONV_KF=-1
NRAD_3D=-1
-CRAD_SAT=' '
LRAD_SUBG_COND=.TRUE.
NRTTOVINFO(:,:)=NUNDEF
LVAR_TURB=.FALSE.
@@ -567,10 +566,6 @@ IF (NRAD_3D >= 0) THEN
END IF
END IF
!
-IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. YRAD/='ECMW') THEN
- CRAD = 'ECMW'
-END IF
-!
!
IF ( CTURB /= 'NONE' .OR. CDCONV /= 'NONE' .OR. CSCONV /= 'NONE' &
.OR. CRAD /= 'NONE' ) THEN
diff --git a/src/MNH/ecrad_interface.f90 b/src/MNH/ecrad_interface.f90
index 19830f9896f118c40384137108b54baf9a1eed3d..96a2821ab84e8e6311a5faaebf36905008090891 100644
--- a/src/MNH/ecrad_interface.f90
+++ b/src/MNH/ecrad_interface.f90
@@ -441,6 +441,7 @@ CALL RADIATION_SCHEME (IKIDIA, IKFDIA,KLON, KLEV, IAER, &
PAP, PT, PAPH, PTH, &
PQ, ZCCO2, ZCCH4, ZCN2O, ZCNO2, ZCCFC11, ZCCFC12, ZCCFC22, ZCCCL4, ZOZON, &
PCLFR, PQLWC, PQIWC, PQRWC, ZQSWC, &
+ PCCT_C2R2, PCRT_C2R2, PCIT_C1R3, &
ZAEROSOL_OLD, ZAEROSOL, &
ZFLUX_SW, ZFLUX_LW, ZFLUX_SW_CLEAR, ZFLUX_LW_CLEAR, &
ZFLUX_SW_SURF, ZFLUX_LW_SURF, ZFLUX_SW_SURF_CLEAR, ZFLUX_LW_SURF_CLEAR, &
diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90
index 6d135c72c053f1094f5978b6deb5fd48d6f4f802..79aeb4ff4470f358b595d3a0a989095c3b092db8 100644
--- a/src/MNH/ground_paramn.f90
+++ b/src/MNH/ground_paramn.f90
@@ -226,6 +226,7 @@ USE MODI_MNH_OASIS_SEND
#ifdef MNH_FOREFIRE
USE MODI_COUPLING_FOREFIRE_n
#endif
+USE MODI_COUPLING_SURF_ATM_MULTI_LEVEL_n
!
IMPLICIT NONE
!
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index a5ed1e2d4eb85a0fc8a6255941442b5bd135bbc3..93bc1ab1e36a082e94ef0b3e7dbdfb686896ad60 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -1964,9 +1964,20 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
tzsource%lavailable = ohorelax_rr
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
tzsource%cmnhname = 'NETUR'
tzsource%clongname = 'negativity correction induced by turbulence'
- tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'VISC'
@@ -2451,11 +2462,20 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
tzsource%lavailable = ohorelax_rs
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
-! tzsource%cmnhname = 'NETUR'
-! tzsource%clongname = 'negativity correction induced by turbulence'
-! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
-! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
-! call Budget_source_add( tbudgets(NBUDGET_RS), tzsource nneturrs )
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
tzsource%cmnhname = 'VISC'
tzsource%clongname = 'viscosity'
@@ -2642,11 +2662,20 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then
tzsource%lavailable = ohorelax_rg
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
-! tzsource%cmnhname = 'NETUR'
-! tzsource%clongname = 'negativity correction induced by turbulence'
-! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
-! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
-! call Budget_source_add( tbudgets(NBUDGET_RG), tzsource nneturrg )
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
tzsource%cmnhname = 'VISC'
tzsource%clongname = 'viscosity'
@@ -2851,11 +2880,20 @@ if ( tbudgets(NBUDGET_RH)%lenabled ) then
tzsource%lavailable = ohorelax_rh
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
-! tzsource%cmnhname = 'NETUR'
-! tzsource%clongname = 'negativity correction induced by turbulence'
-! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
-! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
-! call Budget_source_add( tbudgets(NBUDGET_RH), tzsource nneturrh )
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
tzsource%cmnhname = 'VISC'
tzsource%clongname = 'viscosity'
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 6f2fa0cb9132107bb815629c9dc82434665031c1..5d54d01f0fdc00849070c26e6bb1bfb98f44630d 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2024 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.
@@ -299,6 +299,7 @@ END MODULE MODI_INI_MODEL_n
! A. Costes 12/2021: Blaze fire model
! H. Toumi 09/2022: add EOL/ADR
! C. Barthe 03/2023: if cloud electricity is activated, both ini_micron and ini_elecn are called
+! V. Masson 01/2024: aggregation of columns for radiation
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1556,6 +1557,7 @@ IF (CRAD /= 'NONE') THEN
ALLOCATE(XDTHRADSW(IIU,IJU,IKU))
ALLOCATE(XDTHRADLW(IIU,IJU,IKU))
ALLOCATE(XRADEFF(IIU,IJU,IKU))
+ ALLOCATE(NRAD_AGG_FLAG(IIU,IJU))
ELSE
ALLOCATE(XSLOPANG(0,0))
ALLOCATE(XSLOPAZI(0,0))
@@ -1575,6 +1577,7 @@ ELSE
ALLOCATE(XDTHRADSW(0,0,0))
ALLOCATE(XDTHRADLW(0,0,0))
ALLOCATE(XRADEFF(0,0,0))
+ ALLOCATE(NRAD_AGG_FLAG(0,0))
END IF
IF (CRAD == 'ECMW' .OR. CRAD == 'ECRA') THEN
@@ -2545,7 +2548,8 @@ IF (CRAD /= 'NONE') THEN
XRADEFF,XSWU,XSWD,XLWU, &
XLWD,XDTHRADSW,XDTHRADLW, &
NRAD_AGG,NI_RAD_AGG,NJ_RAD_AGG, &
- NIOR_RAD_AGG,NJOR_RAD_AGG )
+ NIOR_RAD_AGG,NJOR_RAD_AGG, &
+ NRAD_AGG_FLAG )
!
IF (GINIRAD) CALL SUNPOS_n(XZENITH,PAZIMSOL=XAZIM)
CALL SURF_SOLAR_GEOM (XZS, XZS_XY)
diff --git a/src/MNH/ini_one_wayn.f90 b/src/MNH/ini_one_wayn.f90
index c18ff402abe26556640f5cd8acbee57b5b75e108..70c20e10a462c48c3d24abc10a979ff529bd5589 100644
--- a/src/MNH/ini_one_wayn.f90
+++ b/src/MNH/ini_one_wayn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1999-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1999-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -103,10 +103,12 @@ USE MODD_NSV, only: NSV_A, NSV_C1R3BEG_A, NSV_C1R3_A, NSV_C2R2BEG_A,
NSV_CHEM_A, NSV_CHICBEG_A, NSV_CHIC_A, NSV_DSTBEG_A, NSV_DSTDEPBEG_A, NSV_DSTDEP_A, NSV_DST_A, &
NSV_ELECBEG_A, NSV_ELEC_A, NSV_LGBEG_A, NSV_LG_A, NSV_LIMA_A, NSV_LIMA_BEG_A, &
NSV_LNOXBEG_A, NSV_LNOX_A, NSV_PPBEG_A, NSV_PP_A, &
- NSV_SLTBEG_A, NSV_SLTDEPBEG_A, NSV_SLTDEP_A, NSV_SLT_A, NSV_USER_A
+
#ifdef MNH_FOREFIRE
-USE MODD_NSV, only: NSV_FF_A, NSV_FFBEG_A
-#endif
+ NSV_FFBEG_A, NSV_FF_A, &
+#endif
+ NSV_SLTBEG_A, NSV_SLTDEPBEG_A, NSV_SLTDEP_A, NSV_SLT_A, NSV_USER_A
+
USE MODD_PARAM_n, only: CCLOUD
USE MODD_REF, ONLY: LCOUPLES
USE MODD_REF_n, only: XRHODJ, XRHODREF
diff --git a/src/MNH/ini_radiations.f90 b/src/MNH/ini_radiations.f90
index 2b11a5890fb9357e2de1deaf81a350504057ec22..a19a3b71f7b722e67e2a13a19595a49730531f54 100644
--- a/src/MNH/ini_radiations.f90
+++ b/src/MNH/ini_radiations.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2024 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.
@@ -16,7 +16,8 @@ INTERFACE
PFLALWD,PDIRSRFSWD,KCLEARCOL_TM1, &
PZENITH, PAZIM, TPDTRAD_FULL,TPDTRAD_CLONLY,TPINITHALO2D_ll, &
PRADEFF,PSWU,PSWD,PLWU,PLWD,PDTHRADSW,PDTHRADLW, &
- KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG )
+ KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG, &
+ KRAD_AGG_FLAG )
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_IO, ONLY : TFILEDATA
@@ -66,6 +67,7 @@ INTEGER, INTENT(OUT) :: KI_RAD_AGG ! reformatted X array size
INTEGER, INTENT(OUT) :: KJ_RAD_AGG ! reformatted Y array size
INTEGER, INTENT(OUT) :: KIOR_RAD_AGG ! index of first point of packed array according to current domain
INTEGER, INTENT(OUT) :: KJOR_RAD_AGG ! index of first point of packed array according to current domain
+INTEGER, DIMENSION(:,:), INTENT(OUT) :: KRAD_AGG_FLAG ! flag to know if aggregated column is computed in this processor or another one
END SUBROUTINE INI_RADIATIONS
!
@@ -82,7 +84,8 @@ END MODULE MODI_INI_RADIATIONS
PFLALWD,PDIRSRFSWD,KCLEARCOL_TM1, &
PZENITH, PAZIM, TPDTRAD_FULL,TPDTRAD_CLONLY,TPINITHALO2D_ll, &
PRADEFF,PSWU,PSWD,PLWU,PLWD,PDTHRADSW,PDTHRADLW, &
- KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG )
+ KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG, &
+ KRAD_AGG_FLAG )
! ####################################################################
!
!!**** *INI_RADIATION_TIME * - initialisation for radiation scheme in the MesoNH framework
@@ -119,6 +122,7 @@ END MODULE MODI_INI_RADIATIONS
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated 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
+! V. Masson 03/01/2024: aggregation of columns for radiation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -187,6 +191,7 @@ INTEGER, INTENT(OUT) :: KI_RAD_AGG ! reformatted X array size
INTEGER, INTENT(OUT) :: KJ_RAD_AGG ! reformatted Y array size
INTEGER, INTENT(OUT) :: KIOR_RAD_AGG ! index of first point of packed array according to current domain
INTEGER, INTENT(OUT) :: KJOR_RAD_AGG ! index of first point of packed array according to current domain
+INTEGER, DIMENSION(:,:), INTENT(OUT) :: KRAD_AGG_FLAG ! flag to know if aggregated column is computed in this processor or another one
!
!* 0.2 declarations of local variables
!
@@ -343,7 +348,7 @@ END IF
!* 10. INITIALIZE COLUMN AGGREGATION FOR RADIATION CALL
! -------------------------------------------------
-CALL INI_RADIATIONS_AGG (KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG)
+CALL INI_RADIATIONS_AGG (KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG,KRAD_AGG_FLAG)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_radiations_agg.f90 b/src/MNH/ini_radiations_agg.f90
index 0ec198677c8a0e1d3015567b2680cbf11e471760..71679e0ddb087e875d444825b1e1ed747ad11c9d 100644
--- a/src/MNH/ini_radiations_agg.f90
+++ b/src/MNH/ini_radiations_agg.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2023-2024 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.
@@ -9,12 +9,13 @@
!
INTERFACE
- SUBROUTINE INI_RADIATIONS_AGG (KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG)
+ SUBROUTINE INI_RADIATIONS_AGG (KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG,KRAD_AGG_FLAG)
INTEGER, INTENT(IN) :: KRAD_AGG ! number of aggregated points
INTEGER, INTENT(OUT) :: KI_RAD_AGG ! reformatted X array size
INTEGER, INTENT(OUT) :: KJ_RAD_AGG ! reformatted Y array size
INTEGER, INTENT(OUT) :: KIOR_RAD_AGG ! index of first point of packed array according to current domain
INTEGER, INTENT(OUT) :: KJOR_RAD_AGG ! index of first point of packed array according to current domain
+INTEGER, DIMENSION(:,:), INTENT(OUT) :: KRAD_AGG_FLAG ! flag to know if aggregated column is computed in this processor or another one
END SUBROUTINE INI_RADIATIONS_AGG
END INTERFACE
@@ -22,7 +23,7 @@ END INTERFACE
END MODULE MODI_INI_RADIATIONS_AGG
!
! ############################################################################
- SUBROUTINE INI_RADIATIONS_AGG (KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG)
+ SUBROUTINE INI_RADIATIONS_AGG (KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG,KRAD_AGG_FLAG)
! ############################################################################
!
!!**** *INI_RADIATIONS_AGG * - routine to call the SW and LW radiation calculations
@@ -95,6 +96,7 @@ INTEGER, INTENT(OUT) :: KI_RAD_AGG ! reformatted X array size
INTEGER, INTENT(OUT) :: KJ_RAD_AGG ! reformatted Y array size
INTEGER, INTENT(OUT) :: KIOR_RAD_AGG ! index of first point of packed array according to current domain
INTEGER, INTENT(OUT) :: KJOR_RAD_AGG ! index of first point of packed array according to current domain
+INTEGER, DIMENSION(:,:), INTENT(OUT) :: KRAD_AGG_FLAG ! flag to know if aggregated column is computed in this processor or another one
!
!
!* 0.2 DECLARATIONS OF LOCAL VARIABLES
@@ -119,6 +121,9 @@ INTEGER :: IJOR_ll ! index of first point in the processor relative to the
!
INTEGER :: ILUOUT ! Logical unit
INTEGER :: IMI
+
+LOGICAL :: LREMOVE_SOUTH, LREMOVE_NORTH, LREMOVE_EAST, LREMOVE_WEST ! flags to not keep packed column in current processor
+INTEGER :: ISOUTH, INORTH, IEAST, IWEST ! inner limits of packed colums on each side of the processor (in local coordinate)
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
@@ -191,6 +196,7 @@ KJOR_RAD_AGG = IJOR_RAD_AGG_ll - IJOR_ll + 1
KIOR_RAD_AGG = KIOR_RAD_AGG + ((IIB-KIOR_RAD_AGG)/KRAD_AGG) * KRAD_AGG
KJOR_RAD_AGG = KJOR_RAD_AGG + ((IJB-KJOR_RAD_AGG)/KRAD_AGG) * KRAD_AGG
!
+!-------------------------------------------------------------------------------
!
! Number of PACKED radiative subdomains inside current processor domain
KI_RAD_AGG = (IIE - KIOR_RAD_AGG) / KRAD_AGG + 1
@@ -198,5 +204,119 @@ KJ_RAD_AGG = (IJE - KJOR_RAD_AGG) / KRAD_AGG + 1
!
!-------------------------------------------------------------------------------
!
+! REMOVES Aggregated columns that are duplicated in several processors
+!
+! Checks if the middle of the packed column is in the current processor
+!
+LREMOVE_SOUTH = .FALSE.
+LREMOVE_NORTH = .FALSE.
+LREMOVE_EAST = .FALSE.
+LREMOVE_WEST = .FALSE.
+!
+KRAD_AGG_FLAG(:,:) = 0.
+!
+! inner limits of packed colums on each side of the processor (in local coordinate)
+IWEST = KIOR_RAD_AGG + KRAD_AGG-1
+IEAST = KIOR_RAD_AGG + (KI_RAD_AGG-1)*KRAD_AGG
+ISOUTH = KJOR_RAD_AGG + KRAD_AGG-1
+INORTH = KJOR_RAD_AGG + (KJ_RAD_AGG-1)*KRAD_AGG
+!
+! Eastern side of processor (if NOT of whole domain) (checks on last X index of aggregated columns)
+IF (IEAST+KRAD_AGG/2 > IIE .AND. .NOT. (LEAST_ll() .AND. CLBCX(2)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(IEAST:IIE,:) = 3 ! points located there will take values computed by processor towards east
+ LREMOVE_EAST = .TRUE.
+END IF
+! Western side of processor (if NOT of whole domain) (checks on first X index of aggregated columns)
+IF (KIOR_RAD_AGG+KRAD_AGG/2 < IIB .AND. .NOT. (LWEST_ll() .AND. CLBCX(1)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(IIB:IWEST,:) = 1 ! points located there will take values computed by processor towards west
+ LREMOVE_WEST = .TRUE.
+END IF
+! Northern side of processor (if NOT of whole domain) (checks on last Y index of aggregated columns)
+IF (INORTH+KRAD_AGG/2 > IJE .AND. .NOT. (LNORTH_ll() .AND. CLBCY(2)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(:,INORTH:IJE) = 4 ! points located there will take values computed by processor towards north
+ LREMOVE_NORTH= .TRUE.
+END IF
+! Southern side of processor (if NOT of whole domain) (checks on first X index of aggregated columns)
+IF (KJOR_RAD_AGG+KRAD_AGG/2 < IJB .AND. .NOT. (LSOUTH_ll() .AND. CLBCY(1)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(:,IJB:ISOUTH) = 2 ! points located there will take values computed by processor towards south
+ LREMOVE_SOUTH= .TRUE.
+END IF
+!
+! North-Eastern corner of processor (if NOT of whole domain)
+IF ( IEAST+KRAD_AGG/2 > IIE .AND. INORTH+KRAD_AGG/2 > IJE ) THEN
+ IF (.NOT. (LEAST_ll() .AND. CLBCX(2)=='OPEN') .AND. .NOT. (LNORTH_ll() .AND. CLBCY(2)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(IEAST:IIE,INORTH:IJE) = 7
+ ! points located there will take values computed by processor towards NE
+ LREMOVE_EAST = .TRUE.
+ LREMOVE_NORTH = .TRUE.
+ ELSE IF ( (LEAST_ll() .AND. CLBCX(2)=='OPEN') .AND. .NOT. (LNORTH_ll() .AND. CLBCY(2)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(:,INORTH:IJE) = 4 ! points located there will take values computed by processor towards north
+ LREMOVE_NORTH = .TRUE.
+ ELSE IF ( (LNORTH_ll() .AND. CLBCY(2)=='OPEN') .AND. .NOT. (LEAST_ll() .AND. CLBCX(2)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(IEAST:IIE,:) = 3 ! points located there will take values computed by processor towards east
+ LREMOVE_EAST = .TRUE.
+ END IF
+END IF
+!
+! North-Western corner of processor (if NOT of whole domain)
+IF ( KIOR_RAD_AGG+KRAD_AGG/2 < IIB .AND. INORTH+KRAD_AGG/2 > IJE ) THEN
+ IF (.NOT. (LWEST_ll() .AND. CLBCX(1)=='OPEN') .AND. .NOT. (LNORTH_ll() .AND. CLBCY(2)=='OPEN')) THEN
+ KRAD_AGG_FLAG(IIB:IWEST,INORTH:IJE) = 8 ! points located there will take values computed by processor towards NW
+ LREMOVE_WEST = .TRUE.
+ LREMOVE_NORTH = .TRUE.
+ ELSE IF ( (LWEST_ll() .AND. CLBCX(1)=='OPEN') .AND. .NOT. (LNORTH_ll() .AND. CLBCY(2)=='OPEN')) THEN
+ KRAD_AGG_FLAG(IIB:IWEST,INORTH:IJE) = 4 ! points located there will take values computed by processor towards north
+ LREMOVE_NORTH = .TRUE.
+ ELSE IF ( (LNORTH_ll() .AND. CLBCY(2)=='OPEN') .AND. .NOT. (LWEST_ll() .AND. CLBCX(1)=='OPEN')) THEN
+ KRAD_AGG_FLAG(IIB:IWEST,INORTH:IJE) = 1 ! points located there will take values computed by processor towards west
+ LREMOVE_WEST = .TRUE.
+ END IF
+END IF
+!
+! South-Western corner of processor (if NOT of whole domain)
+IF ( KIOR_RAD_AGG+KRAD_AGG/2 < IIB .AND. KJOR_RAD_AGG+KRAD_AGG/2 < IJB ) THEN
+ IF (.NOT. (LWEST_ll() .AND. CLBCX(1)=='OPEN') .AND. .NOT. (LSOUTH_ll() .AND. CLBCY(1)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(IIB:IWEST,IIB:ISOUTH) = 5 ! points located there will take values computed by processor towards SW
+ LREMOVE_WEST = .TRUE.
+ LREMOVE_SOUTH = .TRUE.
+ ELSE IF ( (LWEST_ll() .AND. CLBCX(1)=='OPEN') .AND. .NOT. (LSOUTH_ll() .AND. CLBCY(1)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(IIB:IWEST,IIB:ISOUTH) = 2 ! points located there will take values computed by processor towards south
+ LREMOVE_SOUTH = .TRUE.
+ ELSE IF ( (LSOUTH_ll() .AND. CLBCY(2)=='OPEN') .AND. .NOT. (LWEST_ll() .AND. CLBCX(1)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(IIB:IWEST,IIB:ISOUTH) = 1 ! points located there will take values computed by processor towards west
+ LREMOVE_WEST = .TRUE.
+ END IF
+END IF
+!
+! South-Eastern corner of processor (if NOT of whole domain)
+IF ( IEAST+KRAD_AGG/2 > IIE .AND. KJOR_RAD_AGG+KRAD_AGG/2 < IJB ) THEN
+ IF (.NOT. (LEAST_ll() .AND. CLBCX(1)=='OPEN') .AND. .NOT. (LSOUTH_ll() .AND. CLBCY(1)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(IEAST:IIE,IIB:ISOUTH) = 6 ! points located there will take values computed by processor towards SW
+ LREMOVE_EAST = .TRUE.
+ LREMOVE_SOUTH = .TRUE.
+ ELSE IF ( (LEAST_ll() .AND. CLBCX(1)=='OPEN') .AND. .NOT. (LSOUTH_ll() .AND. CLBCY(1)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(IEAST:IIE,IIB:ISOUTH) = 2 ! points located there will take values computed by processor towards south
+ LREMOVE_SOUTH = .TRUE.
+ ELSE IF ( (LSOUTH_ll() .AND. CLBCY(2)=='OPEN') .AND. .NOT. (LEAST_ll() .AND. CLBCX(1)=='OPEN') ) THEN
+ KRAD_AGG_FLAG(IEAST:IIE,IIB:ISOUTH) = 3 ! points located there will take values computed by processor towards west
+ LREMOVE_EAST = .TRUE.
+ END IF
+END IF
+!
+! removes from current processor the column that was partially (and majoritaly) in the other processor
+!
+IF (LREMOVE_EAST) KI_RAD_AGG = KI_RAD_AGG -1
+IF (LREMOVE_WEST) THEN
+ KIOR_RAD_AGG = KIOR_RAD_AGG + KRAD_AGG
+ KI_RAD_AGG = KI_RAD_AGG -1
+END IF
+IF (LREMOVE_NORTH) KJ_RAD_AGG = KJ_RAD_AGG -1
+IF (LREMOVE_SOUTH) THEN
+ KJOR_RAD_AGG = KJOR_RAD_AGG + KRAD_AGG
+ KJ_RAD_AGG = KJ_RAD_AGG -1
+END IF
+!
+!-------------------------------------------------------------------------------
+!
END SUBROUTINE INI_RADIATIONS_AGG
diff --git a/src/MNH/modd_diag_flag.f90 b/src/MNH/modd_diag_flag.f90
index 3115f14260767f60d010c5ecf7d427d6fd95c643..94ce52ed553e1f112e8f136f7cb2dbd18b316d0c 100644
--- a/src/MNH/modd_diag_flag.f90
+++ b/src/MNH/modd_diag_flag.f90
@@ -56,7 +56,6 @@ LOGICAL :: LVAR_RS ! UM,VM,WM,RVM
LOGICAL :: LVAR_LS ! LSUM,LSVM,LSWM,LSRVM
INTEGER :: NCONV_KF ! Convective scheme
INTEGER :: NRAD_3D ! Radiative scheme
-CHARACTER(LEN=44) :: CRAD_SAT ! GOES-E,GOES-W,GMS,INDSAT,METEOSAT
LOGICAL :: LRAD_SUBG_COND ! to activate subgrid condensation
!scheme in the radiatif transfer code
!rttov and satellites variables
diff --git a/src/MNH/modd_param_radn.f90 b/src/MNH/modd_param_radn.f90
index f429c6938df934a31c6e27faae57c152e2cd4d9e..613a2de1e2fd7390f20a0105ec3e6a74ce40b38c 100644
--- a/src/MNH/modd_param_radn.f90
+++ b/src/MNH/modd_param_radn.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2024 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/11/23 17:28:26
!-----------------------------------------------------------------
! ########################
MODULE MODD_PARAM_RAD_n
@@ -43,6 +39,7 @@
!! F.Solmon 15/03/02 add the control parameter for aerosol and cloud radiative
!! properties. Remove the NSPOT option.
!! B.Aouizerats 07/11 add aerosol optical properties CAOP
+! V. Masson 03/01/2024: aggregation of columns for radiation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/modd_radiationsn.f90 b/src/MNH/modd_radiationsn.f90
index 64be9ce63847ff5c8e7583dcc75ba5687cf3f8d9..4cac01d2d720f3fbb4a41c9835d9401fd1200d7e 100644
--- a/src/MNH/modd_radiationsn.f90
+++ b/src/MNH/modd_radiationsn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2024 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.
@@ -38,7 +38,7 @@
!! multiple wavelengths for surface SW
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 08/02/2019: add missing NULL association for pointers
-!!
+! V. Masson 03/01/2024: aggregation of columns for radiation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -132,6 +132,7 @@ TYPE RADIATIONS_t
INTEGER :: NJ_RAD_AGG ! reformatted Y array size
INTEGER :: NIOR_RAD_AGG ! index of first point of packed array according to current domain
INTEGER :: NJOR_RAD_AGG ! index of first point of packed array according to current domain
+ INTEGER, DIMENSION(:,:), POINTER :: NRAD_AGG_FLAG=>NULL() ! status on which processor is calculated the aggregated column
!
END TYPE RADIATIONS_t
@@ -196,6 +197,7 @@ INTEGER, POINTER :: NI_RAD_AGG=>NULL() ! reformatted X array size
INTEGER, POINTER :: NJ_RAD_AGG=>NULL() ! reformatted Y array size
INTEGER, POINTER :: NIOR_RAD_AGG=>NULL() ! index of first point of packed array according to current domain
INTEGER, POINTER :: NJOR_RAD_AGG=>NULL() ! index of first point of packed array according to current domain
+INTEGER, DIMENSION(:,:),POINTER :: NRAD_AGG_FLAG=>NULL()
CONTAINS
@@ -236,6 +238,7 @@ RADIATIONS_MODEL(KFROM)%XLWD=>XLWD
RADIATIONS_MODEL(KFROM)%XDTHRADSW=>XDTHRADSW
RADIATIONS_MODEL(KFROM)%XDTHRADLW=>XDTHRADLW
RADIATIONS_MODEL(KFROM)%XRADEFF=>XRADEFF
+RADIATIONS_MODEL(KFROM)%NRAD_AGG_FLAG=>NRAD_AGG_FLAG
!
! Current model is set to model KTO
NDLON=>RADIATIONS_MODEL(KTO)%NDLON
@@ -297,6 +300,7 @@ NI_RAD_AGG=>RADIATIONS_MODEL(KTO)%NI_RAD_AGG
NJ_RAD_AGG=>RADIATIONS_MODEL(KTO)%NJ_RAD_AGG
NIOR_RAD_AGG=>RADIATIONS_MODEL(KTO)%NIOR_RAD_AGG
NJOR_RAD_AGG=>RADIATIONS_MODEL(KTO)%NJOR_RAD_AGG
+NRAD_AGG_FLAG=>RADIATIONS_MODEL(KTO)%NRAD_AGG_FLAG
END SUBROUTINE RADIATIONS_GOTO_MODEL
diff --git a/src/MNH/modn_param_radn.f90 b/src/MNH/modn_param_radn.f90
index 477e14df948919878d4aa28f3d4be08f16570dc4..ddcc8c11a0067620c0b731c9de284a242b84e12b 100644
--- a/src/MNH/modn_param_radn.f90
+++ b/src/MNH/modn_param_radn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2024 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/11/23 17:22:54
-!-----------------------------------------------------------------
! ########################
MODULE MODN_PARAM_RAD_n
! ########################
diff --git a/src/MNH/nband_model.fx90 b/src/MNH/nband_model.fx90
deleted file mode 100644
index 6005b838759cf188856ece7a479f72945cf033a2..0000000000000000000000000000000000000000
--- a/src/MNH/nband_model.fx90
+++ /dev/null
@@ -1,2286 +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.
-!-----------------------------------------------------------------
-***FILE: nband_model.f
-***AUTHOR: J.-P. Chaboureau *LA*
-***DATE: 29/03/00
-***ORIGINAL: original from JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-***MODIFIED: I.Mallet (02/11/00) added F90 Interface (MODD_RAD_TRANSF)
-* and changed name of variables concerned
-* indicated by "*MNH"
-* named nband_model.f90 and compiled with -Fixed
-* J.Escobar (1/12/2017) bug => intialized all ZV=0.0 in spectr
-* P. Wautelet 21/11/2019: replace several CONTINUE (workaround of problems with gfortran OpenACC)
-* P. Wautelet 17/12/2021: comment ZBSUI variable (not used and was not initialized)
-*
- SUBROUTINE NBMVEC
- I ( KIDIA ,KFDIA ,KLON,KLEV,KGL,KCABS,KNG1,KUABS
- I , KH2O ,KCO2 ,KO3,KCNT,KN2O,KCH4,KCO,KC11,KC12,KCFC
- I , KINIS ,KENDS ,KCONF,KCLOUD,KOVLP
- L , LPVOIGT, LPTDEP
- R , PTAVE, PQVAVE, PO3AVE, PPL, PT
- R , PANGLE , PCLDLD, PCLDLU
- R , PDT0 ,PEM0
-c R , PFBBDC ,PFBBDT,PFBBUC,PFBBUT
-c R , PFDC ,PFDT ,PFDTI,PFUC,PFUT,PFUTI
- R , PRADC ,PRADT)
-C
-C**** *NBMVEC* - VECTORIZED NARROW BAND MODEL OF THE LONGWAVE RADIATION
-C TRANSFER
-C
-C** INTERFACE
-C ---------
-C *NBMVEC* IS CALLED BY *NARROW*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C KIDIA : START OF VECTOR
-C KFDIA : END OF VECTOR
-C KLON : TOTAL LENGTH OF VECTOR
-C KLEV : NUMBER OF FULL-LEVELS (LAYERS)
-C KGL : NUMBER OF SUB-LAYERS IN VERTICAL INTEGRATION
-C KCABS : CONFIGURATION INDEX FOR ABSORBERS
-C LPVOIGT : .T. IF VOIGT PROFILE IS ACCOUNTED FOR
-C === OUTPUTS ===
-C PFBBDC : BROAD-BAND DOWNWARD CLEAR-SKY FLUXES (SURF./TOA)
-C PFBBDT : BROAD-BAND DOWNWARD TOTAL FLUXES (SURF./TOA)
-C PFBBUC : BROAD-BAND UPWARD CLEAR-SKY FLUXES (SURF./TOA)
-C PFBBUT : BROAD-BAND UPWARD TOTAL FLUXES (SURF./TOA)
-C PFDC,PFUC: CLEAR-SKY FLUXES (ALL HALF-LEVELS)
-C PFDT,PFUT: TOTAL FLUXES (ALL HALF-LEVELS)
-C PRADC : CLEAR-SKY SPECTRAL RADIANCE AT T.O.A.
-C PRADT : TOTAL-SKY SPECTRAL RADIANCE AT T.O.A.
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- !include 'implic.h'
- LOGICAL LPTDEP, LPVOIGT
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomrad.h'
-*MNH integer NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH real CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,FTEMP(JV3),
-*MNH & FCH2O(JV3),FCCO2(JV3),FCO3(JV3),XLIM(JV10),CLIM(JV2)
-*MNH COMMON/YOMRADI/NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH COMMON /YOMRADR/CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,
-*MNH & FTEMP,FCH2O,FCCO2,FCO3,XLIM,CLIM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-*MNH real WNUTOT(2,20), POLPLCKTOT(6,2,20), RODWALTOT(6,8,20)
-*MNH COMMON /YOMSPET/ WNUTOT, RODWALTOT, POLPLCKTOT
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
-C
- REAL PDT0(KLON), PEM0(KLON), PPL(KLON,KLEV+1), PT(KLON,KLEV+1)
- REAL PO3AVE(KLON,KLEV), PQVAVE(KLON,KLEV), PTAVE(KLON,KLEV)
- REAL PCLDLD(KLON,KLEV), PCLDLU(KLON,KLEV)
- REAL PANGLE(KLON)
- REAL PRADC(KLON,20), PRADT(KLON,20)
-C ------------------------------------------------------------------
-C
- REAL
- * ZDPM(KLON,3*KLEV) , ZDUC(KLON,3*KLEV)
- * , ZSSIG(KLON,3*KLEV+1)
- * , ZU(KLON,8,3*KLEV+1) , ZUPM(KLON,3*KLEV)
- * , ZXT(KLON,3,3*KLEV+1) , ZXOZ(KLON) , ZXWV(KLON)
-C ------------------------------------------------------------------
-C
-C ------------------------------------------------------------------
-C
-C 1. INITIALISATION
-C --------------
- 100 CONTINUE
-C
-C IF (NIMP.EQ.0) STOP
-
- PVGH2O = 30.
- PVGCO2 = 60.
- PVGO3 = 400.
- RG = 9.80665
- ZEPSCO = 1.E-12
- !ZEPSCQ = 1.E-12 NOT ENOUGH
- ZEPSCQ = 1.E-8
-*MNH PCMCO2 = CVCO2 * RCO2M / RAIRM
- PCMCO2 = X1CO2 * XCO2M / XAIRM
-*MNH PCMN2O = CVN2O * RN2OM / RAIRM
- PCMN2O = XN2O * XN2OM / XAIRM
-*MNH PCMCH4 = CVCH4 * RCH4M / RAIRM
- PCMCH4 = XCH4 * XCH4M / XAIRM
-C
- DO JA=1,8
- DO JK=1,KGL+1
- DO JL=KIDIA,KFDIA
- ZU(JL,JA,JK)=0.
- END DO
- END DO
- END DO
- DO JA=1,3
- DO JK=1,KGL+1
- DO JL=KIDIA,KFDIA
- ZXT(JL,JA,JK)=0.
- END DO
- END DO
- END DO
-c DO 113 JNIV=1,2
-c DO 112 JSI=1,10
-c DO 111 JL=KIDIA,KFDIA
-c PFBBDC(JL,JSI,JNIV)=0.
-c PFBBUC(JL,JSI,JNIV)=0.
-c PFBBDT(JL,JSI,JNIV)=0.
-c PFBBUT(JL,JSI,JNIV)=0.
-c 111 CONTINUE
-c 112 CONTINUE
-c 113 CONTINUE
-C
-C ------------------------------------------------------------------
-C
-C* 2. PRESSURE OVER GAUSS SUB-LEVELS
-C ------------------------------
-C
- 200 CONTINUE
-C
- IG1P1=KNG1+1
- DO JL=KIDIA,KFDIA
- ZSSIG(JL,1)=PPL(JL,1)
- END DO
-C
- DO JK = 1 , KLEV
- JKJ=(JK-1)*IG1P1+1
- JKJR = JKJ
- JKJP = JKJ + IG1P1
- DO JL = KIDIA,KFDIA
- ZSSIG(JL,JKJP)=PPL(JL,JK+1)
- END DO
- DO IG1=1,KNG1
- JKJ=JKJ+1
- DO JL = KIDIA,KFDIA
- ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5
-*MNH S + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5
- S + XRT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5
- END DO
- END DO
- END DO
-C
-C-----------------------------------------------------------------------
-C
-C* 3. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
-C --------------------------------------------------
-C
- 300 CONTINUE
-C
- DO 302 JKI=1,KGL
- JKIP1=JKI+1
- DO 301 JL = KIDIA,KFDIA
- ZUPM(JL,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5
- ZDPM(JL,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1))/(10.*RG)
- 301 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C PRINT 9301,JKI,ZDPM(JL,JKI),ZUPM(JL,JKI)
-C 9301 FORMAT(1X,I4,2E13.6)
-C END IF
- 302 CONTINUE
-C
- DO JK = 1 , KLEV
- JKP1=JK+1
- JKL = KLEV+1 - JK
- DO JL = KIDIA,KFDIA
- ZXWV(JL) = MAX (PQVAVE(JL,JK) , ZEPSCQ )
- ZXOZ(JL) = MAX (PO3AVE(JL,JK) , ZEPSCO )
- END DO
- JKJ=(JK-1)*IG1P1+1
- JKJPN=JKJ+KNG1
- DO JKK=JKJ,JKJPN
- DO JL = KIDIA,KFDIA
- ZUPMH2O = ( ZUPM(JL,JKK) + PVGH2O ) * ZDPM(JL,JKK) / 101325.
- ZUPMCO2 = ( ZUPM(JL,JKK) + PVGCO2 ) * ZDPM(JL,JKK) / 101325.
- ZUPMO3 = ( ZUPM(JL,JKK) + PVGO3 ) * ZDPM(JL,JKK) / 101325.
- ZDUC(JL,JKK)= ZDPM(JL,JK)
- ZU6= ZXWV(JL) * ZUPMH2O
- ZFPPW= 1.6078 * ZXWV(JL) / (1.+0.608*ZXWV(JL))
- ZU(JL, 1,JKK) = ZXWV(JL) * ZDPM(JL,JKK)
- ZU(JL, 2,JKK) = ZXWV(JL) * ZUPMH2O
- ZU(JL, 3,JKK) = PCMCO2 * ZDPM(JL,JKK)
- ZU(JL, 4,JKK) = PCMCO2 * ZUPMCO2
- ZU(JL, 5,JKK) = ZXOZ(JL) * ZDPM(JL,JKK)
- ZU(JL, 6,JKK) = ZXOZ(JL) * ZUPMO3
- ZU(JL, 7,JKK) = ZU6 * ZFPPW
- ZU(JL, 8,JKK) = ZU6 * (1.-ZFPPW)
- END DO
- END DO
- END DO
- DO JA=1,8
- DO JL=KIDIA,KFDIA
- ZU(JL,JA,KGL+1) = 0.
- END DO
- END DO
-C IF (NIMP.EQ.0) THEN
-C DO 312 JK=1,KGL+1
-C PRINT 9312,JK,(ZU(KIDIA,JA,JK),JA=1,8)
-C 9312 FORMAT(1X,I4,8E13.6)
-C 312 CONTINUE
-C END IF
-C
- CALL SPECTR
- I ( KIDIA,KFDIA,KLON,KLEV,KGL,KCABS,KNG1,KUABS
- I , KH2O,KCO2,KO3,KCNT,KN2O,KCH4,KCO,KC11,KC12,KCFC
- I , KINIS,KENDS,KCONF,KCLOUD,KOVLP
- L , LPVOIGT,LPTDEP
- R , PCMCO2, PCMN2O, PCMN2O, PCMCH4, PCMO2, PCMF11, PCMF12
- R , PANGLE,PCLDLD, PCLDLU
- R , PDT0,PEM0
- R , PT,PTAVE
- R , ZU
- R , PRADC,PRADT
- S )
-
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE SPECTR
- I ( KIDIA,KFDIA,KLON,KLEV,KGL,KCABS,KNG1,KUABS
- I , KH2O,KCO2,KO3,KCNT,KN2O,KCH4,KCO,KC11,KC12,KCFC
- I , KINIS,KENDS,KCONF,KCLOUD,KOVLP
- L , LPVOIGT,LPTDEP
- R , PCMCO2, PCMN2O, PCMCO, PCMCH4, PCMO2, PCMF11, PCMF12
- R , PANGLE,ZCLDLD, ZCLDLU
- R , PDT0,PEM0, PT,PTAVE, PU , PRADC,PRADT)
-C
-C**** *SPECTR* - PERFORMS THE SPECTRAL INTEGRATION
-C
-C** INTERFACE
-C ---------
-C *SPECTR* IS CALLED BY *NBMVEC*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C KIDIA : START OF VECTOR
-C KFDIA : END OF VECTOR
-C KLON : TOTAL LENGTH OF VECTOR
-C KLEV : NUMBER OF FULL-LEVELS (LAYERS)
-C KGL : NUMBER OF SUB-LAYERS IN VERTICAL INTEGRATION
-C KCABS : CONFIGURATION INDEX FOR ABSORBERS
-C LPVOIGT : .T. IF VOIGT PROFILE IS ACCOUNTED FOR
-C === OUTPUTS ===
-C PRADC : CLEAR-SKY SPECTRAL RADIANCE (UPWARD AT TOA)
-C PRADT : TOTAL-SKY SPECTRAL RADIANCE (UPWARD AT TOA)
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C Remy Roca LMD 97 03 03
-c This version is only dedicated to the calculation of the radiance
-c as the satellite may have seen - Jean-Pierre Chaboureau (Dec. 1998).
-c Thus all the flux outputs have been removed to save memory space.
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- LOGICAL LPTDEP, LPVOIGT, LLCNT
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomrad.h'
-*MNH integer NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH real CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,FTEMP(JV3),
-*MNH & FCH2O(JV3),FCCO2(JV3),FCO3(JV3),XLIM(JV10),CLIM(JV2)
-*MNH COMMON/YOMRADI/NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH COMMON /YOMRADR/CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,
-*MNH & FTEMP,FCH2O,FCCO2,FCO3,XLIM,CLIM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-*MNH real WNUTOT(2,20), POLPLCKTOT(6,2,20), RODWALTOT(6,8,20)
-*MNH COMMON /YOMSPET/ WNUTOT, RODWALTOT, POLPLCKTOT
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
-C
- REAL PT(KLON,KLEV+1),PDT0(KLON),PEM0(KLON)
- REAL PTAVE(KLON,KLEV)
- REAL PANGLE(KLON), PU(KLON,8,KGL+1)
- REAL ZCLDLD(KLON,KLEV),ZCLDLU(KLON,KLEV)
-C
- REAL PCNTRB(KLON,KLEV+1,KLEV+1),PRADC(KLON,20),PRADT(KLON,20)
-C ------------------------------------------------------------------
-C
-C 0.2 LOCAL ARRAYS
-C
- REAL
- * ZBINT(KLON,KLEV+1)
- * , ZBLAY(KLON,KLEV)
- * , ZBLEV(KLON,KLEV+1)
- * , ZCNTRB(KLON,KLEV+1,KLEV+1)
- * , ZDZ(KLON,KLEV)
- * , ZTAVSL(KLON,3*KLEV)
-*MNH * , ZV(KLON,JUABS,3*KLEV+1)
- * , ZV(KLON,JPUABS,3*KLEV+1)
- * , ZDBSL(KLON,2*KLEV)
- * , ZCDBSL(KLON,2*KLEV)
- REAL
- * ZBSUI(KLON), ZRES(KLON) ,ZRES2(KLON), ZTI(KLON)
- * , ZTI2(KLON)
- * , ZBSUR(KLON)
- REAL
- * ZFDC(KLON,KLEV+1),ZFDT(KLON,KLEV+1)
- * , ZFUC(KLON,KLEV+1),ZFUT(KLON,KLEV+1)
-C
-C ------------------------------------------------------------------
-C
-C* 1. INITIALIZATION
-C
- 100 CONTINUE
-C
-C IF (NIMP.EQ.0) STOP
-
- IF (KCONF.EQ.0) THEN
- IBOT=1
- ITOP=KLEV+1
- IVDIS=KLEV
- ELSE IF (KCONF.EQ.1) THEN
- IBOT=1
- ITOP=KLEV+1
- IVDIS=1
- ELSE
- IBOT=1
- ITOP=KLEV+1
- IVDIS=1
- WRITE (NULOUT,9101) KCONF
- END IF
-C
-
-
- INH2O=1
- INCO2=2
- INO3 =3
- INN2O=4
- INCH4=5
- INCO =6
- INC11=7
- INC12=8
- INCFC=9
-C
- DO 103 JK1=1,KLEV+1
- DO 102 JK2=1,KLEV+1
- DO 101 JL=KIDIA,KFDIA
- PCNTRB(JL,JK1,JK2)=0.
- 101 CONTINUE
- 102 CONTINUE
- 103 CONTINUE
-C
- IG1P1=KNG1+1
- DO 113 JK=1,KLEV
- JJ=(JK-1)*IG1P1+1
- JJPN=JJ+KNG1
- DO 112 JKSL=JJ,JJPN
- DO 111 JL=KIDIA,KFDIA
- ZTAVSL(JL,JKSL)=PTAVE(JL,JK)
- 111 CONTINUE
- 112 CONTINUE
- 113 CONTINUE
- DO JK=1,2*KLEV
- DO JL=KIDIA,KFDIA
- ZCDBSL(JL,JK)=0.
- END DO
- END DO
-C
-C ------------------------------------------------------------------
-C
-C 2. LOOP ON WAVENUMBER
-C
- 200 CONTINUE
-C
- DO 499 JWVN=KINIS,KENDS
-C
- IH2O=1
- ICNT=1
- ICO2=1
- IO3 =1
- IN2O=1
- ICH4=1
- ICO =1
- IC11=1
- IC12=1
- ICFC=1
-C
-C
-C* 2.1 READ COEFFICIENTS FOR A GIVEN SPECTRAL INTERVAL
-C
- 210 CONTINUE
- do JNU=1,2
-*MNH WNU(JNU)= WNUTOT(JNU,JWVN)
- XWNU(JNU)= XWNUTOT(JNU,JWVN)
-*MNH
- end do
- do JPLA=1,2
- do JPOL=1,6
-*MNH POLPLCK(JPOL,JPLA)= POLPLCKTOT(JPOL,JPLA,JWVN)
- XPOLPLCK(JPOL,JPLA)= XPOLPLCKTOT(JPOL,JPLA,JWVN)
-*MNH
- end do
- end do
- do JABS=1,NA
- do JCOE=1,6
-*MNH RODWAL(JCOE,JABS)= RODWALTOT(JCOE,JABS,JWVN)
- XRODWAL(JCOE,JABS)= XRODWALTOT(JCOE,JABS,JWVN)
-*MNH
- end do
- end do
-C
-C
-C* 2.2 INITIALIZATION
-C
- 220 CONTINUE
-C
- IBBF=1
- DO ICHAN=1,NCHAN
-*MNH IF (WNU(1).GE.XLIM(ICHAN)) IBBF=ICHAN
- IF (XWNU(1).GE.XXLIM(ICHAN)) IBBF=ICHAN
-*MNH
- END DO
-c IF (WNU(1).GE.XLIM(1)) IBBF=1
-c IF (WNU(1).GE.XLIM(2)) IBBF=2
-c IF (WNU(1).GE.XLIM(3)) IBBF=3
-c IF (WNU(1).GE.XLIM(4)) IBBF=4
-c IF (WNU(1).GE.XLIM(5)) IBBF=5
-c IF (WNU(1).GE.XLIM(6)) IBBF=6
-c IF (WNU(1).GE.XLIM(7)) IBBF=7
-c IF (WNU(1).GE.XLIM(8)) IBBF=8
-c IF (WNU(1).GE.XLIM(9)) IBBF=9
-C
-*MNH ZWVN=0.5*(WNU(1)+WNU(2))
- ZWVN=0.5*(XWNU(1)+XWNU(2))
-*MNH WVNA(JWVN)=WNU(1)
- XWVNA(JWVN)=XWNU(1)
-*MNH WVNB(JWVN)=WNU(2)
- XWVNB(JWVN)=XWNU(2)
-*MNH
-C
- DO 224 JKSL=1,2*KLEV
- DO 221 JL=KIDIA,KFDIA
- ZDBSL(JL,JKSL)=0.
- 221 CONTINUE
- DO 223 JABS=1,KUABS
- DO 222 JL=KIDIA,KFDIA
-C ZV(JL,JABS,JKSL)=0.
- 222 CONTINUE
- 223 CONTINUE
- 224 CONTINUE
-C
- ZV = 0.0
-C
- LLCNT=.FALSE.
-*MNH IF (WNU(1).LT.CLIM(1) .OR. WNU(1).GE.CLIM(2)) ICNT=0
- IF (XWNU(1).LT.XCLIM(1) .OR. XWNU(1).GE.XCLIM(2)) ICNT=0
-*MNH IF (WNU(1).GE.330. .OR. WNU(1).LE.1300. ) LLCNT=.TRUE.
- IF (XWNU(1).GE.330. .OR. XWNU(1).LE.1300. ) LLCNT=.TRUE.
-*MNH
-CCO2 IF (WNU(1).LT.500. .OR. WNU(1).GE.1250. ) ICO2=0
-CO3 IF (WNU(1).LT.970. .OR. WNU(1).GE.1110. ) IO3 =0
-C
-*MNH ZA1=RODWAL(1,INH2O)
- ZA1=XRODWAL(1,INH2O)
-*MNH ZA2=RODWAL(1,INCO2)
- ZA2=XRODWAL(1,INCO2)
-*MNH ZA3=RODWAL(1,INO3 )
- ZA3=XRODWAL(1,INO3 )
-*MNH ZA4=RODWAL(1,INN2O)
- ZA4=XRODWAL(1,INN2O)
-*MNH ZA5=RODWAL(1,INCH4)
- ZA5=XRODWAL(1,INCH4)
-*MNH
-C
-C IF (NIMP.EQ.0) THEN
-C PRINT 9224,ZA1,ZA2,ZA3,ZA4,ZA5,KH2O,KCO2,KO3 ,KN2O,KCH4
-C 9224 FORMAT(1X,5E13.6,5I3)
-C END IF
- IF (ZA1.EQ.0. .OR. KH2O.EQ.0) IH2O=0
- IF (ZA2.EQ.0. .OR. KCO2.EQ.0) ICO2=0
- IF (ZA3.EQ.0. .OR. KO3 .EQ.0) IO3 =0
- IF (ZA4.EQ.0. .OR. KN2O.EQ.0) IN2O=0
- IF (ZA5.EQ.0. .OR. KCH4.EQ.0) ICH4=0
- IF (NCNT.EQ.0) ICNT=0
- ICO = 0
- IC11= 0
- IC12= 0
- ICFC= 0
-C
-c PRINT 9221,JWVN,WNU(1),WNU(2),IH2O,ICO2,IO3,IN2O,ICH4,ICNT
-c $ ,ICO,IC11,IC12,ICFC
-C IF (NIMP.EQ.0) THEN
-C PRINT 9221,JWVN,WNU(1),WNU(2),IH2O,ICO2,IO3,IN2O,ICH4,ICNT
-C $ ,ICO,IC11,IC12,ICFC
-C 9221 FORMAT(1X,'JWVN= ',I3,' WV= ',F8.2,' - ',F8.2,2X,10I3)
-C END IF
-C
-C
-C
-C
-C* 2.3 INTRODUCTION OF THE TEMPERATURE EFFECT
-C
- 230 CONTINUE
-C
- IF (IH2O.NE.0) THEN
- DO 232 JKSL=KGL,1,-1
- DO 231 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
-*MNH ZTX =ZTAVSL(JL,JKSL)-TREF
- ZTX =ZTAVSL(JL,JKSL)-XTREF
- ZTX2=ZTX*ZTX
-*MNH ZPHI=RODWAL(3,INH2O)*ZTX+RODWAL(4,INH2O)*ZTX2
- ZPHI=XRODWAL(3,INH2O)*ZTX+XRODWAL(4,INH2O)*ZTX2
-*MNH ZPSI=RODWAL(5,INH2O)*ZTX+RODWAL(6,INH2O)*ZTX2
- ZPSI=XRODWAL(5,INH2O)*ZTX+XRODWAL(6,INH2O)*ZTX2
-*MNH
- ZUA =PU(JL,1,JKSL)*EXP (ZPHI)
- ZUB =PU(JL,2,JKSL)*EXP (2.*ZPSI)
- ELSE
- ZUA =PU(JL,1,JKSL)
- ZUB =PU(JL,2,JKSL)
- END IF
- ZV(JL,1,JKSL)=ZV(JL,1,JKSL+1)+ZUA
- ZV(JL,2,JKSL)=ZV(JL,2,JKSL+1)+ZUB
- 231 CONTINUE
- 232 CONTINUE
- END IF
-C IF (NIMP.EQ.0) print *,' SPECTR after 232 '
-C
- IF (ICO2.NE.0) THEN
- DO 234 JKSL=KGL,1,-1
- DO 233 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
-*MNH ZTX =ZTAVSL(JL,JKSL)-TREF
- ZTX =ZTAVSL(JL,JKSL)-XTREF
- ZTX2=ZTX*ZTX
-*MNH ZPHI=RODWAL(3,INCO2)*ZTX+RODWAL(4,INCO2)*ZTX2
- ZPHI=XRODWAL(3,INCO2)*ZTX+XRODWAL(4,INCO2)*ZTX2
-*MNH ZPSI=RODWAL(5,INCO2)*ZTX+RODWAL(6,INCO2)*ZTX2
- ZPSI=XRODWAL(5,INCO2)*ZTX+XRODWAL(6,INCO2)*ZTX2
-*MNH
- ZUA =PU(JL,3,JKSL)*EXP (ZPHI)
- ZUB =PU(JL,4,JKSL)*EXP (2.*ZPSI)
- ELSE
- ZUA =PU(JL,3,JKSL)
- ZUB =PU(JL,4,JKSL)
- END IF
- ZV(JL,3,JKSL)=ZV(JL,3,JKSL+1)+ZUA
- ZV(JL,4,JKSL)=ZV(JL,4,JKSL+1)+ZUB
- 233 CONTINUE
- 234 CONTINUE
- END IF
-C
- IF (IO3 .NE.0) THEN
- DO 236 JKSL=KGL,1,-1
- DO 235 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
-*MNH ZTX =ZTAVSL(JL,JKSL)-TREF
- ZTX =ZTAVSL(JL,JKSL)-XTREF
- ZTX2=ZTX*ZTX
-*MNH ZPHI=RODWAL(3,INO3 )*ZTX+RODWAL(4,INO3 )*ZTX2
- ZPHI=XRODWAL(3,INO3 )*ZTX+XRODWAL(4,INO3 )*ZTX2
-*MNH ZPSI=RODWAL(5,INO3 )*ZTX+RODWAL(6,INO3 )*ZTX2
- ZPSI=XRODWAL(5,INO3 )*ZTX+XRODWAL(6,INO3 )*ZTX2
-*MNH
- ZUA =PU(JL,5,JKSL)*EXP (ZPHI)
- ZUB =PU(JL,6,JKSL)*EXP (2.*ZPSI)
- ELSE
- ZUA =PU(JL,5,JKSL)
- ZUB =PU(JL,6,JKSL)
- END IF
- ZV(JL,5,JKSL)=ZV(JL,5,JKSL+1)+ZUA
- ZV(JL,6,JKSL)=ZV(JL,6,JKSL+1)+ZUB
- 235 CONTINUE
- 236 CONTINUE
- END IF
-C
- IF (ICNT.NE.0) THEN
- DO 238 JKSL=KGL,1,-1
- DO 237 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
- ZFACTC= 6.08*(296./ZTAVSL(JL,JKSL)-1.)
- ZUA =PU(JL,7,JKSL)*EXP (ZFACTC)
- ZUB =PU(JL,8,JKSL)
- ELSE
- ZUA =PU(JL,7,JKSL)
- ZUB =PU(JL,8,JKSL)
- END IF
- ZV(JL,11,JKSL)=ZV(JL,11,JKSL+1)+ZUA
- ZV(JL,12,JKSL)=ZV(JL,12,JKSL+1)+ZUB
- 237 CONTINUE
- 238 CONTINUE
- END IF
-C
- IF (IN2O.NE.0) THEN
- DO 242 JKSL=KGL,1,-1
- DO 241 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
-*MNH ZTX =ZTAVSL(JL,JKSL)-TREF
- ZTX =ZTAVSL(JL,JKSL)-XTREF
- ZTX2=ZTX*ZTX
-*MNH ZPHI=RODWAL(3,INN2O)*ZTX+RODWAL(4,INN2O)*ZTX2
- ZPHI=XRODWAL(3,INN2O)*ZTX+XRODWAL(4,INN2O)*ZTX2
-*MNH ZPSI=RODWAL(5,INN2O)*ZTX+RODWAL(6,INN2O)*ZTX2
- ZPSI=XRODWAL(5,INN2O)*ZTX+XRODWAL(6,INN2O)*ZTX2
-*MNH
- ZUA =PU(JL,3,JKSL)*EXP (ZPHI) *PCMN2O/PCMCO2
- ZUB =PU(JL,4,JKSL)*EXP (2.*ZPSI)*PCMN2O/PCMCO2
- ELSE
- ZUA =PU(JL,3,JKSL)*PCMN2O/PCMCO2
- ZUB =PU(JL,4,JKSL)*PCMN2O/PCMCO2
- END IF
- ZV(JL,7,JKSL)=ZV(JL,7,JKSL+1)+ZUA
- ZV(JL,8,JKSL)=ZV(JL,8,JKSL+1)+ZUB
- 241 CONTINUE
- 242 CONTINUE
- END IF
-C
- IF (ICH4.NE.0) THEN
- DO 244 JKSL=KGL,1,-1
- DO 243 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
-*MNH ZTX =ZTAVSL(JL,JKSL)-TREF
- ZTX =ZTAVSL(JL,JKSL)-XTREF
- ZTX2=ZTX*ZTX
-*MNH ZPHI=RODWAL(3,INCH4)*ZTX+RODWAL(4,INCH4)*ZTX2
- ZPHI=XRODWAL(3,INCH4)*ZTX+XRODWAL(4,INCH4)*ZTX2
-*MNH ZPSI=RODWAL(5,INCH4)*ZTX+RODWAL(6,INCH4)*ZTX2
- ZPSI=XRODWAL(5,INCH4)*ZTX+XRODWAL(6,INCH4)*ZTX2
-*MNH
- ZUA =PU(JL,3,JKSL)*EXP (ZPHI) *PCMCH4/PCMCO2
- ZUB =PU(JL,4,JKSL)*EXP (2.*ZPSI)*PCMCH4/PCMCO2
- ELSE
- ZUA =PU(JL,3,JKSL)*PCMCH4/PCMCO2
- ZUB =PU(JL,4,JKSL)*PCMCH4/PCMCO2
- END IF
- ZV(JL, 9,JKSL)=ZV(JL, 9,JKSL+1)+ZUA
- ZV(JL,10,JKSL)=ZV(JL,10,JKSL+1)+ZUB
- 243 CONTINUE
- 244 CONTINUE
- END IF
-C
-C IF (NIMP.LE.2) THEN
-C WRITE (NULOUT,9244) KCABS,KH2O,KCO2,KO3,KCNT,KN2O,KCH4,KCO
-C * ,KC11,KC12,KCFC
-C * ,JWVN,IH2O,ICO2,IO3,ICNT,IN2O,ICH4,ICO,IC11,IC12,ICFC
-C WRITE (NULOUT,9245) KIDIA,(ZV(KIDIA,JABS,1),JABS=1,KUABS)
-C WRITE (NULOUT,9245) KFDIA,(ZV(KFDIA,JABS,1),JABS=1,KUABS)
-C END IF
-C
-C
-C
-C* 2.5 COMPUTES PLANCK FUNCTIONS
-C
- 250 CONTINUE
-C
- INDPLK=1
- DO 253 JK=1,KLEV
- DO 251 JL=KIDIA,KFDIA
- ZTI(JL)=PT(JL,JK)
- ZTI2(JL)=PTAVE(JL,JK)
- 251 CONTINUE
-C
- CALL POLPLK (KIDIA,KFDIA,KLON,INDPLK,ZTI ,ZRES )
- CALL POLPLK (KIDIA,KFDIA,KLON,INDPLK,ZTI2,ZRES2)
-C
- DO 252 JL=KIDIA,KFDIA
- ZBLEV(JL,JK)=ZRES(JL)
- ZBLAY(JL,JK)=ZRES2(JL)
- ZBINT(JL,JK)=ZBINT(JL,JK)+ZRES(JL)
- 252 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9252,0,PT(JL,JK),PTAVE(JL,JK)
-C $ ,ZBLAY(JL,JK),ZBLEV(JL,JK),ZBINT(JL,JK)
-C 9252 FORMAT(1X,I3,2F8.3,3F14.7)
-C END IF
- 253 CONTINUE
-C
- DO 254 JL=KIDIA,KFDIA
- ZTI2(JL)=PT(JL,1)+PDT0(JL)
- ZTI (JL)=PT(JL,KLEV+1)
- 254 CONTINUE
-C
- CALL POLPLK (KIDIA,KFDIA,KLON,INDPLK,ZTI2,ZBSUR)
- CALL POLPLK (KIDIA,KFDIA,KLON,INDPLK,ZTI ,ZRES )
-C
- DO 255 JL=KIDIA,KFDIA
- ZBLEV(JL,KLEV+1)=ZRES(JL)
- ZBINT(JL,KLEV+1)=ZBINT(JL,KLEV+1)+ZRES(JL)
-C ZBSUI(JL)=ZBSUI(JL)+ZBSUR(JL)
- 255 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9255, JWVN,ZTI(JL),ZTI2(JL)
-C $ ,ZBSUR(JL),ZBSUI(JL),ZBLEV(JL,KLEV+1),ZBINT(JL,KLEV+1)
-C 9255 FORMAT(1X,I3,2F8.3,4F14.7)
-C END IF
-C
- DO 257 JK = 1 , KLEV
- JK2 = 2 * JK
- JK1 = JK2 - 1
- DO 256 JL = KIDIA,KFDIA
- ZDBSL(JL,JK1) = ZBLAY(JL,JK ) - ZBLEV(JL,JK)
- ZDBSL(JL,JK2) = ZBLEV(JL,JK+1) - ZBLAY(JL,JK)
- ZCDBSL(JL,JK1)= ZCDBSL(JL,JK1) + ZDBSL(JL,JK1)
- ZCDBSL(JL,JK2)= ZCDBSL(JL,JK2) + ZDBSL(JL,JK2)
- 256 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9256,JK,PTAVE(JL,JK),ZDBSL(JL,JK1),ZDBSL(JL,JK2)
-C $ ,ZCDBSL(JL,JK1),ZCDBSL(JL,JK2)
-C 9256 FORMAT(1X,I3,F8.3,4F14.7)
-C END IF
- 257 CONTINUE
- 259 CONTINUE
-C IF (NIMP.EQ.0) print *,' SPECTR after 259 '
-C
-C
-C
-C* 2.6 CALL VERTICAL INTEGRATION
-C
- 260 CONTINUE
-C
- CALL VERTI
- I ( KIDIA,KFDIA,KLON,KLEV,KGL,KCABS,KNG1,KUABS,KCONF
- I , KH2O,KCO2,KO3,KCNT,KN2O,KCH4,KCO,KC11,KC12,KCFC
- I , IBOT,ITOP,IVDIS
- L , LPVOIGT
- R , PANGLE,ZBLEV,ZBSUR,ZCNTRB,ZDZ,PEM0
- R , ZV,ZDBSL,ZWVN
- R , ZFDC,ZFUC )
-C
- DO 263 JK1=1,KLEV+1
- DO 262 JK2=1,KLEV+1
- DO 261 JL=KIDIA,KFDIA
- PCNTRB(JL,JK1,JK2)=PCNTRB(JL,JK1,JK2)+ZCNTRB(JL,JK1,JK2)
- 261 CONTINUE
-
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C PRINT 9261,JK1,JK2,ZCNTRB(JL,JK1,JK2),PCNTRB(JL,JK1,JK2)
-C 9261 FORMAT(1X,2I4,2E15.8)
-C END IF
- 262 CONTINUE
- 263 CONTINUE
-C
- DO 265 JK=1,KLEV+1
- DO 264 JL=KIDIA,KFDIA
- ZFUT(JL,JK)=0.
- ZFDT(JL,JK)=0.
- ZFUT(JL,JK)=ZFUC(JL,JK)
- ZFDT(JL,JK)=ZFDC(JL,JK)
- 264 CONTINUE
- 265 CONTINUE
-C IF (NIMP.EQ.0) print *,' SPECTR after 265 '
-C
-C
-C ------------------------------------------------------------------
-C
-C* 3. INTRODUCE CLOUD EFFECTS (ON A SPECTRAL BASIS)
-C
- 300 CONTINUE
-C
- IF (KCONF.EQ.0 .OR. KCONF.EQ.1) THEN
-C
-
- CALL CLOUD
- I ( KIDIA , KFDIA, KLON , KLEV
- I , KCLOUD, KOVLP
- R , ZBSUR , ZCLDLD, ZCLDLU, ZCNTRB, ZFUC, ZFDC, ZBLEV, PEM0
- R , ZFUT , ZFDT
- S )
-C
-C
-C
- END IF
-C
-C
-C
-C
-C ------------------------------------------------------------------
-C
-C* 4. FILLING-UP BROAD-BAND FLUXES ARRAYS
-C
- 400 CONTINUE
-C
- ILEV=0
- IF (KCONF.EQ.0) THEN
- IVSTP=1
- ELSE
- IVSTP=KLEV
- END IF
- DO JL=KIDIA,KFDIA
- PRADC(JL,JWVN)=ZFUC(JL,KLEV+1)
- PRADT(JL,JWVN)=ZFUT(JL,KLEV+1)
- END DO
-C
-C
-C
-C
-C
-C
-C
-C
-C 4.9 END OF SPECTRAL LOOP
-C
-C***
- 499 CONTINUE
-
- 9101 FORMAT (1X,'*VERTI* IMPROPER CONFIGURATION:',I2)
- 9201 FORMAT (1X,'*SPECTR* NULL ABSORBER AMOUNTS IUX= ',I2,' IUY= ',I2)
- 9244 FORMAT (1X,'REQUIRED:',11I3,' JWVN= ',I3,' ACTIVE:',10I3)
- 9245 FORMAT (1X,I3,14E9.3)
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE POLPLK
- I ( KIDIA,KFDIA,KLON,KINDT
- R , PT
- R , PRES
- S )
-C
-C**** *POLPLK* - COMPUTES PLANCK FUNCTIONS FROM POLYNOMIAL EXPANSION
-C
-C** INTERFACE
-C ---------
-C *POLPLK* IS CALLED BY *SPECTR*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C KIDIA : START OF VECTOR
-C KFDIA : END OF VECTOR
-C KLON : TOTAL LENGTH OF VECTOR
-C KINDT : 1. PLANCK FUNCTION 2. DERIVATIVE W.R.T. TEMPERATURE
-C PT : TEMPERATURE
-C === OUTPUTS ===
-C PRES : B(T) OR DB(T)/DT
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
- REAL PT(KLON),PRES(KLON)
-C
-C ------------------------------------------------------------------
-C
-C 0.2 LOCAL ARRAYS
-C
- REAL ZT(KLON)
-C
-C ------------------------------------------------------------------
-C
-C 1.
-C
- 100 CONTINUE
-C
- DO 101 JL=KIDIA,KFDIA
-*MNH ZT(JL)=(PT(JL)-TPOLY)/TPOLY
- ZT(JL)=(PT(JL)-XTPOLY)/XTPOLY
-*MNH PRES(JL)=POLPLCK(6,KINDT)
- PRES(JL)=XPOLPLCK(6,KINDT)
-*MNH
- 101 CONTINUE
-C
- DO 103 JPOL=5,1,-1
- DO 102 JL=KIDIA,KFDIA
-*MNH PRES(JL)=PRES(JL)*ZT(JL)+POLPLCK(JPOL,KINDT)
- PRES(JL)=PRES(JL)*ZT(JL)+XPOLPLCK(JPOL,KINDT)
-*MNH
- 102 CONTINUE
- 103 CONTINUE
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE VERTI
- I ( KIDIA, KFDIA, KLON , KLEV, KGL , KCABS, KNG1, KUABS, KCONF
- I , KH2O , KCO2 , KO3 , KCNT, KN2O, KCH4
- I , KCO , KC11 , KC12 , KCFC
- I , KBOT , KTOP , KVDIS
- L , LPVOIGT
- R , PANGLE,PB ,PBSUR,PCNTRB, PDZ, PEM0 , PV , PDBSL, PWVN
- R , PFDC ,PFUC
- S )
-C
-C**** *VERTI* - PERFORMS THE VERTICAL INTEGRATION
-C
-C** INTERFACE
-C ---------
-C *VERTI* IS CALLED BY *SPECTR*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C I KIDIA : START OF VECTOR
-C I KFDIA : END OF VECTOR
-C I KLON : TOTAL LENGTH OF VECTOR
-C I KLEV : NUMBER OF FULL-LEVELS (LAYERS)
-C I KGL : NUMBER OF SUB-LAYERS IN VERTICAL INTEGRATION
-C I KCABS : CONFIGURATION INDEX FOR ABSORBERS
-C L LPVOIGT : .T. IF VOIGT PROFILE IS ACCOUNTED FOR
-C R PANGLE : 1./COS(VIEWING ANGLE) OR DIFFUSIVITY FACTOR
-C R PB : PLANCK FUNCTION ON HALF-LEVELS
-C R PBSUR : SURFACE PLANCK FUNCTION
-C R PCNTRB : ENERGY EXCHANGE MATRIX
-C R PDZ : LAYER THICKNESS
-C
-C === OUTPUTS ===
-C PFDC : DOWNWARD CLEAR-SKY FLUXES
-C PFUC : UPWARD CLEAR-SKY FLUXES
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 92/12/04
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- LOGICAL LPVOIGT
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
- REAL
- * PANGLE(KLON)
- * , PB(KLON,KLEV+1) , PBSUR(KLON)
- * , PCNTRB(KLON,KLEV+1,KLEV+1)
- * , PDT0(KLON) , PDZ(KLON,KLEV)
-*MNH * , PEM0(KLON) , PV(KLON,JUABS,KGL+1)
- * , PEM0(KLON) , PV(KLON,JPUABS,KGL+1)
-CBUG * , PDBSL(KLON,2*KLEV+1) , PXT(KLON,3,3*KLEV+1)
- * , PDBSL(KLON,2*KLEV) , PXT(KLON,3,3*KLEV+1)
-C
- REAL
- * PFDC(KLON,KLEV+1) , PFUC(KLON,KLEV+1)
-C
-C ------------------------------------------------------------------
-C
-C 0.2 LOCAL ARRAYS
-C
- INTEGER
- * INDCL(KLON,KLEV+1)
-C
- REAL
- * ZDISD(KLON),ZDISU(KLON)
- * , ZCNSU(KLON),ZCNTP(KLON)
- * , ZDR(KLON),ZSR(KLON),ZDG(KLON)
- * , ZUG(KLON),ZBGND(KLON)
- * , ZTR(KLON),ZUR(KLON),ZFU(KLON)
- * , ZFD(KLON),ZFD1(KLON)
- REAL
- *ZDAU0(KLON),ZDAU1(KLON),ZDAU2(KLON), ZDAU3(KLON),ZDAU4(KLON)
- *,ZDAU5(KLON),ZDAU6(KLON),ZDAU7(KLON),ZDAU8(KLON),ZDAU9(KLON)
- *,ZSAU0(KLON),ZSAU1(KLON),ZSAU2(KLON),ZSAU3(KLON),ZSAU4(KLON)
- *,ZSAU5(KLON),ZSAU6(KLON),ZSAU7(KLON),ZSAU8(KLON),ZSAU9(KLON)
- *,ZTAU0(KLON),ZTAU1(KLON),ZTAU2(KLON),ZTAU3(KLON),ZTAU4(KLON)
- *,ZTAU5(KLON),ZTAU6(KLON),ZTAU7(KLON),ZTAU8(KLON),ZTAU9(KLON)
- *,ZUAU0(KLON),ZUAU1(KLON),ZUAU2(KLON),ZUAU3(KLON),ZUAU4(KLON)
- *,ZUAU5(KLON),ZUAU6(KLON),ZUAU7(KLON),ZUAU8(KLON),ZUAU9(KLON)
-C ------------------------------------------------------------------
-C
-C* 1. INITIALIZATION
-C
- 100 CONTINUE
-C
-c PRINT *,' Verti '
-C IF (NIMP.EQ.0) STOP
-
-C
- DO 103 JK1=1,KLEV+1
- DO 102 JK2=1,KLEV+1
- DO 101 JL=KIDIA,KFDIA
- PCNTRB(JL,JK1,JK2)=0.
- 101 CONTINUE
- 102 CONTINUE
- 103 CONTINUE
-C IF (NIMP.EQ.0) print *,' VERTI after 103 '
-
-C
-C
-C
-C ------------------------------------------------------------------
-C
-C* 2. VERTICAL INTEGRATION USING GAUSS QUADRATURE
-C
- 200 CONTINUE
-C
-C IF (NIMP.EQ.0) print *,' Vertical integration '
- DO 249 JK=KBOT,KTOP,KVDIS
- ISL=(JK-1)*(KNG1+1)+1
- IL12 = 2 * (JK - 1)
-C
- DO 201 JL=KIDIA,KFDIA
- ZDISD(JL)=0.
- ZDISU(JL)=0.
- ZDR (JL)=1.
- ZSR (JL)=1.
- ZTR (JL)=1.
- ZUR (JL)=1.
- PFUC(JL,JK)=0.
- PFDC(JL,JK)=0.
- 201 CONTINUE
-C
-C
-C* 2.1 DOWNWARD FLUXES
-C
- 210 CONTINUE
-C
- IF (JK.NE.KLEV+1) THEN
-C
- DO 218 JK1=JK,KLEV
- ISLX=(JK1-1)*(KNG1+1)+1
- ID12 = 2 * (JK1 - 1)
-
- DO 211 JL=KIDIA,KFDIA
- ZDG(JL)=0.
- 211 CONTINUE
- DO 214 JG=1,KNG1
- ISLXG=ISLX+JG
- IDS = ID12 + JG
-
- DO 212 JL=KIDIA,KFDIA
- ZDAU0(JL)=0.
- ZDAU1(JL)=0.
- ZDAU2(JL)=0.
- ZDAU3(JL)=0.
- ZDAU4(JL)=0.
- ZDAU5(JL)=0.
- ZDAU6(JL)=0.
- ZDAU7(JL)=0.
- ZDAU8(JL)=0.
- ZDAU9(JL)=0.
- 212 CONTINUE
-C
-C IF (NIMP.EQ.0) print 9212,JK,ISL,JK1,JG,ISLXG
-C 9212 FORMAT(1X,' Downward JK,ISL,JK1,JG,ISLXG ',5I4)
- IF (KCNT.EQ.1) THEN
- CALL CNTINU (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, KCABS
- R , PANGLE,PV,PWVN
- R , ZDAU0 )
- END IF
- IF (KH2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 1 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU1 )
- END IF
- IF (KCO2.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 2 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU2 )
- END IF
- IF (KO3 .EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 3 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU3 )
- END IF
- IF (KN2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 4 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU4 )
- END IF
- IF (KCH4.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 5 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU5 )
- END IF
- IF (KC11.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 6 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU6 )
- END IF
- IF (KC12.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 7 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU7 )
- END IF
- IF (KCFC.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 8 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU8 )
- END IF
-C
- DO 213 JL=KIDIA,KFDIA
- ZDR(JL)=EXP (-ZDAU0(JL)-ZDAU1(JL)-ZDAU2(JL)-ZDAU3(JL)
- * -ZDAU4(JL)-ZDAU5(JL)-ZDAU6(JL)-ZDAU7(JL)-ZDAU8(JL))
-*MNH ZDG(JL)=ZDG(JL)+PDBSL(JL,IDS)*ZDR(JL)*WG1(JG)
- ZDG(JL)=ZDG(JL)+PDBSL(JL,IDS)*ZDR(JL)*XWG1(JG)
-*MNH
- 213 CONTINUE
-
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9213,JK,JK1,JG,IDS,ZDR(JL),PDBSL(JL,IDS),ZDG(JL)
-C 9213 format(1x,'Dn',4I4,F8.5,2F14.7)
-C END IF
- 214 CONTINUE
-C
- IK1P1=JK1+1
-C
- DO 215 JL=KIDIA,KFDIA
- PCNTRB(JL,JK,IK1P1)=ZDG(JL)
- ZDISD(JL)=ZDISD(JL)+ZDG(JL)
- 215 CONTINUE
-C
- 218 CONTINUE
- END IF
-C
-C
-C
-C
-C* 2.2 UPWARD FLUXES
-C
- 220 CONTINUE
-C
- IF (JK.NE.1) THEN
-C
- DO 228 JK1= JK-1,1,-1
- ISLX=(JK1-1)*(KNG1+1)+1
- IU12 = 2 * (JK1 - 1)
-
- DO 221 JL=KIDIA,KFDIA
- ZUG(JL)=0.
- 221 CONTINUE
- DO 224 JG=1,KNG1
- ISLXG=ISLX+JG
- IUS = IU12 + JG
-
- DO 222 JL=KIDIA,KFDIA
- ZUAU0(JL)=0.
- ZUAU1(JL)=0.
- ZUAU2(JL)=0.
- ZUAU3(JL)=0.
- ZUAU4(JL)=0.
- ZUAU5(JL)=0.
- ZUAU6(JL)=0.
- ZUAU7(JL)=0.
- ZUAU8(JL)=0.
- ZUAU9(JL)=0.
- 222 CONTINUE
-C
-C IF (NIMP.EQ.0) print 9222,JK,ISL,JK1,JG,ISLXG
- 9222 FORMAT(1X,' Upward JK,ISL,JK1,JG,ISLXG ',5I4)
- IF (KCNT.EQ.1) THEN
- CALL CNTINU (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, KCABS
- R , PANGLE,PV,PWVN
- R , ZUAU0 )
- END IF
- IF (KH2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 1 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU1 )
- END IF
- IF (KCO2.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 2 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU2 )
- END IF
- IF (KO3 .EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 3 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU3 )
- END IF
- IF (KN2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 4 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU4 )
- END IF
- IF (KCH4.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 5 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU5 )
- END IF
- IF (KC11.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 6 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU6 )
- END IF
- IF (KC12.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 7 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU7 )
- END IF
- IF (KCFC.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 8 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU8 )
- END IF
-C
- DO 223 JL=KIDIA,KFDIA
- ZUR(JL)=EXP (-ZUAU0(JL)-ZUAU1(JL)-ZUAU2(JL)-ZUAU3(JL)
- * -ZUAU4(JL)-ZUAU5(JL)-ZUAU6(JL)-ZUAU7(JL)-ZUAU8(JL))
-*MNH ZUG(JL)=ZUG(JL)+PDBSL(JL,IUS)*ZUR(JL)*WG1(JG)
- ZUG(JL)=ZUG(JL)+PDBSL(JL,IUS)*ZUR(JL)*XWG1(JG)
-*MNH
- 223 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9223,JK,JK1,JG,IUS,ZUR(JL),PDBSL(JL,IDS),ZUG(JL)
-C 9223 format(1x,'Up',4I4,F8.5,2F14.7)
-C END IF
- 224 CONTINUE
-C
- DO 225 JL=KIDIA,KFDIA
- PCNTRB(JL,JK,JK1 )=ZUG(JL)
- ZDISU(JL)=ZDISU(JL)+ZUG(JL)
- 225 CONTINUE
-C
- 228 CONTINUE
- END IF
-C
-C
-C
-C
-C
-C
-C* 2.3 EXCHANGE WITH THE TOP OF THE ATMOSPHERE
-C
- 230 CONTINUE
-C
- IF (JK.NE.KLEV+1) THEN
-C
- DO 231 JL=KIDIA,KFDIA
- ZTAU0(JL)=0.
- ZTAU1(JL)=0.
- ZTAU2(JL)=0.
- ZTAU3(JL)=0.
- ZTAU4(JL)=0.
- ZTAU5(JL)=0.
- ZTAU6(JL)=0.
- ZTAU7(JL)=0.
- ZTAU8(JL)=0.
- ZTAU9(JL)=0.
- 231 CONTINUE
-C
-C IF (NIMP.EQ.0) print 9231,JK,ISL,KGL+1
- 9231 FORMAT(1X,' Top JK,ISL,KGL+1 ',5I4)
- IF (KCNT.EQ.1) THEN
- CALL CNTINU (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, KCABS
- R , PANGLE,PV,PWVN
- R , ZTAU0 )
- END IF
- IF (KH2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 1 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU1 )
- END IF
- IF (KCO2.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 2 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU2 )
- END IF
- IF (KO3 .EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 3 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU3 )
- END IF
- IF (KN2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 4 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU4 )
- END IF
- IF (KCH4.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 5 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU5 )
- END IF
- IF (KC11.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 6 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU6 )
- END IF
- IF (KC12.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 7 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU7 )
- END IF
- IF (KCFC.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 8 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU8 )
- END IF
-C
- DO 232 JL=KIDIA,KFDIA
- ZTR(JL)=EXP (-ZTAU0(JL)-ZTAU1(JL)-ZTAU2(JL)-ZTAU3(JL)
- * -ZTAU4(JL)-ZTAU5(JL)-ZTAU6(JL)-ZTAU7(JL)-ZTAU8(JL))
- 232 CONTINUE
- END IF
-C
- DO 233 JL=KIDIA,KFDIA
- ZCNTP(JL)=ZTR(JL)*PB(JL,KLEV+1)
- ZFD(JL)=ZCNTP(JL)-PB(JL,JK)-ZDISD(JL)
- PFDC(JL,JK)=ZFD(JL)
- 233 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9233,JK,ZTR(JL),PB(JL,KLEV+1),ZCNTP(JL),PB(JL,JK),ZDISD(JL)
-C $ ,ZFD(JL)
-C 9233 format(1x,'Xchg Top',I4,F8.5,5F14.7)
-C END IF
-C
- IF (JK.EQ.1) THEN
- DO 234 JL=KIDIA,KFDIA
- ZFD1(JL)=-ZFD(JL)
- 234 CONTINUE
- END IF
-C
-C
-C
-C
-C
-C* 2.4 EXCHANGE WITH THE SURFACE
-C
- 240 CONTINUE
-C
- DO 241 JL=KIDIA,KFDIA
- ZBGND(JL)=PBSUR(JL)*PEM0(JL)+(1.-PEM0(JL))*ZFD1(JL)-PB(JL,1)
-C ZSR(JL)=1.
- 241 CONTINUE
-C IF (NIMP.EQ.0. AND. JK.EQ.1) THEN
-C JL=KIDIA
-C print 9241,PBSUR(JL),PEM0(JL),ZFD1(JL),PB(JL,1),ZBGND(JL)
-C 9241 FORMAT(1X,'Surf ',F12.5,F8.5,3F12.5)
-C END IF
-C
- IF (JK.NE.1) THEN
-C
- DO 242 JL=KIDIA,KFDIA
- ZSAU0(JL)=0.
- ZSAU1(JL)=0.
- ZSAU2(JL)=0.
- ZSAU3(JL)=0.
- ZSAU4(JL)=0.
- ZSAU5(JL)=0.
- ZSAU6(JL)=0.
- ZSAU7(JL)=0.
- ZSAU8(JL)=0.
- ZSAU9(JL)=0.
- 242 CONTINUE
-C
-C IF (NIMP.EQ.0) print 9242,JK,1,ISL
- 9242 FORMAT(1X,' Surface JK,1,ISL ',5I4)
- IF (KCNT.EQ.1) THEN
- CALL CNTINU (KIDIA,KFDIA,KLON, KLEV, 1, ISL, KCABS
- R , PANGLE,PV,PWVN
- R , ZSAU0 )
- END IF
- IF (KH2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 1 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU1 )
- END IF
- IF (KCO2.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 2 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU2 )
- END IF
- IF (KO3 .EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 3 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU3 )
- END IF
- IF (KN2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 4 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU4 )
- END IF
- IF (KCH4.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 5 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU5 )
- END IF
- IF (KC11.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 6 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU6 )
- END IF
- IF (KC12.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 7 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU7 )
- END IF
- IF (KCFC.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 8 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU8 )
- END IF
-C
- DO 243 JL=KIDIA,KFDIA
- ZSR(JL)=EXP (-ZSAU0(JL)-ZSAU1(JL)-ZSAU2(JL)-ZSAU3(JL)
- * -ZSAU4(JL)-ZSAU5(JL)-ZSAU6(JL)-ZSAU7(JL)-ZSAU8(JL))
- 243 CONTINUE
- END IF
-C
- DO 244 JL=KIDIA,KFDIA
- ZCNSU(JL)=ZSR(JL)*ZBGND(JL)
- ZFU(JL)=ZCNSU(JL)+PB(JL,JK)-ZDISU(JL)
- PFUC(JL,JK)=ZFU(JL)
- 244 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9244,JK,ZSR(JL),ZBGND(JL),ZCNSU(JL),PB(JL,JK),ZDISU(JL)
-C $ ,ZFU(JL)
-C 9244 format(1x,'Xchg Sur',I4,F8.5,5F14.7)
-C END IF
-C
- 249 CONTINUE
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE CNTINU (KIDIA,KFDIA,KLON, KLEV, KINF,KSUP, KCABS
- R , PANGLE,PV,PWVN
- R , PTAU )
-C
-C**** *CNTINU* - TRANSMISSION BY WATER VAPOR CONTINUUM
-C
-C** INTERFACE
-C ---------
-C *CNTINU* IS CALLED BY *VERTI*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C KIDIA : START OF VECTOR
-C KFDIA : END OF VECTOR
-C KLON : TOTAL LENGTH OF VECTOR
-C KCABS : CONFIGURATION INDEX FOR ABSORBERS
-C KINF : LOWER LEVEL OF LAYER CONSIDERED
-C KSUP : UPPER LEVEL OF LAYER CONSIDERED
-C PANGLE : 1./COS(VIEWING ANGLE) OR DIFFUSITY FACTOR
-C PWVN : WAVENUMBER
-C PV : REDUCED ABSORBER AMOUNTS CUMULATED FROM MODEL TOP
-C === OUTPUTS ===
-C PTAU : OPTICAL THICKNESS DUE TO WATER VAPOR CONTINUUM
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomrad.h'
-*MNH integer NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH real CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,FTEMP(JV3),
-*MNH & FCH2O(JV3),FCCO2(JV3),FCO3(JV3),XLIM(JV10),CLIM(JV2)
-*MNH COMMON/YOMRADI/NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH COMMON /YOMRADR/CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,
-*MNH & FTEMP,FCH2O,FCCO2,FCO3,XLIM,CLIM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
-*MNH REAL PANGLE(KLON),PV(KLON,JUABS,3*KLEV+1)
- REAL PANGLE(KLON),PV(KLON,JPUABS,3*KLEV+1)
-C
- REAL PTAU(KLON)
-C
-C ------------------------------------------------------------------
-C
-C 0.2 LOCAL ARRAYS
-C
- REAL ZE(KLON),ZP(KLON),ZTAUE(KLON),ZTAUP(KLON)
- REAL ZCOEF
-C
-C ------------------------------------------------------------------
-C
-C 1.
-C
- DO JL=KIDIA,KFDIA
- PTAU(JL)=0.
- END DO
-C
-*MNH IF (PWVN.GT.CLIM(1) .AND. PWVN.LT.CLIM(2)) THEN
- IF (PWVN.GT.XCLIM(1) .AND. PWVN.LT.XCLIM(2)) THEN
-C
- ZCOEF=4.18 + 5578.*EXP(-7.87e-03*PWVN)
- DO JL=KIDIA,KFDIA
- ZE(JL)=PV(JL,11,KINF)-PV(JL,11,KSUP)
- ZP(JL)=PV(JL,12,KINF)-PV(JL,12,KSUP)
- ZTAUE(JL)=PANGLE(JL)*ZCOEF*ZE(JL)
- ZTAUP(JL)=PANGLE(JL)*ZCOEF*ZP(JL)*0.002
- END DO
-C
- IF (KCABS.EQ.20) THEN
- DO JL=KIDIA,KFDIA
- ZTAUE(JL)=0.
- END DO
- END IF
- IF (KCABS.EQ.21) THEN
- DO JL=KIDIA,KFDIA
- ZTAUP(JL)=0.
- END DO
- END IF
-C
- DO JL=KIDIA,KFDIA
- PTAU(JL)=ZTAUE(JL)+ZTAUP(JL)
- END DO
- END IF
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE TRANSM
- I ( KIDIA,KFDIA,KLON, KLEV, KINF,KSUP, KABS,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , PTAU
- S )
-C
-C**** *TRANSM* - COMPUTES TRANSMISSION FUNCTIONS
-C
-C** INTERFACE
-C ---------
-C *TRANSM* IS CALLED BY *VERTI*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C KIDIA : START OF VECTOR
-C KFDIA : END OF VECTOR
-C KLON : TOTAL LENGTH OF VECTOR
-C KINF : LOWER LEVEL OF LAYER CONSIDERED
-C KSUP : UPPER LEVEL OF LAYER CONSIDERED
-C KABS : INDEX OF CONSIDERED ABSORBER
-C KCABS : CONFIGURATION INDEX FOR ABSORBERS
-C LPVOIGT : .T. IF VOIGT PROFILE IS ACCOUNTED FOR
-C PANGLE : 1./COS(VIEWING ANGLE) OR DIFFUSITY FACTOR
-C PV : REDUCED ABSORBER AMOUNTS CUMULATED FROM MODEL TOP
-C PWVN : WAVENUMBER
-C === OUTPUTS ===
-C PTAU : OPTICAL THICKNESS DUE TO WATER VAPOR CONTINUUM
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
- USE MODD_CST
-*MNH
- !include 'implic.h'
- LOGICAL LPVOIGT
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
-*MNH !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
-C
-*MNH REAL PANGLE(KLON),PV(KLON,JUABS,3*KLEV+1)
- REAL PANGLE(KLON),PV(KLON,JPUABS,3*KLEV+1)
-C
- REAL PTAU(KLON)
-C
-C ------------------------------------------------------------------
-C
-C 0.2 LOCAL ARRAYS
-C
- REAL ZA(KLON),ZB(KLON),ZC(KLON)
- REAL ZD(KLON),ZF(KLON),ZG(KLON)
- REAL ZAB(KLON),ZSQ(KLON),ZX(KLON)
- REAL ZY(KLON)
-C
-C ------------------------------------------------------------------
-C
-C 1. INITIALIZATION
-C
- 100 CONTINUE
-C
- DO 101 JL=KIDIA,KFDIA
- PTAU(JL)=0.
-c print *,'TRANSM:',JL,PANGLE(JL)
- 101 CONTINUE
-C
-*MNH ZA1=RODWAL(1,KABS)
- ZA1=XRODWAL(1,KABS)
-*MNH ZA2=RODWAL(2,KABS)
- ZA2=XRODWAL(2,KABS)
-*MNH
-c print *,'TRANSM: ',ZA1,ZA2
-C
-C ------------------------------------------------------------------
-C
-C 2. SKIP COMPUTATION IF NO ABSORPTION OR NO ABSORBER
-C
- 200 CONTINUE
-C
- IF (ZA1.EQ.0.) RETURN
-C
- IUX=2*KABS-1
- IUY=IUX+1
-C
- DO 201 JL=KIDIA,KFDIA
- ZX(JL)=PANGLE(JL)*(PV(JL,IUX,KINF)-PV(JL,IUX,KSUP))
- ZY(JL)=PANGLE(JL)*(PV(JL,IUY,KINF)-PV(JL,IUY,KSUP))
-C IF (ZX(JL).EQ.0. .OR. ZY(JL).EQ.0.) THEN
-C PRINT 9201,IUX,IUY,KINF,KSUP
-C print *,'ZX=',ZX(JL),' ZY=',ZY(JL)
-C print *,PV(JL,IUX,KINF),PV(JL,IUX,KSUP)
-C print *,PV(JL,IUY,KINF),PV(JL,IUY,KSUP)
-C print *,'KABS ',kabs
-C print *,'PROFILE NUMBER:',JL,' PANGLE:',PANGLE(JL)
-C STOP
-C END IF
- 201 CONTINUE
-C
-C ------------------------------------------------------------------
-C
-C 3. COMPUTATION DEPEND ON ABSORBER AND LINE PROFILE
-C
- 300 CONTINUE
-C
- IF (KABS.GE.4) GO TO 400
- IF (LPVOIGT) GO TO 600
- GO TO 500
-C
-C ------------------------------------------------------------------
-C
-C 4. GOODY'S STATISTICAL MODEL FOR N2O, CH4, CO
-C
- 400 CONTINUE
-C
- DO 401 JL=KIDIA,KFDIA
- ZSQ(JL)=SQRT (1.+ZA1*ZX(JL)*ZX(JL)/(ZA2*ZY(JL)))
- PTAU(JL)=ZA1*ZX(JL)/ZSQ(JL)
- 401 CONTINUE
-C
- RETURN
-C
-C
-C ------------------------------------------------------------------
-C
-C 5. MALKMUS'S STATISTICAL MODEL FOR H2O, CO2, O3 - LORENTZ
-C
- 500 CONTINUE
-C
- DO 501 JL=KIDIA,KFDIA
- ZSQ(JL)=SQRT (1.+4.*ZA1*ZX(JL)*ZX(JL)/(ZA2*ZY(JL))) - 1.
- PTAU(JL)=ZA2*ZY(JL)*ZSQ(JL)/(2.*ZX(JL))
- 501 CONTINUE
-C
- RETURN
-C
-C
-C ------------------------------------------------------------------
-C
-C 6. MALKMUS'S STATISTICAL MODEL FOR H2O, CO2, O3 - VOIGT
-C
- 600 CONTINUE
-C
- IF (KABS-2.LT.0) GO TO 610
- IF (KABS-2.EQ.0) GO TO 620
- IF (KABS-2.GT.0) GO TO 630
-C
-C 6.1 WATER VAPOUR
-C
- 610 CONTINUE
- ZDELTA=2.00
-*MNH ZALPHA=RALPHA*SQRT(1./RH2OM)
- ZALPHA=XALPHA*SQRT(1./XH2OM)
-*MNH ZALPHA=RALPHA*SQRT(1./RH2OM)
- ZALPHA=XALPHA*SQRT(1./XH2OM)
- GO TO 650
-C
-C
-C 6.2 CARBON DIOXIDE
-C
- 620 CONTINUE
- ZDELTA=0.75
-*MNH ZALPHA=RALPHA*SQRT(1./RCO2M)
- ZALPHA=XALPHA*SQRT(1./XCO2M)
-*MNH
- GO TO 650
-C
-C
-C 6.3 OZONE
-C
- 630 CONTINUE
- ZDELTA=0.25
-*MNH ZALPHA=RALPHA*SQRT(1./RO3M)
- ZALPHA=XALPHA*SQRT(1./XO3M)
-*MNH GO TO 650
-C
-C 6.5 APPROXIMATE TREATMENT OF VOIGT LINE A LA FELS (1979)
-C
- 650 CONTINUE
-C
- ZALPHD=ZALPHA*PWVN
- DO 651 JL=KIDIA,KFDIA
- ZA(JL)=ZA1*ZX(JL)
-*MNH ZB(JL)=ZA2*ZY(JL)/(RPI*RPI*ZX(JL))
- ZB(JL)=ZA2*ZY(JL)/(XPI*XPI*ZX(JL))
-*MNH
- ZAB(JL)=ZA(JL)*ZB(JL)
- ZC(JL)=4.*ZB(JL) + 1.4*ZALPHD/ZDELTA
- ZD(JL)=0.5-ZB(JL)/ZC(JL)
- ZSQ(JL)=SQRT (ZAB(JL))
- ZF(JL)=ZSQ(JL) * ATAN( ZSQ(JL)/ZC(JL) )
- ZG(JL)=1. + ZA(JL)*ZD(JL)/ZC(JL)
- PTAU(JL)=4.*ZF(JL)
- * +2.*ZC(JL)*LOG(ZG(JL)/(1.+ZAB(JL)/(ZC(JL)*ZC(JL))))
- 651 CONTINUE
-C
-C ------------------------------------------------------------------
-C
- 9201 FORMAT (1X,'*TRANSM* NULL ABSORBER AMOUNTS IUX= ',I2,' IUY= ',I2
- *,' BETWEEN LEVELS',I3,' AND',I3)
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE CLOUD
- I ( KIDIA , KFDIA, KLON , KLEV
- I , KCLOUD, KOVLP
- R , PBSUR , PCLDLD,PCLDLU , PCNTRB, PFUC, PFDC, PBLEV, PEM0
- R , PFUT , PFDT
- S )
-C
-C**** *CLOUD* - INTRODUCES CLOUD EFFECT ON RADIATION FIELDS
-C
-C** INTERFACE
-C ---------
-C *CLOUD* IS CALLED BY *SPECTR*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C === OUTPUTS ===
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomrad.h'
-*MNH integer NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH real CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,FTEMP(JV3),
-*MNH & FCH2O(JV3),FCCO2(JV3),FCO3(JV3),XLIM(JV10),CLIM(JV2)
-*MNH COMMON/YOMRADI/NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH COMMON /YOMRADR/CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,
-*MNH & FTEMP,FCH2O,FCCO2,FCO3,XLIM,CLIM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
- REAL PBSUR(KLON) , PBLEV(KLON,KLEV+1)
- R , PCLDLD(KLON,KLEV) , PCNTRB(KLON,KLEV+1,KLEV+1)
- R , PEM0(KLON), PCLDLU(KLON,KLEV)
- R , PFDC(KLON,KLEV+1), PFUC(KLON,KLEV+1)
-C
- R , PFDT(KLON,KLEV+1), PFUT(KLON,KLEV+1)
-C
-C -------------------------------------------------------------------
-C
-C* 0.2 LOCAL ARRAYS
-C ------------
-C
- REAL ZCLEAR(KLON) , ZCLOUD(KLON)
- S , ZCLM(KLON,KLEV+1,KLEV+1)
- S , ZDNF(KLON,KLEV+1,KLEV+1)
- S , ZFD(KLON) , ZFU(KLON)
- S , ZUPF(KLON,KLEV+1,KLEV+1)
-C
-C ------------------------------------------------------------------
-C
-C* 1. INITIALIZE TO CLEAR-SKY FLUXES
-C ------------------------------
-C
- IMAXC=KLEV
- REPSEC=1.E-12
- REPSEC=1.e-7 ! JPChaboureau's modification to avoid division by zero
-C
- DO JK = 1 , KLEV+1
- DO JL = KIDIA,KFDIA
- PFDT(JL,JK) = PFDC(JL,JK)
- PFUT(JL,JK) = PFUC(JL,JK)
- END DO
- END DO
-C
- DO JK1=1,KLEV+1
- DO JK2=1,KLEV+1
- DO JL = KIDIA,KFDIA
- ZUPF(JL,JK2,JK1)=PFUC(JL,JK1)
- ZDNF(JL,JK2,JK1)=PFDC(JL,JK1)
- END DO
- END DO
- END DO
-C
-C ------------------------------------------------------------------
-C
-C* 2. FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
-C ----------------------------------------------
-C
- DO JKC = 1 , IMAXC
- JCLOUD=JKC
- JKCP1=JCLOUD+1
-C
-C* 2.1 ABOVE THE CLOUD
-C ---------------
-C
- DO JK=JKCP1,KLEV+1
- JKM1=JK-1
- DO JL = KIDIA,KFDIA
- ZFU(JL)=0.
- END DO
- IF (JK .GT. JKCP1) THEN
- DO JKJ=JKCP1,JKM1
- DO JL = KIDIA,KFDIA
- ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ)
- END DO
- END DO
- END IF
-C
- DO JL = KIDIA,KFDIA
- ZUPF(JL,JKCP1,JK)=PBLEV(JL,JK)-ZFU(JL)
- END DO
- END DO
-C
-C
-C* 2.2 BELOW THE CLOUD
-C ---------------
-C
- DO JK=1,JCLOUD
- JKP1=JK+1
- DO JL = KIDIA,KFDIA
- ZFD(JL)=0.
- END DO
-C
- IF (JK .LT. JCLOUD) THEN
- DO JKJ=JKP1,JCLOUD
- DO JL = KIDIA,KFDIA
- ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ)
- END DO
- END DO
- END IF
- DO JL = KIDIA,KFDIA
- ZDNF(JL,JKCP1,JK)=-PBLEV(JL,JK)-ZFD(JL)
- END DO
- END DO
- END DO
-C
-C ------------------------------------------------------------------
-C
-C* 3. CLOUD COVER MATRIX
-C ------------------
-C
-C* ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
-C HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1
-C
- DO JK1 = 1 , KLEV+1
- DO JK2 = 1 , KLEV+1
- DO JL = KIDIA,KFDIA
- ZCLM(JL,JK1,JK2) = 0.
- END DO
- END DO
- END DO
-C
-C
-C
-C* 3.1 CLOUD COVER BELOW THE LEVEL OF CALCULATION
-C ------------------------------------------
-C
- DO JK1 = 2 , KLEV+1
- DO JL = KIDIA,KFDIA
- ZCLEAR(JL)=1.
- ZCLOUD(JL)=0.
- END DO
- DO JK = JK1 - 1 , 1 , -1
- DO JL = KIDIA,KFDIA
- IF (KOVLP.EQ.1) THEN
-c* maximum-random
- ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLU(JL,JK),ZCLOUD(JL)))
- * /(1.0-MIN(ZCLOUD(JL),1.-REPSEC))
- ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
- ZCLOUD(JL) = PCLDLU(JL,JK)
- ELSE IF (KOVLP.EQ.2) THEN
-c* maximum
-c ZCLOUD(JL) = AMAX1(ZCLOUD(JL) , PCLDLU(JL,JK))
- ZCLOUD(JL)=MAX(ZCLOUD(JL),PCLDLU(JL,JK))
- ZCLM(JL,JK1,JK) = ZCLOUD(JL)
- ELSE IF (KOVLP.EQ.3) THEN
-c* random
- ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLU(JL,JK))
- ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
- ZCLM(JL,JK1,JK) = ZCLOUD(JL)
- END IF
- END DO
- END DO
- END DO
-C
-C
-C* 3.2 CLOUD COVER ABOVE THE LEVEL OF CALCULATION
-C ------------------------------------------
-C
- DO JK1 = 1 , KLEV
- DO JL = KIDIA,KFDIA
- ZCLEAR(JL)=1.
- ZCLOUD(JL)=0.
- END DO
- DO JK = JK1 , KLEV
- DO JL = KIDIA,KFDIA
- IF (KOVLP.EQ.1) THEN
-c* maximum-random
- ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLD(JL,JK),ZCLOUD(JL)))
- * /(1.0-MIN(ZCLOUD(JL),1.-REPSEC))
- ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
- ZCLOUD(JL) = PCLDLD(JL,JK)
- ELSE IF (KOVLP.EQ.2) THEN
-c* maximum
-c ZCLOUD(JL) = AMAX1(ZCLOUD(JL) , PCLDLD(JL,JK))
- ZCLOUD(JL)=MAX(ZCLOUD(JL) , PCLDLD(JL,JK))
- ZCLM(JL,JK1,JK) = ZCLOUD(JL)
- ELSE IF (KOVLP.EQ.3) THEN
-c* random
- ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLD(JL,JK))
- ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
- ZCLM(JL,JK1,JK) = ZCLOUD(JL)
- END IF
- END DO
- END DO
- END DO
-C
-C
-C ------------------------------------------------------------------
-C
-C* 4. FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
-C ----------------------------------------------
-C
-C* 4.1 DOWNWARD FLUXES
-C ---------------
-C
- DO JL = KIDIA,KFDIA
- PFDT(JL,KLEV+1) = 0.
- END DO
-C
- DO JK1 = KLEV , 1 , -1
-C
-C* CONTRIBUTION FROM CLEAR-SKY FRACTION
-C
- DO JL = KIDIA,KFDIA
- ZFD (JL) = (1. - ZCLM(JL,JK1,KLEV)) * ZDNF(JL,1,JK1)
- END DO
-C
-C* CONTRIBUTION FROM ADJACENT CLOUD
-C
- DO JL = KIDIA,KFDIA
- ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1)
- END DO
-C
-C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
-C
- DO JK = KLEV-1 , JK1 , -1
- DO JL = KIDIA,KFDIA
- ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK)
- ZFD(JL) = ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1)
- END DO
- END DO
-C
- DO JL = KIDIA,KFDIA
- PFDT(JL,JK1) = ZFD (JL)
- END DO
-C
- END DO
-C
-C
-C
-C
-C* 4.2 UPWARD FLUX AT THE SURFACE
-C --------------------------
-C
- DO JL = KIDIA,KFDIA
- PFUT(JL,1) = PEM0(JL)*PBSUR(JL)-(1.-PEM0(JL))*PFDT(JL,1)
- END DO
-C
-C
-C
-C
-C* 4.3 UPWARD FLUXES
-C -------------
-C
- DO JK1 = 2 , KLEV+1
-C
-C* CONTRIBUTION FROM CLEAR-SKY FRACTION
-C
- DO JL = KIDIA,KFDIA
- ZFU (JL) = (1. - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1)
- END DO
-C
-C* CONTRIBUTION FROM ADJACENT CLOUD
-C
- DO JL = KIDIA,KFDIA
- ZFU(JL) = ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1)
- END DO
-C
-C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
-C
- DO JK = 2 , JK1-1
- DO JL = KIDIA,KFDIA
- ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK)
- ZFU(JL) = ZFU(JL) + ZCFRAC * ZUPF(JL,JK ,JK1)
- END DO
- END DO
-C
- DO JL = KIDIA,KFDIA
- PFUT(JL,JK1) = ZFU (JL)
- END DO
-C
- END DO
-C
-C-----------------------------------------------------------------------
-C
- RETURN
- END
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 8c14197c8833ca6847683e6ba2f5a78982f2dd96..edd731e427f3ff0b3b502f8ef82bfb74052ade40 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2024 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.
@@ -36,7 +36,7 @@ END MODULE MODI_PHYS_PARAM_n
!
! ########################################################################################
SUBROUTINE PHYS_PARAM_n( KTCOUNT, TPFILE, &
- PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PEOL, PDRAG, PTURB, &
+ PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PDRAG, PEOL, PTURB, &
PTRACER, PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
! ########################################################################################
!
@@ -242,6 +242,7 @@ END MODULE MODI_PHYS_PARAM_n
! A. Costes 12/2021: add Blaze fire model
! Q. Rodier 2022 : integration with PHYEX
! C. Barthe 03/2023: add CELEC in call to turbulence
+! V. Masson 01/2024: aggregation of columns for radiation
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -326,6 +327,7 @@ USE MODD_TIME_n
USE MODD_TIME, ONLY : TDTEXP ! Ajout PP
USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
USE MODD_TURB_n
+USE MODD_VAR_ll, ONLY: IP
USE MODE_AERO_PSD
use mode_budget, only: Budget_store_end, Budget_store_init
@@ -777,7 +779,7 @@ CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
XLWD(:,:,:)=0.0
XDTHRADSW(:,:,:)=0.0
XDTHRADLW(:,:,:)=0.0
- CALL RADIATIONS_AGG(NRAD_AGG,NI_RAD_AGG,NJ_RAD_AGG,NIOR_RAD_AGG,NJOR_RAD_AGG, TPFILE, &
+ CALL RADIATIONS_AGG(NRAD_AGG,NI_RAD_AGG,NJ_RAD_AGG,NIOR_RAD_AGG,NJOR_RAD_AGG, NRAD_AGG_FLAG, 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, &
diff --git a/src/MNH/radiations.f90 b/src/MNH/radiations.f90
index 7917ae111200cbedcd572a0ba06849df616c4eef..246c30f19679efee60156c9914ecf65feebf2957 100644
--- a/src/MNH/radiations.f90
+++ b/src/MNH/radiations.f90
@@ -123,6 +123,7 @@ CONTAINS
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 06/09/2022: small fix: GSURF_CLOUD was not set outside of physical domain
+! V. Masson 03/01/2024: aggregation of columns for radiation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/radiations_agg.f90 b/src/MNH/radiations_agg.f90
index bbc5d383f7f0f091ed3af08658b8291edcb77162..f06055180abe13dd91a7581d6469d4cfc84576ea 100644
--- a/src/MNH/radiations_agg.f90
+++ b/src/MNH/radiations_agg.f90
@@ -9,7 +9,7 @@
!
INTERFACE
- SUBROUTINE RADIATIONS_AGG (KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG, &
+ SUBROUTINE RADIATIONS_AGG (KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG,KRAD_AGG_FLAG, &
TPFILE,OCLEAR_SKY,OCLOUD_ONLY, &
KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW, &
PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB_OLD, &
@@ -26,6 +26,8 @@ INTEGER, INTENT(IN) :: KI_RAD_AGG ! reformatted X array size
INTEGER, INTENT(IN) :: KJ_RAD_AGG ! reformatted Y array size
INTEGER, INTENT(IN) :: KIOR_RAD_AGG ! index of first point of packed array according to current domain
INTEGER, INTENT(IN) :: KJOR_RAD_AGG ! index of first point of packed array according to current domain
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KRAD_AGG_FLAG ! flag to know if aggregated column is computed in this processor or another one
+
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
LOGICAL, INTENT(IN) :: OCLOUD_ONLY! flag for the cloud column
@@ -113,7 +115,7 @@ END INTERFACE
END MODULE MODI_RADIATIONS_AGG
!
! ############################################################################
- SUBROUTINE RADIATIONS_AGG (KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG, &
+ SUBROUTINE RADIATIONS_AGG (KRAD_AGG,KI_RAD_AGG,KJ_RAD_AGG,KIOR_RAD_AGG,KJOR_RAD_AGG,KRAD_AGG_FLAG, &
TPFILE,OCLEAR_SKY,OCLOUD_ONLY, &
KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW, &
PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB_OLD, &
@@ -192,6 +194,7 @@ INTEGER, INTENT(IN) :: KI_RAD_AGG ! reformatted X array size
INTEGER, INTENT(IN) :: KJ_RAD_AGG ! reformatted Y array size
INTEGER, INTENT(IN) :: KIOR_RAD_AGG ! index of first point of packed array according to current domain
INTEGER, INTENT(IN) :: KJOR_RAD_AGG ! index of first point of packed array according to current domain
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KRAD_AGG_FLAG ! flag to know if aggregated column is computed in this processor or another one
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
LOGICAL, INTENT(IN) :: OCLOUD_ONLY! flag for the cloud column
@@ -630,35 +633,87 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PFULL
REAL, DIMENSION(:,:), INTENT(OUT) :: PPACK
LOGICAL :: OEXCH
-! DO JJP=1,MIN(KJ_RAD_AGG,IJMAX)
-! DO JIP=1,MIN(KI_RAD_AGG,IIMAX)
DO JJP=1,KJ_RAD_AGG
DO JIP=1,KI_RAD_AGG
IXORP = KIOR_RAD_AGG + (JIP-1) * KRAD_AGG
IYORP = KJOR_RAD_AGG + (JJP-1) * KRAD_AGG
- PPACK(JIP,JJP) = PFULL(MIN(IXORP + KRAD_AGG/2,IImax),MIN(IYORP + KRAD_AGG/2,Ijmax) )
+ PPACK(JIP,JJP) = PFULL(MIN(IXORP + KRAD_AGG/2,IIMAX),MIN(IYORP + KRAD_AGG/2,IJMAX) )
END DO
END DO
END SUBROUTINE PACK_RAD_AGG_MID
-!
!-------------------------------------------------------------------------------
!
SUBROUTINE UNPACK_RAD_AGG_2D(PFULL,PPACK)
REAL, DIMENSION(:,:), INTENT(OUT) :: PFULL
REAL, DIMENSION(:,:), INTENT(IN) :: PPACK
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+REAL, DIMENSION(SIZE(PFULL,1),SIZE(PFULL,2)) :: ZFULL
+
+ ZFULL = 0.
+ ! unpacks columns whose center is located in the current processor
DO JJP=1,KJ_RAD_AGG
DO JIP=1,KI_RAD_AGG
IXORP = KIOR_RAD_AGG + (JIP-1) * KRAD_AGG
IYORP = KJOR_RAD_AGG + (JJP-1) * KRAD_AGG
DO JJ=IYORP,MIN(IYORP+KRAD_AGG-1,IJMAX)
DO JI=IXORP,MIN(IXORP+KRAD_AGG-1,IIMAX)
- PFULL(JI,JJ) = PPACK(JIP,JJP)
+ ZFULL(JI,JJ) = PPACK(JIP,JJP)
END DO
END DO
END DO
END DO
+ ! stores the output field
+ PFULL = 0.
+ PFULL(IIB:IIE,IJB:IJE) = ZFULL(IIB:IIE,IJB:IJE)
+
+ ! updates boundaries outside processor (that's because some aggregated columns were computed another processors)
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, ZFULL, 'RADIATION_AGG: UNPACK_RAD_AGG_2D' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+
+ ! Get the values of the packed column for points in the HALO if those were indeed computed by the other processors
+! DO JJ=1,IJB-1
+! DO JI=1,IIB-1
+! IF (ZFULL(JI,JJ) /= 0.) PFULL(JI,JJ) = ZFULL(JI,JJ)
+! END DO
+! END DO
+! DO JJ=IJE+1,IJU
+! DO JI=1,IIB-1
+! IF (ZFULL(JI,JJ) /= 0.) PFULL(JI,JJ) = ZFULL(JI,JJ)
+! END DO
+! END DO
+! DO JJ=1,IJB-1
+! DO JI=IIE+1,IIU
+! IF (ZFULL(JI,JJ) /= 0.) PFULL(JI,JJ) = ZFULL(JI,JJ)
+! END DO
+! END DO
+! DO JJ=IJE+1,IJU
+! DO JI=IIE+1,IIU
+! IF (ZFULL(JI,JJ) /= 0.) PFULL(JI,JJ) = ZFULL(JI,JJ)
+! END DO
+! END DO
+
+
+ ! Get the values of the packed column for points whose column center is outside the processor
+ ! In that case, the column is on one of the sides outside the processor, but within the NHALO bands
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (KRAD_AGG_FLAG(JI,JJ)==0) CYCLE ! points whose aggregated columns were computed within this processor
+ IF (KRAD_AGG_FLAG(JI,JJ)==1) PFULL(JI,JJ) = ZFULL(IIB-1,JJ) ! computed column was towards West side of processor
+ IF (KRAD_AGG_FLAG(JI,JJ)==2) PFULL(JI,JJ) = ZFULL(JI,IJB-1) ! computed column was towards South side of processor
+ IF (KRAD_AGG_FLAG(JI,JJ)==3) PFULL(JI,JJ) = ZFULL(IIE+1,JJ) ! computed column was towards East side of processor
+ IF (KRAD_AGG_FLAG(JI,JJ)==4) PFULL(JI,JJ) = ZFULL(JI,IJE+1) ! computed column was towards North side of processor
+ IF (KRAD_AGG_FLAG(JI,JJ)==5) PFULL(JI,JJ) = ZFULL(IIB-1,IJB-1) ! computed column was towards South-West corner
+ IF (KRAD_AGG_FLAG(JI,JJ)==6) PFULL(JI,JJ) = ZFULL(IIE+1,IJB-1) ! computed column was towards South-East corner
+ IF (KRAD_AGG_FLAG(JI,JJ)==7) PFULL(JI,JJ) = ZFULL(IIE+1,IJE+1) ! computed column was towards North-East corner
+ IF (KRAD_AGG_FLAG(JI,JJ)==8) PFULL(JI,JJ) = ZFULL(IIB-1,IJE+1) ! computed column was towards North-West corner
+ END DO
+ END DO
+ !
END SUBROUTINE UNPACK_RAD_AGG_2D
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index 95a1c0e424314b794ce7ba28699aa86f53bc78f1..b2f87f427d65c90c079464a6abad42b5f6aae67a 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -313,6 +313,7 @@ END MODULE MODI_READ_EXSEG_n
! P. Wautelet 19/08/2022: add namelist for aircrafts
! H. Toumi 09/2022: add EOL/ADR
! C. Barthe 11/07/2023: ELEC: only some combinations of microphysical options are allowed
+! V. Masson 03/01/2024: aggregation of columns for radiation
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/reset_exseg.f90 b/src/MNH/reset_exseg.f90
index b467f7c05123f190f3c63c50506cf111bdbd110f..ce172c04b34ac62bef903e7983fb9ca3d2af4e32 100644
--- a/src/MNH/reset_exseg.f90
+++ b/src/MNH/reset_exseg.f90
@@ -173,9 +173,6 @@ IF ( NRAD_3D>=1 ) THEN
CGETRAD='INIT'
END IF
!
-IF(LEN_TRIM(CRAD_SAT) /= 0) THEN
- CRAD='ECMW'
-END IF
!
IF ( IP == 1 ) PRINT*,'RESET_EXSEG OUTPUT: NRAD_3D =',NRAD_3D,' CRAD =',CRAD,' CGETRAD =',CGETRAD
!
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 51209fc69bcae1e39a1b6f320db3a2d2e58319c9..a78ace969ea25378dbf3945f822977ea770627a3 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -314,6 +314,7 @@ USE MODD_PARAM_ICE_n, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, LRED, PARAM_IC
USE MODD_PARAM_LIMA, ONLY: LADJ, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM, NMOM_I
USE MODD_RAIN_ICE_DESCR_n, ONLY: XRTMIN, RAIN_ICE_DESCRN
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAMN
+USE MODD_REF, ONLY: XTHVREFZ
USE MODD_SALT, ONLY: LSALT
USE MODD_TURB_n, ONLY: TURBN
!
@@ -964,8 +965,8 @@ SELECT CASE ( HCLOUD )
ALLOCATE(ZQHS(0,0,0))
!
CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, RAIN_ICE_DESCRN, &
- ELEC_PARAM, ELEC_DESCR, TBUCONF, 0, .FALSE., &
- GELEC, LSEDIM_BEARD, &
+ ELEC_PARAM, ELEC_DESCR, TBUCONF, GELEC, LSEDIM_BEARD, &
+ XTHVREFZ(IKB), HCLOUD, &
PTSTEP, KRR, ZEXN, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -1245,9 +1246,9 @@ SELECT CASE ( HCLOUD )
ALLOCATE(ZEFIELDW(0,0,0))
END IF
!
- CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, RAIN_ICE_DESCRN, &
- ELEC_PARAM, ELEC_DESCR, TBUCONF, 0, .FALSE., &
- GELEC, LSEDIM_BEARD, &
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, RAIN_ICE_DESCRN, &
+ ELEC_PARAM, ELEC_DESCR, TBUCONF, GELEC, LSEDIM_BEARD, &
+ XTHVREFZ(IKB), HCLOUD, &
PTSTEP, KRR, ZEXN, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -1386,9 +1387,11 @@ SELECT CASE ( HCLOUD )
ZZZ = MZF( PZZ )
IF (LPTSPLIT) THEN
IF (GELEC) THEN
- CALL LIMA (YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
- PTSTEP, GELEC, &
- PRHODREF, PEXNREF, ZDZZ, &
+ CALL LIMA (YLDIMPHYEX,CST, RAIN_ICE_DESCRN, RAIN_ICE_PARAMN, &
+ ELEC_DESCR, ELEC_PARAM, &
+ TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ PTSTEP, GELEC, HCLOUD, &
+ PRHODREF, PEXNREF, ZDZZ, XTHVREFZ(IKB), &
PRHODJ, PPABST, &
NMOD_CCN, NMOD_IFN, NMOD_IMM, &
PDTHRAD, PTHT, PRT, &
@@ -1400,9 +1403,11 @@ SELECT CASE ( HCLOUD )
PSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND) )
ELSE
- CALL LIMA (YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
- PTSTEP, GELEC, &
- PRHODREF, PEXNREF, ZDZZ, &
+ CALL LIMA (YLDIMPHYEX,CST, RAIN_ICE_DESCRN, RAIN_ICE_PARAMN, &
+ ELEC_DESCR, ELEC_PARAM, &
+ TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ PTSTEP, GELEC, HCLOUD, &
+ PRHODREF, PEXNREF, ZDZZ, XTHVREFZ(IKB), &
PRHODJ, PPABST, &
NMOD_CCN, NMOD_IFN, NMOD_IMM, &
PDTHRAD, PTHT, PRT, &
diff --git a/src/MNH/spawn_field2.f90 b/src/MNH/spawn_field2.f90
index 50047fb02056b2cf69a0a7b247ff23c5353c1cb5..418797c5b4d4a5556772545d79901a790c249fac 100644
--- a/src/MNH/spawn_field2.f90
+++ b/src/MNH/spawn_field2.f90
@@ -175,7 +175,11 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX, ONLY: LTH_FLX, LUV_FLX
USE MODD_LBC_n, ONLY: LBC_MODEL
USE MODD_LUNIT_n, ONLY: TLUOUT
+#ifdef MNH_FOREFIRE
+USE MODD_NSV
+#else
USE MODD_NSV, ONLY: NSV, NSV_CSBEG, NSV_CSEND, NSV_PPBEG, NSV_PPEND, NSV_USER, TSVLIST
+#endif
USE MODD_RELFRC_n, ONLY: RELFRC_MODEL
USE MODD_SPAWN
!
diff --git a/src/MNH/write_lfifm1_for_diag_supp.f90 b/src/MNH/write_lfifm1_for_diag_supp.f90
index 974e78231d39c46ec70973c62476ca5fb54998d5..0dd9d393cabb8edea6844514faa980b353596b3c 100644
--- a/src/MNH/write_lfifm1_for_diag_supp.f90
+++ b/src/MNH/write_lfifm1_for_diag_supp.f90
@@ -71,7 +71,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!! choose the platform, the satellite, the sensor for all channels
!! (see the table in rttov science and validation report) and the
!! type of calculations in the namelist: 0 = tb, 1 = tb + jacobian,
-!! 2 = tb + adjoint, 3 = tb + jacobian + adjoint)
+!! 2 = tb + adjoint, 3 = tb + jacobian + adjoint) --- !!! removed !!!
!! V. Masson 01/2004 removes surface (externalization)
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
@@ -82,7 +82,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!! P.Tulet : Diag for salt and orilam
!! J.-P. Chaboureau 07/03/2016 fix the dimensions of local arrays
!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
-!! J.-P. Chaboureau 31/10/2016 add the call to RTTOV11
+!! J.-P. Chaboureau 31/10/2016 add the call to RTTOV11 --- !!! removed !!!
!! F. Brosse 10/2016 add chemical production destruction terms outputs
!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
!! J.-P. Chaboureau 01/2018 add altitude interpolation
@@ -117,7 +117,7 @@ USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_CONF_n, ONLY: LUSERC, LUSERI, LUSERV, NRR
USE MODD_DEEP_CONVECTION_n, ONLY: NCLBASCONV, NCLTOPCONV, XCAPE, XDMFCONV, XDRCCONV, XDRICONV, XDRVCONV, &
XDTHCONV, XDSVCONV, XMFCONV, XPRLFLXCONV, XPRSFLXCONV, XUMFCONV
-USE MODD_DIAG_FLAG, ONLY: CRAD_SAT, LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL, LISOPR, LISOTH, LRAD_SUBG_COND, &
+USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL, LISOPR, LISOTH, LRAD_SUBG_COND, &
NCONV_KF, NDXCOARSE, NRAD_3D, NRTTOVINFO, XISOAL, XISOPR, XISOTH
USE MODD_FIELD_n, ONLY: XCLDFR, XICEFR, XPABST, XSIGS, XTHT, XTKET, XRT, XUT, XVT, XWT
USE MODD_GRID_n, ONLY: XZHAT, XZZ
@@ -143,12 +143,6 @@ USE MODE_NEIGHBORAVG, ONLY: BLOCKAVG, MOVINGAVG
USE MODE_THERMO, ONLY: SM_FOES
USE MODE_TOOLS_LL, ONLY: GET_INDICE_ll
-#ifdef MNH_RTTOV_8
-USE MODI_CALL_RTTOV8
-#endif
-#ifdef MNH_RTTOV_11
-USE MODI_CALL_RTTOV11
-#endif
#ifdef MNH_RTTOV_13
USE MODI_CALL_RTTOV13
#endif
@@ -160,7 +154,6 @@ USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_PINTER
USE MODI_SHUMAN
-USE MODI_RADTR_SATEL
USE MODI_UV_TO_ZONAL_AND_MERID
USE MODI_ZINTER
@@ -710,97 +703,12 @@ IF (LCHEMDIAG) THEN
END IF
!-------------------------------------------------------------------------------
!
-!* Brightness temperatures from the radiatif transfer code (Morcrette, 1991)
-!
-IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. NRR /=0) THEN
- ALLOCATE (ZIRBT(IIU,IJU),ZWVBT(IIU,IJU))
- ITOTGEO=0
- IF (INDEX(CRAD_SAT,'GOES-E') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 1
- YNAM_SAT(ITOTGEO) = 'GOES-E'
- END IF
- IF (INDEX(CRAD_SAT,'GOES-W') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 2
- YNAM_SAT(ITOTGEO) = 'GOES-W'
- END IF
- IF (INDEX(CRAD_SAT,'GMS') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 3
- YNAM_SAT(ITOTGEO) = 'GMS'
- END IF
- IF (INDEX(CRAD_SAT,'INDSAT') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 4
- YNAM_SAT(ITOTGEO) = 'INDSAT'
- END IF
- IF (INDEX(CRAD_SAT,'METEOSAT') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 5
- YNAM_SAT(ITOTGEO) = 'METEOSAT'
- END IF
- PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURES FOR ',ITOTGEO,' SATELLITE(S)'
- IF (NRR==1) THEN
- PRINT*,' THERE IS ONLY VAPOR WATER IN YOUR ATMOSPHERE'
- PRINT*,' IRBT WILL NOT TAKE INTO ACCOUNT CLOUDS.'
- END IF
- !
- DO JI=1,ITOTGEO
- ZIRBT(:,:) = XUNDEF
- ZWVBT(:,:) = XUNDEF
- CALL RADTR_SATEL( TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
- NDLON, NFLEV, NSTATM, NRAD_COLNBR, XEMIS(:,:,1), &
- XCCO2, XTSRAD, XSTATM, XTHT, XRT, XPABST, XZZ, &
- XSIGS, XMFCONV, MAX(XCLDFR,XICEFR), LUSERI, LSIGMAS, &
- LSUBG_COND, LRAD_SUBG_COND, ZIRBT, ZWVBT, &
- INDGEO(JI), VSIGQSAT )
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YNAM_SAT(JI))//'_IRBT', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YNAM_SAT(JI))//'_IRBT', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YNAM_SAT(JI))//' Infra-Red Brightness Temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZIRBT)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YNAM_SAT(JI))//'_WVBT', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YNAM_SAT(JI))//'_WVBT', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YNAM_SAT(JI))//' Water-Vapor Brightness Temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWVBT)
- END DO
- DEALLOCATE(ZIRBT,ZWVBT)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
!* Brightness temperatures from the Radiatif Transfer for Tiros Operational
! Vertical Sounder (RTTOV) code
!
IF (NRTTOVINFO(1,1) /= NUNDEF) THEN
! PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURE COMPUTED BY THE RTTOV CODE'
-#if defined(MNH_RTTOV_8)
- CALL CALL_RTTOV8(NDLON, NFLEV, NSTATM, XEMIS(:,:,1), XTSRAD, XSTATM, XTHT, XRT, &
- XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
- LUSERI, NRTTOVINFO, TPFILE )
-#elif defined(MNH_RTTOV_11)
- CALL CALL_RTTOV11(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, &
- XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
- LUSERI, NRTTOVINFO, TPFILE )
-#elif defined(MNH_RTTOV_13)
+#if defined(MNH_RTTOV_13)
CALL CALL_RTTOV13(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, &
XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
LUSERI, NRTTOVINFO, TPFILE )
diff --git a/src/Makefile b/src/Makefile
index d903b69fdec9669451f95961dc7fafd4030c6d96..092383fcbb6516383b8f9e0d5c25011435253f9b 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -352,7 +352,7 @@ $(CDF_MOD) :
cd ${DIR_HDF} && ./configure --enable-fortran --disable-shared --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 --with-szlib=${CDF_PATH}/include,${CDF_PATH}/lib64 \
CC="$(CC)" CFLAGS="$(HDF_OPT)" ${HDF_CONF} FC="$(FC)" FCFLAGS="$(NETCDF_OPT)" LDFLAGS="-L${CDF_PATH}/lib64" LIBS="-lsz -laec -lz" && \
$(MAKE) && $(MAKE) install && $(MAKE) clean
- cd ${DIR_CDFC} && ./configure --disable-shared --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 --disable-dap --disable-byterange \
+ cd ${DIR_CDFC} && ./configure --disable-shared --disable-libxml2 --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 --disable-dap --disable-byterange \
CC="$(CC)" CFLAGS="$(NETCDF_OPT)" CPPFLAGS="${INC_NETCDF}" ${CDF_CONF} LDFLAGS="-L${CDF_PATH}/lib64" LIBS="-lhdf5_hl -lhdf5 -lsz -laec -lz -ldl " && \
$(MAKE) && $(MAKE) install && $(MAKE) clean
ifdef MNH_FOREFIRE
@@ -520,7 +520,7 @@ ARFLAGS=r
#
# GENERATION OF DEPENDANCE FILES : *.D
#
-SPLL ?= spll
+SPLL ?= spll_new
%.D:%.F90
$(CPP) $(INC) $(CPPFLAGS) $< > $(OBJDIR)/$(*F).f90
$(SPLL) $(NSOURCE) $(OBJDIR)/$(*F).f90
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index 791ff37ea2d4a857d24e31fda8ab68adf344a855..2444943ffddb157a748c66a6fcb2a6936daff477 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -200,30 +200,7 @@ endif
##########################################################
ifdef MNH_RTTOV
ifndef VER_RTTOV
-VER_RTTOV = 8.7
-endif
-ifeq "$(VER_RTTOV)" "8.7"
-DIR_RTTOV += LIB/RTTOV/src
-CPPFLAGS_RTTOV = -DMNH_RTTOV
-INC_RTTOV = -I$(B)LIB/RTTOV/src
-#
-DIR_MASTER += $(DIR_RTTOV)
-CPPFLAGS += $(CPPFLAGS_RTTOV)
-INC += $(INC_RTTOV)
-CPPFLAGS += $(CPPFLAGS_RTTOV)
-CPPFLAGS_MNH += -DMNH_RTTOV_8=MNH_RTTOV_8
-endif
-ifeq "$(VER_RTTOV)" "11.3"
-DIR_RTTOV=${SRC_MESONH}/src/LIB/RTTOV-${VER_RTTOV}
-RTTOV_PATH=${DIR_RTTOV}
-#
-INC_RTTOV ?= -I${RTTOV_PATH}/include -I${RTTOV_PATH}/mod
-LIB_RTTOV ?= -L${RTTOV_PATH}/lib -lrttov11_coef_io -lrttov11_mw_scatt -lrttov11_main
-INC += $(INC_RTTOV)
-LIBS += $(LIB_RTTOV)
-VPATH += $(RTTOV_PATH)/mod
-CPPFLAGS += $(CPPFLAGS_RTTOV)
-CPPFLAGS_MNH += -DMNH_RTTOV_11=MNH_RTTOV_11
+VER_RTTOV = 13.2
endif
ifeq "$(VER_RTTOV)" "13.2"
DIR_RTTOV=${SRC_MESONH}/src/LIB/RTTOV-${VER_RTTOV}
diff --git a/src/PHYEX/aux/modd_phyex.f90 b/src/PHYEX/aux/modd_phyex.f90
index 6b8ddb985f6e7736b12ae3c805788d684e4c377a..493013dda18d51d9f5b16389f2aea34fb9cddaef 100644
--- a/src/PHYEX/aux/modd_phyex.f90
+++ b/src/PHYEX/aux/modd_phyex.f90
@@ -32,6 +32,8 @@ USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_t
USE MODD_PARAM_LIMA_WARM, ONLY: PARAM_LIMA_WARM_t
USE MODD_PARAM_LIMA_COLD, ONLY: PARAM_LIMA_COLD_t
USE MODD_PARAM_LIMA_MIXED, ONLY: PARAM_LIMA_MIXED_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
USE MODD_NSV, ONLY: NSV_t
USE MODD_MISC, ONLY: MISC_t
!
@@ -52,6 +54,8 @@ TYPE PHYEX_t
TYPE(PARAM_LIMA_WARM_t):: PARAM_LIMA_WARM !< Microphysical factors for LIMA (warm processes)
TYPE(PARAM_LIMA_COLD_t):: PARAM_LIMA_COLD !< Microphysical factors for LIMA (cold processes)
TYPE(PARAM_LIMA_MIXED_t):: PARAM_LIMA_MIXED !< Microphysical factors for LIMA (mixed processes)
+ TYPE(ELEC_DESCR_t) :: ELEC_DESCR ! Electricity descriptive constants
+ TYPE(ELEC_PARAM_t) :: ELEC_PARAM ! Electricity parameters
TYPE(NSV_t) :: TNSV !< NSV indexes
!
! Supplementary strucuture to hold model specific values
diff --git a/src/PHYEX/aux/mode_gradient_m_phy.f90 b/src/PHYEX/aux/mode_gradient_m_phy.f90
index e4df65f930da03f27b8d6f9bf524d49349f0a865..aeb7f5d1d9c6ac052b5cfc51f62f707724dabb81 100644
--- a/src/PHYEX/aux/mode_gradient_m_phy.f90
+++ b/src/PHYEX/aux/mode_gradient_m_phy.f90
@@ -489,8 +489,8 @@ CALL D1D_TO_3D(D,ZGX_M_U,PGX_M_U)
END DO
ELSE
! PGX_M_U = DXM(PY) / PDXX
- PGX_M_U(1+1:IIU,:,:) = ( ZY(1+1:IIU,:,:)-ZY(1:IIU-1,:,:) ) &
- / ZDXX(1+1:IIU,:,:)
+ PGX_M_U(2:IIU,:,:) = ( ZY(2:IIU,:,:)-ZY(1:IIU-1,:,:) ) &
+ / ZDXX(2:IIU,:,:)
!
ENDIF
DO JI=1,JPHEXT
@@ -621,8 +621,8 @@ IF (.NOT. OFLAT) THEN
!
ELSE
! PGY_M_V = DYM(PY)/PDYY
- PGY_M_V(:,1+1:IJU,:) = ( PY(:,1+1:IJU,:)-PY(:,1:IJU-1,:) ) &
- / PDYY(:,1+1:IJU,:)
+ PGY_M_V(:,2:IJU,:) = ( PY(:,2:IJU,:)-PY(:,1:IJU-1,:) ) &
+ / PDYY(:,2:IJU,:)
!
ENDIF
DO JJ=1,JPHEXT
diff --git a/src/PHYEX/micro/compute_frac_ice.func.h b/src/PHYEX/micro/compute_frac_ice.func.h
index b425ef0f928e8829fc33f2cc8438fb2e765e8c30..e18f510a574de5830dfc4862a4ecb41c018775d9 100644
--- a/src/PHYEX/micro/compute_frac_ice.func.h
+++ b/src/PHYEX/micro/compute_frac_ice.func.h
@@ -2,7 +2,7 @@
!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 COMPUTE_FRAC_ICE(HFRAC_ICE,NEBN,PFRAC_ICE,PT,KERR)
+ ELEMENTAL SUBROUTINE COMPUTE_FRAC_ICE(CST, HFRAC_ICE,NEBN,PFRAC_ICE,PT,KERR)
! ******* TO BE INCLUDED IN THE *CONTAINS* OF A SUBROUTINE, IN ORDER TO EASE AUTOMATIC INLINING ******
! => Don't use drHook !!!
@@ -22,10 +22,11 @@
!
!! --------------------------------------------------------------------------
USE MODD_NEB_n, ONLY : NEB_t
-USE MODD_CST, ONLY : XTT
+USE MODD_CST, ONLY : CST_t
!
IMPLICIT NONE
!
+TYPE(CST_t), INTENT(IN) :: CST
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
TYPE(NEB_t), INTENT(IN) :: NEBN
REAL, INTENT(IN) :: PT ! temperature
@@ -41,7 +42,7 @@ SELECT CASE(HFRAC_ICE)
CASE ('T') !using Temperature
PFRAC_ICE = MAX( 0., MIN(1., (( NEBN%XTMAXMIX - PT ) / ( NEBN%XTMAXMIX - NEBN%XTMINMIX )) ) ) ! freezing interval
CASE ('O') !using Temperature with old formulae
- PFRAC_ICE = MAX( 0., MIN(1., (( XTT - PT ) / 40.) ) ) ! freezing interval
+ PFRAC_ICE = MAX( 0., MIN(1., (( CST%XTT - PT ) / 40.) ) ) ! freezing interval
CASE ('N') !No ice
PFRAC_ICE = 0.
CASE ('S') !Same as previous
diff --git a/src/PHYEX/micro/condensation.f90 b/src/PHYEX/micro/condensation.f90
index 0bcb57d47016ce2bd47ad0bbdfd42dae01547e3f..1ac71be35b944c0660496002ec045f8e5032b355 100644
--- a/src/PHYEX/micro/condensation.f90
+++ b/src/PHYEX/micro/condensation.f90
@@ -345,7 +345,7 @@ DO JK=IKTB,IKTE
ENDIF
END DO
DO JIJ=IIJB,IIJE
- CALL COMPUTE_FRAC_ICE(HFRAC_ICE, NEBN, ZFRAC(JIJ), PT(JIJ,JK), IERR) !error code IERR cannot be checked here to not break vectorization
+ CALL COMPUTE_FRAC_ICE(CST, HFRAC_ICE, NEBN, ZFRAC(JIJ), PT(JIJ,JK), IERR) !error code IERR cannot be checked here to not break vectorization
ENDDO
ENDIF
DO JIJ=IIJB,IIJE
diff --git a/src/PHYEX/micro/ice4_nucleation.func.h b/src/PHYEX/micro/ice4_nucleation.func.h
new file mode 100644
index 0000000000000000000000000000000000000000..758c515754d4594686a3fc0d78c39eefdb0ddb7a
--- /dev/null
+++ b/src/PHYEX/micro/ice4_nucleation.func.h
@@ -0,0 +1,123 @@
+!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(CST, PARAMI, ICEP, ICED, 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: CST_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+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 array
+ ZUSW, & ! Undersaturation over water
+ ZSSI ! Supersaturation over ice
+!-------------------------------------------------------------------------------
+!
+!
+ IF (ODCOMPUTE) THEN
+GNEGT=PT<CST%XTT .AND. PRVT>ICED%XRTMIN(1)
+ELSE
+GNEGT=.FALSE.
+END IF
+
+ZUSW=0.
+ZZW=0.
+
+IF (GNEGT) THEN
+ ZZW=ALOG(PT)
+ ZUSW=EXP(CST%XALPW - CST%XBETAW/PT - CST%XGAMW*ZZW) ! es_w
+ ZZW=EXP(CST%XALPI - CST%XBETAI/PT - CST%XGAMI*ZZW) ! es_i
+END IF
+
+ZSSI=0.
+IF (GNEGT) THEN
+ ZZW=MIN(PPABST/2., ZZW) ! safety limitation
+ ZSSI=PRVT*(PPABST-ZZW) / (CST%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
+ ZSSI=MIN(ZSSI, ZUSW) ! limitation of SSi according to SSw=0
+END IF
+
+ZZW=0.
+
+IF(GNEGT) THEN
+ IF(PT<CST%XTT-5.0 .AND. ZSSI>0.0) THEN
+ ZZW=ICEP%XNU20*EXP(ICEP%XALPHA2*ZSSI-ICEP%XBETA2)
+ ELSEIF(PT<=CST%XTT-2.0 .AND. PT>=CST%XTT-5.0 .AND. ZSSI>0.0) THEN
+ ZZW=MAX(ICEP%XNU20*EXP(-ICEP%XBETA2 ), &
+ ICEP%XNU10*EXP(-ICEP%XBETA1*(PT-CST%XTT))*(ZSSI/ZUSW)**ICEP%XALPHA1)
+ ENDIF
+ENDIF
+IF (GNEGT) THEN
+ ZZW=ZZW-PCIT
+ ZZW=MIN(ZZW, 50.E3) ! limitation provisoire a 50 l^-1
+END IF
+
+PRVHENI_MR=0.
+
+IF (GNEGT) THEN
+ PRVHENI_MR=MAX(ZZW, 0.0)*ICEP%XMNU0/PRHODREF
+ PRVHENI_MR=MIN(PRVT, PRVHENI_MR)
+END IF
+!Limitation due to 0 crossing of temperature
+IF(PARAMI%LFEEDBACKT) THEN
+ ZW=0.
+ IF (GNEGT) THEN
+ ZW=MIN(PRVHENI_MR, &
+ MAX(0., (CST%XTT/PEXN-PTHT)/PLSFACT)) / &
+ MAX(PRVHENI_MR, 1.E-20)
+ END IF
+ PRVHENI_MR=PRVHENI_MR*ZW
+ ZZW=ZZW*ZW
+ENDIF
+IF (GNEGT) THEN
+ PCIT=MAX(ZZW+PCIT, PCIT)
+END IF
+END SUBROUTINE ICE4_NUCLEATION
diff --git a/src/PHYEX/micro/ice_adjust.f90 b/src/PHYEX/micro/ice_adjust.f90
index b480da71079ce570a02efe4b5e800f609bb1e9c6..611c3b17c562c3d4be9d6ee12ef1c7d920df01ca 100644
--- a/src/PHYEX/micro/ice_adjust.f90
+++ b/src/PHYEX/micro/ice_adjust.f90
@@ -103,6 +103,7 @@
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!! 2020-12 U. Andrae : Introduce SPP for HARMONIE-AROME
!! R. El Khatib 24-Aug-2021 Optimizations
+!! R. El Khatib 24-Oct-2023 Re-vectorize ;-)
!!
!-------------------------------------------------------------------------------
!
@@ -216,6 +217,8 @@ INTEGER :: IKTB, IKTE, IIJB, IIJE
!
REAL, DIMENSION(D%NIJT,D%NKT) :: ZSIGS, ZSRCS
REAL, DIMENSION(D%NIJT) :: ZSIGQSAT
+LOGICAL :: LLNONE, LLTRIANGLE, LLHLC_H, LLHLI_H
+
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -319,6 +322,13 @@ DO JK=IKTB,IKTE
END IF
ENDDO
ELSE !NEBN%LSUBG_COND case
+ ! Tests on characters strings can break the vectorization, or at least they would
+ ! slow down considerably the performance of a vector loop. One should use tests on
+ ! reals, integers or booleans only. REK.
+ LLNONE=PARAMI%CSUBG_MF_PDF=='NONE'
+ LLTRIANGLE=PARAMI%CSUBG_MF_PDF=='TRIANGLE'
+ LLHLC_H=PRESENT(PHLC_HRC).AND.PRESENT(PHLC_HCF)
+ LLHLI_H=PRESENT(PHLI_HRI).AND.PRESENT(PHLI_HCF)
DO JIJ=IIJB,IIJE
!We limit PRC_MF+PRI_MF to PRVS*PTSTEP to avoid negative humidity
ZW1=PRC_MF(JIJ,JK)/PTSTEP
@@ -334,14 +344,14 @@ DO JK=IKTB,IKTE
PTHS(JIJ,JK) = PTHS(JIJ,JK) + &
(ZW1 * ZLV(JIJ,JK) + ZW2 * ZLS(JIJ,JK)) / ZCPH(JIJ,JK) / PEXNREF(JIJ,JK)
!
- IF(PRESENT(PHLC_HRC) .AND. PRESENT(PHLC_HCF)) THEN
+ IF(LLHLC_H) THEN
ZCRIAUT=ICEP%XCRIAUTC/PRHODREF(JIJ,JK)
- IF(PARAMI%CSUBG_MF_PDF=='NONE')THEN
+ IF(LLNONE)THEN
IF(ZW1*PTSTEP>PCF_MF(JIJ,JK) * ZCRIAUT) THEN
PHLC_HRC(JIJ,JK)=PHLC_HRC(JIJ,JK)+ZW1*PTSTEP
PHLC_HCF(JIJ,JK)=MIN(1.,PHLC_HCF(JIJ,JK)+PCF_MF(JIJ,JK))
ENDIF
- ELSEIF(PARAMI%CSUBG_MF_PDF=='TRIANGLE')THEN
+ ELSEIF(LLTRIANGLE)THEN
!ZHCF is the precipitating part of the *cloud* and not of the grid cell
IF(ZW1*PTSTEP>PCF_MF(JIJ,JK)*ZCRIAUT) THEN
ZHCF=1.-.5*(ZCRIAUT*PCF_MF(JIJ,JK) / MAX(1.E-20, ZW1*PTSTEP))**2
@@ -362,14 +372,14 @@ DO JK=IKTB,IKTE
PHLC_HRC(JIJ,JK)=PHLC_HRC(JIJ,JK)+ZHR
ENDIF
ENDIF
- IF(PRESENT(PHLI_HRI) .AND. PRESENT(PHLI_HCF)) THEN
+ IF(LLHLI_H) THEN
ZCRIAUT=MIN(ICEP%XCRIAUTI,10**(ICEP%XACRIAUTI*(ZT(JIJ,JK)-CST%XTT)+ICEP%XBCRIAUTI))
- IF(PARAMI%CSUBG_MF_PDF=='NONE')THEN
+ IF(LLNONE)THEN
IF(ZW2*PTSTEP>PCF_MF(JIJ,JK) * ZCRIAUT) THEN
PHLI_HRI(JIJ,JK)=PHLI_HRI(JIJ,JK)+ZW2*PTSTEP
PHLI_HCF(JIJ,JK)=MIN(1.,PHLI_HCF(JIJ,JK)+PCF_MF(JIJ,JK))
ENDIF
- ELSEIF(PARAMI%CSUBG_MF_PDF=='TRIANGLE')THEN
+ ELSEIF(LLTRIANGLE)THEN
!ZHCF is the precipitating part of the *cloud* and not of the grid cell
IF(ZW2*PTSTEP>PCF_MF(JIJ,JK)*ZCRIAUT) THEN
ZHCF=1.-.5*(ZCRIAUT*PCF_MF(JIJ,JK) / (ZW2*PTSTEP))**2
diff --git a/src/PHYEX/micro/ini_neb.f90 b/src/PHYEX/micro/ini_neb.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/src/PHYEX/micro/lima.f90 b/src/PHYEX/micro/lima.f90
index 0d912878d5add373f3c6a05af1ca4c03dd85dd6c..43e886f16530eeb67bd532ef5794ba707e5d39b0 100644
--- a/src/PHYEX/micro/lima.f90
+++ b/src/PHYEX/micro/lima.f90
@@ -4,9 +4,9 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################################################################
-SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
- PTSTEP, OELEC, &
- PRHODREF, PEXNREF, PDZZ, &
+SUBROUTINE LIMA ( D, CST, ICED, ICEP, ELECD, ELECP,BUCONF, TBUDGETS, KBUDGETS,&
+ PTSTEP, OELEC, HCLOUD, &
+ PRHODREF, PEXNREF, PDZZ,PTHVREFZIKB, &
PRHODJ, PPABST, &
NCCN, NIFN, NIMM, &
PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
@@ -50,6 +50,10 @@ SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
!* 0. DECLARATIONS
! ------------
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR_n,ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n,ONLY: RAIN_ICE_PARAM_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
NBUDGET_RI, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
USE MODD_CST, ONLY: CST_t
@@ -72,7 +76,7 @@ USE MODE_LIMA_NUCLEATION_PROCS, ONLY: LIMA_NUCLEATION_PROCS
USE MODE_LIMA_SEDIMENTATION, ONLY: LIMA_SEDIMENTATION
USE MODE_LIMA_TENDENCIES, ONLY: LIMA_TENDENCIES
!
-USE MODI_ELEC_TENDENCIES
+USE MODE_ELEC_TENDENCIES, ONLY : ELEC_TENDENCIES
!
IMPLICIT NONE
!
@@ -80,8 +84,13 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
INTEGER, INTENT(IN) :: KBUDGETS
!
REAL, INTENT(IN) :: PTSTEP ! Time step
@@ -123,11 +132,12 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFPR ! Precipitation fluxes in altitude
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLATHAM_IAGGS ! Factor for IAGGS modification due to Efield
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PLATHAM_IAGGS ! Factor for IAGGS modification due to Efield
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PEFIELDW ! Vertical component of the electric field
REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PSV_ELEC_T ! Charge density at time t
REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(INOUT) :: PSV_ELEC_S ! Charge density sources
!
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!* 0.2 Declarations of local variables :
!
!
@@ -797,12 +807,12 @@ ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
IF (NMOM_C.GE.1 .AND. LSEDC) THEN
IF (OELEC) THEN
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'L', 2, 2, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'L', 2, 2, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
ZRCS, ZCCS, PINPRC, PFPR(:,:,:,2), PEFIELDW, ZQCS)
ELSE
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'L', 2, 2, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'L', 2, 2, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
ZRCS, ZCCS, PINPRC, PFPR(:,:,:,2))
END IF
END IF
@@ -812,12 +822,12 @@ ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
IF (NMOM_R.GE.1) THEN
IF (OELEC) THEN
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'L', NMOM_R, 3, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'L', NMOM_R, 3, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB,PPABST, ZT, ZRT_SUM, ZCPT, &
ZRRS, ZCRS, PINPRR, PFPR(:,:,:,3), PEFIELDW, ZQRS)
ELSE
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'L', NMOM_R, 3, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'L', NMOM_R, 3, 1, PTSTEP, OELEC, PDZZ, PRHODREF,PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
ZRRS, ZCRS, PINPRR, PFPR(:,:,:,3))
END IF
END IF
@@ -827,12 +837,12 @@ ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
IF (NMOM_I.GE.1 .AND. LSEDI) THEN
IF (OELEC) THEN
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_I, 4, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_I, 4, 1, PTSTEP, OELEC, PDZZ, PRHODREF,PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
ZRIS, ZCIS, ZW2D, PFPR(:,:,:,4), PEFIELDW, ZQIS)
ELSE
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_I, 4, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_I, 4, 1, PTSTEP, OELEC, PDZZ, PRHODREF,PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
ZRIS, ZCIS, ZW2D, PFPR(:,:,:,4))
END IF
END IF
@@ -842,12 +852,12 @@ ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
IF (NMOM_S.GE.1) THEN
IF (OELEC) THEN
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_S, 5, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_S, 5, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
ZRSS, ZCSS, PINPRS, PFPR(:,:,:,5), PEFIELDW, ZQSS)
ELSE
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_S, 5, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_S, 5, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST,ZT, ZRT_SUM, ZCPT, &
ZRSS, ZCSS, PINPRS, PFPR(:,:,:,5))
END IF
END IF
@@ -857,12 +867,12 @@ ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
IF (NMOM_G.GE.1) THEN
IF (OELEC) THEN
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_G, 6, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_G, 6, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
ZRGS, ZCGS, PINPRG, PFPR(:,:,:,6), PEFIELDW, ZQGS)
ELSE
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_G, 6, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_G, 6, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
ZRGS, ZCGS, PINPRG, PFPR(:,:,:,6))
END IF
END IF
@@ -872,12 +882,12 @@ ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
IF (NMOM_H.GE.1) THEN
IF (OELEC) THEN
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_H, 7, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_H, 7, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
ZRHS, ZCHS, PINPRH, PFPR(:,:,:,7), PEFIELDW, ZQHS)
ELSE
- CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_H, 7, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, &
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_H, 7, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
ZRHS, ZCHS, PINPRH, PFPR(:,:,:,7))
END IF
END IF
@@ -2066,8 +2076,11 @@ IF (OELEC) THEN
! Attention, les signes des tendances ne sont pas traites de la meme facon dans ice3 et lima
! On se cale sur la facon de faire dans ice3 => on fait en sorte que les tendances soient positives
IF (NMOM_H .GE. 1) THEN
- CALL ELEC_TENDENCIES(D, KRR, IELEC, PTSTEP, GMASK_ELEC, &
- PRHODREF, PRHODJ, ZT, ZCIT_ELEC, &
+ CALL ELEC_TENDENCIES(D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, &
+ PRHODREF, PRHODJ, ZT, ZCIT_ELEC, &
ZRVT_ELEC, ZRCT_ELEC, ZRRT_ELEC, ZRIT_ELEC, ZRST_ELEC, ZRGT_ELEC, &
ZQPIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQNIT, &
ZQPIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQNIS, &
@@ -2101,7 +2114,10 @@ IF (OELEC) THEN
PRCCORR2=-ZTOT_RC_CORR2*ZINV_TSTEP, PRRCORR2=-ZTOT_RR_CORR2*ZINV_TSTEP, &
PRICORR2=-ZTOT_RI_CORR2*ZINV_TSTEP)
ELSE
- CALL ELEC_TENDENCIES(D, KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ CALL ELEC_TENDENCIES(D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, &
PRHODREF, PRHODJ, ZT, ZCIT_ELEC, &
ZRVT_ELEC, ZRCT_ELEC, ZRRT_ELEC, ZRIT_ELEC, ZRST_ELEC, ZRGT_ELEC, &
ZQPIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQNIT, &
diff --git a/src/PHYEX/micro/modd_elec_descr.f90 b/src/PHYEX/micro/modd_elec_descr.f90
index 24cdba934b55911b4d91d1a0da23427bd345a391..db6aaa9587502e2c80bc9f6eb9be30cad41dade3 100644
--- a/src/PHYEX/micro/modd_elec_descr.f90
+++ b/src/PHYEX/micro/modd_elec_descr.f90
@@ -93,7 +93,6 @@ REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XQTMIN ! Min values allowed for the
REAL, DIMENSION(:) , ALLOCATABLE :: XRTMIN_ELEC ! Limit value of R where charge is available
!
REAL :: XEPSILON ! Dielectric permittivity of air (F/m)
-REAL :: XECHARGE ! Elementary charge (C)
!
!
! parameters relative to electrification
@@ -163,6 +162,7 @@ LOGICAL :: LIAGGS_LATHAM=.FALSE. ! .T.: to enable ELEC=>MICROPHYS via
TYPE ELEC_DESCR_t
REAL :: XFC, XFR, XFI, XFS, XFG, XFH ! f_x in q_x = e_x D^f_x
REAL :: XCXR ! Exponent in the concentration-slope
+ REAL :: XECHARGE ! Elementary charge (C)
END TYPE ELEC_DESCR_t
!
TYPE(ELEC_DESCR_t), SAVE, TARGET :: ELEC_DESCR
@@ -173,7 +173,8 @@ REAL, POINTER :: XFC => NULL(), &
XFS => NULL(), &
XFG => NULL(), &
XFH => NULL(), &
- XCXR => NULL()
+ XCXR => NULL(), &
+ XECHARGE => NULL()
!
CONTAINS
!
@@ -187,6 +188,7 @@ SUBROUTINE ELEC_DESCR_ASSOCIATE()
XFG => ELEC_DESCR%XFG
XFH => ELEC_DESCR%XFH
XCXR => ELEC_DESCR%XCXR
+ XECHARGE=> ELEC_DESCR%XECHARGE
END SUBROUTINE ELEC_DESCR_ASSOCIATE
!
END MODULE MODD_ELEC_DESCR
diff --git a/src/MNH/modd_elec_param.f90 b/src/PHYEX/micro/modd_elec_param.f90
similarity index 100%
rename from src/MNH/modd_elec_param.f90
rename to src/PHYEX/micro/modd_elec_param.f90
diff --git a/src/MNH/modd_elecn.f90 b/src/PHYEX/micro/modd_elecn.f90
similarity index 100%
rename from src/MNH/modd_elecn.f90
rename to src/PHYEX/micro/modd_elecn.f90
diff --git a/src/PHYEX/micro/modd_param_lima.f90 b/src/PHYEX/micro/modd_param_lima.f90
index 3b8b56a4a5cb1476f0875babf18fcd80d250a40a..61fd573f42c169d41cb4d217e604e399ea4efe13 100644
--- a/src/PHYEX/micro/modd_param_lima.f90
+++ b/src/PHYEX/micro/modd_param_lima.f90
@@ -710,7 +710,7 @@ ENDIF
!
IF(LLCHECK) THEN
CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CPRISTINE_ICE_LIMA', CPRISTINE_ICE_LIMA, &
- 'PLAT', 'COLU', 'BURO')
+ 'PLAT', 'COLU', 'BURO','YPLA','YCOL','YBUR','YDRO','YHCO','YHBU')
CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CHEVRIMED_ICE_LIMA', CHEVRIMED_ICE_LIMA, &
'GRAU', 'HAIL')
diff --git a/src/PHYEX/micro/modd_param_lima_cold.f90 b/src/PHYEX/micro/modd_param_lima_cold.f90
index 3134e583f585419a5121808a9ac0fd302a1b9e89..cc3e3adc1e5639286c37689f9569905947dc8501 100644
--- a/src/PHYEX/micro/modd_param_lima_cold.f90
+++ b/src/PHYEX/micro/modd_param_lima_cold.f90
@@ -53,12 +53,14 @@ REAL :: XLBEXS,XLBS,XNS ! Snow/agg. distribution parameters
!
REAL :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
REAL :: XF0IS,XF1IS ! (large Di vent. coef.)
+REAL :: XDELTAI, XGAMMAI ! cloud ice area-diameter parameters
REAL :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
!
REAL :: XLBDAS_MIN, XLBDAS_MAX ! Max values allowed for the shape parameter of snow
REAL :: XFVELOS ! Wurtz - snow fall speed parameterizaed after Thompson 2008
REAL :: XTRANS_MP_GAMMAS ! Wurtz - change between lambda value for MP and gen. gamma
!
+REAL :: XREFFI ! constante for ice crystal effective radius for ecRad
!
!-------------------------------------------------------------------------------
!
@@ -146,6 +148,8 @@ REAL, POINTER :: XLBEXI => NULL(), &
XNS => NULL(), &
XAI => NULL(), &
XBI => NULL(), &
+ XGAMMAI => NULL(), &
+ XDELTAI => NULL(), &
XC_I => NULL(), &
XDI => NULL(), &
XF0I => NULL(), &
@@ -166,6 +170,7 @@ REAL, POINTER :: XLBEXI => NULL(), &
XLBDAS_MAX => NULL(), &
XFVELOS => NULL(), &
XTRANS_MP_GAMMAS => NULL(), &
+ XREFFI => NULL(), &
XFSEDRI => NULL(), &
XFSEDCI => NULL(), &
XFSEDRS => NULL(), &
@@ -286,6 +291,8 @@ IF(.NOT. ASSOCIATED(XLBEXI)) THEN
XNS => PARAM_LIMA_COLD%XNS
XAI => PARAM_LIMA_COLD%XAI
XBI => PARAM_LIMA_COLD%XBI
+ XGAMMAI => PARAM_LIMA_COLD%XGAMMAI
+ XDELTAI => PARAM_LIMA_COLD%XDELTAI
XC_I => PARAM_LIMA_COLD%XC_I
XDI => PARAM_LIMA_COLD%XDI
XF0I => PARAM_LIMA_COLD%XF0I
@@ -306,6 +313,7 @@ IF(.NOT. ASSOCIATED(XLBEXI)) THEN
XLBDAS_MAX => PARAM_LIMA_COLD%XLBDAS_MAX
XFVELOS => PARAM_LIMA_COLD%XFVELOS
XTRANS_MP_GAMMAS => PARAM_LIMA_COLD%XTRANS_MP_GAMMAS
+ XREFFI => PARAM_LIMA_COLD%XREFFI
XFSEDRI => PARAM_LIMA_COLD%XFSEDRI
XFSEDCI => PARAM_LIMA_COLD%XFSEDCI
XFSEDRS => PARAM_LIMA_COLD%XFSEDRS
diff --git a/src/MNH/compute_lambda.f90 b/src/PHYEX/micro/mode_compute_lambda.f90
similarity index 82%
rename from src/MNH/compute_lambda.f90
rename to src/PHYEX/micro/mode_compute_lambda.f90
index e2d085cb0ac4b7ef4e7eb4ec112be34d7351b737..ba45978ba3a82791b61a1f6449a501372d1eca5c 100644
--- a/src/MNH/compute_lambda.f90
+++ b/src/PHYEX/micro/mode_compute_lambda.f90
@@ -5,29 +5,13 @@
!-----------------------------------------------------------------
!
! ##########################
- MODULE MODI_COMPUTE_LAMBDA
+ MODULE MODE_COMPUTE_LAMBDA
! ##########################
-!
-INTERFACE
- SUBROUTINE COMPUTE_LAMBDA (KID, KMOMENT, KSIZE, &
- PRHO, PRTMIN, PRX, PCX, PLBDX)
-!
-INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
-INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
-INTEGER, INTENT(IN) :: KSIZE
-REAL, INTENT(IN) :: PRTMIN
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHO ! reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRX ! Mixing ratio
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCX ! Nb concentration
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PLBDX ! Slope parameter of the distribution
-!
-END SUBROUTINE COMPUTE_LAMBDA
-END INTERFACE
-END MODULE MODI_COMPUTE_LAMBDA
-!
+IMPLICIT NONE
+CONTAINS
!
! #########################################################
- SUBROUTINE COMPUTE_LAMBDA (KID, KMOMENT, KSIZE, &
+ SUBROUTINE COMPUTE_LAMBDA (KID, KMOMENT, KSIZE, HCLOUD, &
PRHO, PRTMIN, PRX, PCX, PLBDX)
! #########################################################
!
@@ -49,7 +33,6 @@ END MODULE MODI_COMPUTE_LAMBDA
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_n, ONLY: CCLOUD
USE MODD_RAIN_ICE_DESCR_n, ONLY: XLBC_I=>XLBC, XLBR_I=>XLBR, XLBI_I=>XLBI, XLBS_I=>XLBS, XLBG_I=>XLBG, XLBH_I=>XLBH, &
XLBEXC_I=>XLBEXC, XLBEXR_I=>XLBEXR, XLBEXI_I=>XLBEXI, XLBEXS_I=>XLBEXS, &
XLBEXG_I=>XLBEXG, XLBEXH_I=>XLBEXH, &
@@ -72,6 +55,7 @@ IMPLICIT NONE
!* 0.1 Declaration of dummy arguments
!
INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
INTEGER, INTENT(IN) :: KSIZE
REAL, INTENT(IN) :: PRTMIN
@@ -92,21 +76,21 @@ REAL :: ZRTMIN, ZLBX, ZLBEX, ZLBDAX_MAX, ZCCX, ZCXX
ZRTMIN = PRTMIN
!
IF (KID == 2) THEN
- IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
ZLBX = XLBC_L
ZLBEX = XLBEXC_L
! ELSE
! print*, 'ERROR: the computation of lambda_c is not available if c is 1-moment species'
END IF
ELSE IF (KID == 3) THEN
- IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
ZLBX = XLBR_L
ZLBEX = XLBEXR_L
IF (KMOMENT == 1) THEN
ZCCX = XCCR_L
ZCXX = XCXR_L
END IF
- ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
ZLBX = XLBR_I
ZLBEX = XLBEXR_I
ZCCX = XCCR_I
@@ -115,17 +99,17 @@ ELSE IF (KID == 3) THEN
PRINT*, 'ERROR: something wrong with the computation of lambda_r'
END IF
ELSE IF (KID == 4) THEN
- IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
ZLBX = XLBI_L
ZLBEX = XLBEXI_L
- ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
ZLBX = XLBI_I
ZLBEX = XLBEXI_I
ELSE
PRINT*, 'ERROR: something wrong with the computation of lambda_i'
END IF
ELSE IF (KID == 5) THEN
- IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
ZLBX = XLBS_L
ZLBEX = XLBEXS_L
ZLBDAX_MAX = XLBDAS_MAX_L
@@ -133,7 +117,7 @@ ELSE IF (KID == 5) THEN
ZCCX = XCCS_L
ZCXX = XCXS_L
END IF
- ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
ZLBX = XLBS_I
ZLBEX = XLBEXS_I
ZLBDAX_MAX = XLBDAS_MAX_I
@@ -143,14 +127,14 @@ ELSE IF (KID == 5) THEN
PRINT*, 'ERROR: something wrong with the computation of lambda_s'
END IF
ELSE IF (KID == 6) THEN
- IF (CCLOUD == 'LIMA') THEN ! .AND. KMOMENT == 1) THEN
+ IF (HCLOUD == 'LIMA') THEN ! .AND. KMOMENT == 1) THEN
ZLBX = XLBG_L
ZLBEX = XLBEXG_L
IF (KMOMENT == 1) THEN
ZCCX = XCCG_L
ZCXX = XCXG_L
END IF
- ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
ZLBX = XLBG_I
ZLBEX = XLBEXG_I
ZCCX = XCCG_I
@@ -159,14 +143,14 @@ ELSE IF (KID == 6) THEN
PRINT*, 'ERROR: something wrong with the computation of lambda_g'
END IF
ELSE IF (KID == 7) THEN
- IF (CCLOUD == 'LIMA') THEN ! .AND. KMOMENT == 1) THEN
+ IF (HCLOUD == 'LIMA') THEN ! .AND. KMOMENT == 1) THEN
ZLBX = XLBH_L
ZLBEX = XLBEXH_L
IF (KMOMENT == 1) THEN
ZCCX = XCCH_L
ZCXX = XCXH_L
END IF
- ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
ZLBX = XLBH_I
ZLBEX = XLBEXH_I
ZCCX = XCCH_I
@@ -227,3 +211,4 @@ ELSE IF (KMOMENT == 1) THEN
END IF
!
END SUBROUTINE COMPUTE_LAMBDA
+END MODULE MODE_COMPUTE_LAMBDA
diff --git a/src/MNH/mode_elec_beard_effect.f90 b/src/PHYEX/micro/mode_elec_beard_effect.f90
similarity index 82%
rename from src/MNH/mode_elec_beard_effect.f90
rename to src/PHYEX/micro/mode_elec_beard_effect.f90
index dfbcd7cd1230816e05d769a659f745794484d001..b7f8f94fc75236c9da3c572e50a0036946801a87 100644
--- a/src/MNH/mode_elec_beard_effect.f90
+++ b/src/PHYEX/micro/mode_elec_beard_effect.f90
@@ -10,7 +10,7 @@ IMPLICIT NONE
CONTAINS
!
! ###################################################################
- SUBROUTINE ELEC_BEARD_EFFECT(D, KID, OSEDIM, PT, PRHODREF, &
+ SUBROUTINE ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KID, OSEDIM, PT, PRHODREF, PTHVREFZIKB, &
PRX, PQX, PEFIELDW, PLBDA, PBEARDCOEF)
! ####################################################################
!
@@ -42,10 +42,11 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XG, XRD, XP00, XTT
+USE MODD_CST, ONLY: CST_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+
USE MODD_ELEC_DESCR, ONLY: XRTMIN_ELEC
-USE MODD_PARAMETERS, ONLY: JPVEXT
USE MODD_PARAM_LIMA, ONLY: XALPHAC_L=>XALPHAC, XNUC_L=>XNUC, XALPHAR_L=>XALPHAR, XNUR_L=>XNUR, &
XALPHAI_L=>XALPHAI, XNUI_L=>XNUI, XALPHAS_L=>XALPHAS, XNUS_L=>XNUS, &
XALPHAG_L=>XALPHAG, XNUG_L=>XNUG, &
@@ -57,28 +58,16 @@ USE MODD_PARAM_LIMA_MIXED,ONLY: XBG_L=>XBG, XCG_L=>XCG, XDG_L=>XDG, &
XALPHAH_L=>XALPHAH, XNUH_L=>XNUH
USE MODD_PARAM_LIMA_WARM, ONLY: XBR_L=>XBR, XCR_L=>XCR, XDR_L=>XDR, &
XBC_L=>XBC, XCC_L=>XCC, XDC_L=>XDC
-USE MODD_PARAM_n, ONLY: CCLOUD
-USE MODD_RAIN_ICE_DESCR_n,ONLY: XALPHAC_I=>XALPHAC, XNUC_I=>XNUC, XALPHAR_I=>XALPHAR, XNUR_I=>XNUR, &
- XALPHAI_I=>XALPHAI, XNUI_I=>XNUI, XALPHAS_I=>XALPHAS, XNUS_I=>XNUS, &
- XALPHAG_I=>XALPHAG, XNUG_I=>XNUG, XALPHAH_I=>XALPHAH, XNUH_I=>XNUH, &
- XBC_I=>XBC, XCC_I=>XCC, XDC_I=>XDC, &
- XBR_I=>XBR, XCR_I=>XCR, XDR_I=>XDR, &
- XBI_I=>XBI, XC_I_I=>XC_I, XDI_I=>XDI, &
- XBS_I=>XBS, XCS_I=>XCS, XDS_I=>XDS, &
- XBG_I=>XBG, XCG_I=>XCG, XDG_I=>XDG, &
- XBH_I=>XBH, XCH_I=>XCH, XDH_I=>XDH, &
- XCEXVT_I=>XCEXVT
-USE MODD_REF, ONLY: XTHVREFZ
!
USE MODI_MOMG
!
-USE MODE_TOOLS_ll, ONLY: GET_INDICE_ll
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
LOGICAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: OSEDIM ! if T, compute the sedim. proc.
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! Reference density
@@ -88,7 +77,9 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PQX ! Elec. charge de
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEFIELDW ! Vertical component of the electric field
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLBDA ! Slope param. of the distribution
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PBEARDCOEF ! Beard coefficient
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
!
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!* 0.2 Declarations of local variables
!
INTEGER :: JIJ, JK ! loop indexes
@@ -106,6 +97,19 @@ real, dimension(D%NIJT,D%NKT) :: zreynolds
!
!-------------------------------------------------------------------------------
!
+
+ASSOCIATE(XALPHAC_I=>ICED%XALPHAC, XNUC_I=>ICED%XNUC, XALPHAR_I=>ICED%XALPHAR, XNUR_I=>ICED%XNUR, &
+ XALPHAI_I=>ICED%XALPHAI, XNUI_I=>ICED%XNUI, XALPHAS_I=>ICED%XALPHAS, XNUS_I=>ICED%XNUS, &
+ XALPHAG_I=>ICED%XALPHAG, XNUG_I=>ICED%XNUG, XALPHAH_I=>ICED%XALPHAH, XNUH_I=>ICED%XNUH, &
+ XBC_I=>ICED%XBC, XCC_I=>ICED%XCC, XDC_I=>ICED%XDC, &
+ XBR_I=>ICED%XBR, XCR_I=>ICED%XCR, XDR_I=>ICED%XDR, &
+ XBI_I=>ICED%XBI, XC_I_I=>ICED%XC_I, XDI_I=>ICED%XDI, &
+ XBS_I=>ICED%XBS, XCS_I=>ICED%XCS, XDS_I=>ICED%XDS, &
+ XBG_I=>ICED%XBG, XCG_I=>ICED%XCG, XDG_I=>ICED%XDG, &
+ XBH_I=>ICED%XBH, XCH_I=>ICED%XCH, XDH_I=>ICED%XDH, &
+ XCEXVT_I=>ICED%XCEXVT)
+
+
!* 1. COMPUTE USEFULL PARAMETERS
! --------------------------
!
@@ -117,7 +121,7 @@ IIJE = D%NIJE
!* 1.1 Select the right parameters
! --> depend on the microphysics scheme and the hydrometeor species
!
-IF (CCLOUD(1:3) == 'ICE') THEN
+IF (HCLOUD(1:3) == 'ICE') THEN
ZCEXVT = XCEXVT_I
!
IF (KID == 2) THEN
@@ -158,7 +162,7 @@ IF (CCLOUD(1:3) == 'ICE') THEN
ZALPHAX = XALPHAH_I
ZNUX = XNUH_I
END IF
-ELSE IF (CCLOUD == 'LIMA') THEN
+ELSE IF (HCLOUD == 'LIMA') THEN
ZCEXVT = XCEXVT_L
!
IF (KID == 2) THEN
@@ -204,9 +208,9 @@ END IF
!* 1.2 Parameters from Table 1 in Beard (1980)
!
! Reference value of the dynamic viscosity of air
-ZETA0 = (1.718E-5 + 0.0049E-5 * (XTHVREFZ(IKTB) - XTT))
+ZETA0 = (1.718E-5 + 0.0049E-5 * (PTHVREFZIKB - CST%XTT))
!
-ZRHO00 = XP00 / (XRD * XTHVREFZ(IKTB))
+ZRHO00 = CST%XP00 / (CST%XRD * PTHVREFZIKB)
ZCOR00 = ZRHO00**ZCEXVT
!
! (rho_0 / eta_0) * (v * lambda^d)
@@ -228,7 +232,7 @@ DO JK = IKTB, IKTE
IF (OSEDIM(JIJ,JK) .AND. PRX(JIJ,JK) .GT. XRTMIN_ELEC(KID) .AND. PLBDA(JIJ,JK) .GT. 0.) THEN
!--cb--
! Temperature K --> C
- ZT = PT(JIJ,JK) - XTT
+ ZT = PT(JIJ,JK) - CST%XTT
!
! Pre-factor of f_0
IF (ZT >= 0.0) THEN
@@ -241,7 +245,7 @@ DO JK = IKTB, IKTE
ZF1 = SQRT(ZRHO00/PRHODREF(JIJ,JK))
!
! compute (1 - K) = 1 - qE/mg
- ZK = 1. - PQX(JIJ,JK) * PEFIELDW(JIJ,JK) / (PRX(JIJ,JK) * XG)
+ ZK = 1. - PQX(JIJ,JK) * PEFIELDW(JIJ,JK) / (PRX(JIJ,JK) * CST%XG)
!
! Hyp : K_0 ~ 0
! Hyp : si qE > mg, K > 1
@@ -270,6 +274,7 @@ DO JK = IKTB, IKTE
END DO
END DO
!
+END ASSOCIATE
!-------------------------------------------------------------------------------
!
END SUBROUTINE ELEC_BEARD_EFFECT
diff --git a/src/MNH/elec_compute_ex.f90 b/src/PHYEX/micro/mode_elec_compute_ex.f90
similarity index 72%
rename from src/MNH/elec_compute_ex.f90
rename to src/PHYEX/micro/mode_elec_compute_ex.f90
index af16313c509489393cc3b7fb7fb15f141f7c0e84..7f0977cef7411fe7ba0b8c19ae470b1647e26bf7 100644
--- a/src/MNH/elec_compute_ex.f90
+++ b/src/PHYEX/micro/mode_elec_compute_ex.f90
@@ -5,34 +5,14 @@
!-----------------------------------------------------------------
!
! ###########################
- MODULE MODI_ELEC_COMPUTE_EX
+ MODULE MODE_ELEC_COMPUTE_EX
! ###########################
-!
-INTERFACE
- SUBROUTINE ELEC_COMPUTE_EX (KID, KMOMENT, KSIZE, &
- PDUM, PRHO, PRTMIN, &
- PRX, PQX, PEX, PLBDX, PCX)
-!
-INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
-INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
-INTEGER, INTENT(IN) :: KSIZE
-REAL, INTENT(IN) :: PDUM ! =1. if mixing ratio
- ! =timestep if source
-REAL, INTENT(IN) :: PRTMIN
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHO ! reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PQX ! Electric charge
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRX ! Mixing ratio
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PEX ! e coef of the q-D relation
-REAL, DIMENSION(KSIZE), OPTIONAL, INTENT(IN) :: PLBDX ! Slope parameter of the distribution
-REAL, DIMENSION(KSIZE), OPTIONAL, INTENT(IN) :: PCX ! Nb concentration
-!
-END SUBROUTINE ELEC_COMPUTE_EX
-END INTERFACE
-END MODULE MODI_ELEC_COMPUTE_EX
+IMPLICIT NONE
+CONTAINS
!
!
! #######################################################
- SUBROUTINE ELEC_COMPUTE_EX (KID, KMOMENT, KSIZE, &
+ SUBROUTINE ELEC_COMPUTE_EX (KID, KMOMENT, KSIZE,HCLOUD, &
PDUM, PRHO, PRTMIN, &
PRX, PQX, PEX, PLBDX, PCX )
! #######################################################
@@ -53,7 +33,6 @@ END MODULE MODI_ELEC_COMPUTE_EX
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_n, ONLY : CCLOUD
USE MODD_ELEC_PARAM, ONLY : XECMAX, XERMAX, XEIMAX, XESMAX, XEGMAX, XEHMAX, &
XFQUPDC, XFQUPDR, XFQUPDI, XEXFQUPDI, XFQUPDS, XFQUPDG, XFQUPDH
USE MODD_ELEC_DESCR, ONLY : XCXR, XFC, XFR, XFI, XFS, XFG, XFH
@@ -81,6 +60,7 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRX ! Mixing ratio
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PEX ! e coef of the q-D relation
REAL, DIMENSION(KSIZE), OPTIONAL, INTENT(IN) :: PLBDX ! Slope parameter of the distribution
REAL, DIMENSION(KSIZE), OPTIONAL, INTENT(IN) :: PCX ! Nb concentration
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
!
!* 0.2 Declaration of local variables
!
@@ -97,8 +77,8 @@ PEX(:) = 0.
IF (KID == 2) THEN ! parameters for cloud droplets
ZFX = XFC
ZEXMAX = XECMAX
- IF (CCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDC
- IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDC
+ IF (HCLOUD == 'LIMA') THEN
ZALPHAX = XALPHAC
ZNUX = XNUC
END IF
@@ -106,16 +86,16 @@ ELSE IF (KID == 3) THEN ! parameters for raindrops
ZFX = XFR
ZCX = XCXR
ZEXMAX = XERMAX
- IF (CCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDR
- IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ IF (HCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDR
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
ZALPHAX = XALPHAR
ZNUX = XNUR
END IF
ELSE IF (KID == 4) THEN ! parameters for ice crystals
ZFX = XFI
ZEXMAX = XEIMAX
- IF (CCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDI
- IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ IF (HCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDI
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
ZALPHAX = XALPHAI
ZNUX = XNUI
END IF
@@ -123,41 +103,41 @@ ELSE IF (KID == 5) THEN ! parameters for snow/aggregates
ZFX = XFS
ZEXMAX = XESMAX
ZFQUPDX = XFQUPDS
- IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
ZALPHAX = XALPHAS
ZNUX = XNUS
- ELSE IF (CCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ELSE IF (HCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
ZCX = XCXS_L
- ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
ZCX = XCXS_I
END IF
ELSE IF (KID == 6) THEN ! parameters for graupel
ZFX = XFG
ZEXMAX = XEGMAX
ZFQUPDX = XFQUPDG
- IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
ZALPHAX = XALPHAG
ZNUX = XNUG
- ELSE IF (CCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ELSE IF (HCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
ZCX = XCXG_L
- ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
ZCX = XCXG_I
END IF
ELSE IF (KID == 7) THEN ! parameters for hail
ZFX = XFH
ZEXMAX = XEHMAX
ZFQUPDX = XFQUPDH
- IF (CCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
ZALPHAX = XALPHAH
ZNUX = XNUH
- ELSE IF (CCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ELSE IF (HCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
ZCX = XCXH_L
- ELSE IF (CCLOUD(1:3) == 'ICE') THEN
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
ZCX = XCXH_I
END IF
END IF
!
-IF (CCLOUD == 'LIMA') THEN
+IF (HCLOUD == 'LIMA') THEN
IF (KID == 2) THEN
ZALPHAX = XALPHAC
ZNUX = XNUC
@@ -223,4 +203,4 @@ ELSE IF (KMOMENT == 1) THEN
END IF
!
END SUBROUTINE ELEC_COMPUTE_EX
-
+END MODULE MODE_ELEC_COMPUTE_EX
diff --git a/src/MNH/elec_tendencies.f90 b/src/PHYEX/micro/mode_elec_tendencies.f90
similarity index 81%
rename from src/MNH/elec_tendencies.f90
rename to src/PHYEX/micro/mode_elec_tendencies.f90
index 0f16543127b550aedbed33b28cdf2f954dba7105..af2a62376f1ebd296ca6c3b46f9d88c76e7a74ce 100644
--- a/src/MNH/elec_tendencies.f90
+++ b/src/PHYEX/micro/mode_elec_tendencies.f90
@@ -3,133 +3,16 @@
!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_ELEC_TENDENCIES
-! ###########################
-!
-INTERFACE
- SUBROUTINE ELEC_TENDENCIES (D, KRR, KMICRO, PTSTEP, ODMICRO, &
- PRHODREF, PRHODJ, PZT, PCIT, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
- PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
- PRVHENI, PRRHONG, PRIMLTC, &
- PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
- PRCAUTR, PRCACCR, PRREVAV, &
- PRCRIMSS, PRCRIMSG, PRSRIMCG, PRRACCSS, PRRACCSG, PRSACCRG, &
- PRSMLTG, PRICFRRG, PRRCFRIG, &
- PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
- PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, &
- PRGMLTR, PRCBERI, &
- PRCMLTSR, PRICFRR, & !- opt. param. for ICE3
- PCCT, PCRT, PCST, PCGT, & !-- optional
- PRVHENC, PRCHINC, PRVHONH, & !| parameters
- PRRCVRC, PRICNVI, PRVDEPI, PRSHMSI, PRGHMGI, & !| for
- PRICIBU, PRIRDSF, & !| LIMA
- PRCCORR2, PRRCORR2, PRICORR2, & !--
- PRWETGH, PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & !-- optional
- PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, & !| parameters
- PRHMLTR, PRDRYHG, & !| for
- PRHT, PRHS, PCHT, PQHT, PQHS) !-- hail
-!
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
-!
-INTEGER, INTENT(IN) :: KMICRO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-!
-LOGICAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
-!
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZT ! Temperature (K)
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
-!
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQPIT ! Positive ion (Nb/kg) at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQNIT ! Negative ion (Nb/kg) at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQCT ! Cloud water charge at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQRT ! Raindrops charge at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQIT ! Pristine ice charge at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQST ! Snow/aggregates charge at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQGT ! Graupel charge at t
-!
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQPIS ! Positive ion (Nb/kg) source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQNIS ! Negative ion (Nb/kg) source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQCS ! Cloud water charge source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQRS ! Raindrops charge source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQIS ! Pristine ice charge source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQSS ! Snow/aggregates charge source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQGS ! Graupel charge source
-!
-! microphysics rates common to ICE3 and LIMA
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRVHENI, & ! heterogeneous nucleation mixing ratio change (HIND for LIMA)
- PRCHONI, & ! Homogeneous nucleation
- PRRHONG, & ! Spontaneous freezing mixing ratio change
- PRVDEPS, & ! Deposition on r_s,
- PRIAGGS, & ! Aggregation on r_s
- PRIAUTS, & ! Autoconversion of r_i for r_s production (CNVS for LIMA)
- PRVDEPG, & ! Deposition on r_g
- PRCAUTR, & ! Autoconversion of r_c for r_r production
- PRCACCR, & ! Accretion of r_c for r_r production
- PRREVAV, & ! Evaporation of r_r
- PRIMLTC, & ! Cloud ice melting mixing ratio change
- PRCBERI, & ! Bergeron-Findeisen effect
- PRSMLTG, & ! Conversion-Melting of the aggregates
- PRRACCSS, PRRACCSG, PRSACCRG, & ! Rain accretion onto the aggregates
- PRCRIMSS, PRCRIMSG, PRSRIMCG, & ! Cloud droplet riming of the aggregates
- PRICFRRG, PRRCFRIG, & ! Rain contact freezing
- PRCWETG, PRIWETG, PRRWETG, PRSWETG, & ! Graupel wet growth
- PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, & ! Graupel dry growth
- PRGMLTR ! Melting of the graupel
-! microphysics rates specific to ICE3 (knmoments==1)
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRCMLTSR,& ! Cld droplet collection onto aggregates by pos. temp.
- PRICFRR ! Rain contact freezing (part of ice crystals converted to rain)
-! microphysics rates specific to LIMA (knmoments==2)
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRVHENC, & ! Cld droplet formation
- PRCHINC, & ! Heterogeneous nucleation of coated IFN
- PRVHONH, & ! Nucleation of haze
- PRRCVRC, & ! Conversion of small drops into droplets
- PRICNVI, & ! Conversion snow --> ice
- PRVDEPI, & ! Deposition on r_i
- PRSHMSI, PRGHMGI, & ! Hallett Mossop for snow and graupel
- PRICIBU, & ! Collisional ice breakup
- PRIRDSF, & ! Raindrop shattering by freezing
- PRCCORR2, PRRCORR2, PRICORR2 ! Correction inside LIMA splitting
-! microphysics rates related to hail (krr == 7, lhail = .t.)
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRWETGH, & ! Conversion of graupel into hail
- PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & ! Dry growth of hail
- PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, & ! Wet growth of hail
- PRHMLTR, & ! Melting of hail
- PRDRYHG ! Conversion of hail into graupel
-!
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCCT ! Cloud droplets conc. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCRT ! Raindrops conc. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCST ! Snow conc. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCGT ! Graupel conc. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCHT ! Hail conc. at t
-!
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PQHT ! Hail charge at t
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail charge source
-!
-END SUBROUTINE ELEC_TENDENCIES
-END INTERFACE
-END MODULE MODI_ELEC_TENDENCIES
+MODULE MODE_ELEC_TENDENCIES
!
+IMPLICIT NONE
+CONTAINS
!
! #########################################################################################
- SUBROUTINE ELEC_TENDENCIES (D, KRR, KMICRO, PTSTEP, ODMICRO, &
+ SUBROUTINE ELEC_TENDENCIES (D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, KMICRO, PTSTEP, ODMICRO, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, &
PRHODREF, PRHODJ, PZT, PCIT, &
PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
@@ -157,7 +40,7 @@ END MODULE MODI_ELEC_TENDENCIES
!!**** * - compute the explicit cloud electrification sources
!!
!! This routine is adapted from rain_ice_elec.f90.
-!! To avoid duplicated routines, the cloud electrification routine is now called
+!! To avoid duplicated routines, the cloud electrification routine is now CALLed
!! at the end of the microphysics scheme but needs the microphysical tendencies as arguments.
!! The sedimentation source for electric charges is treated separately.
!!
@@ -180,24 +63,18 @@ END MODULE MODI_ELEC_TENDENCIES
!* 0. DECLARATIONS
! ------------
!
-use modd_budget, only: lbu_enable, &
- lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
- lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
- NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
- tbudgets
-!
-USE MODD_CONF
-USE MODD_CST
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_ELEC_DESCR
+USE MODD_BUDGET, ONLY: NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ TBUDGETDATA, TBUDGETCONF_t
+!
+USE MODD_CST, ONLY: CST_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_PARAM
USE MODD_ELEC_n
-USE MODD_ELEC_PARAM
-USE MODD_LES
-USE MODE_ll
-USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND ! Scalar variables for budgets
-USE MODD_PARAMETERS
-USE MODD_PARAM_ICE_n
USE MODD_PARAM_LIMA, ONLY: XALPHAI_L=>XALPHAI, XNUI_L=>XNUI, &
XCEXVT_L=>XCEXVT, XRTMIN_L=>XRTMIN, &
LCIBU, LRDSF, &
@@ -218,35 +95,15 @@ USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L=>XDG, XCXG_L=>XCXG,
XDRYINTP1S_L=>XDRYINTP1S, XDRYINTP2S_L=>XDRYINTP2S, &
XDRYINTP1G_L=>XDRYINTP1G, XDRYINTP2G_L=>XDRYINTP2G, &
XRIMINTP1_L=>XRIMINTP1, XRIMINTP2_L=>XRIMINTP2
-
-USE MODD_PARAM_n, ONLY: CCLOUD
-USE MODD_RAIN_ICE_DESCR_n,ONLY: XCEXVT_I=>XCEXVT, XRTMIN_I=>XRTMIN, &
- XALPHAI_I=>XALPHAI, XNUI_I=>XNUI, XAI_I=>XAI, XBI_I=>XBI, &
- XDS_I=>XDS, XDG_I=>XDG, &
- XCXS_I=>XCXS, XCXG_I=>XCXG
-USE MODD_RAIN_ICE_PARAM_n,ONLY: XCOLIS_I=>XCOLIS, XCOLEXIS_I=>XCOLEXIS, &
- XCOLIG_I=>XCOLIG, XCOLEXIG_I=>XCOLEXIG, &
- XCOLSG_I=>XCOLSG, XCOLEXSG_I=>XCOLEXSG, &
- NGAMINC_I=>NGAMINC, &
- NACCLBDAR_I=>NACCLBDAR, NACCLBDAS_I=>NACCLBDAS, &
- XACCINTP1S_I=>XACCINTP1S, XACCINTP2S_I=>XACCINTP2S, &
- XACCINTP1R_I=>XACCINTP1R, XACCINTP2R_I=>XACCINTP2R, &
- NDRYLBDAR_I=>NDRYLBDAR, NDRYLBDAS_I=>NDRYLBDAS, &
- NDRYLBDAG_I=>NDRYLBDAG, &
- XDRYINTP1R_I=>XDRYINTP1R, XDRYINTP2R_I=>XDRYINTP2R, &
- XDRYINTP1S_I=>XDRYINTP1S, XDRYINTP2S_I=>XDRYINTP2S, &
- XDRYINTP1G_I=>XDRYINTP1G, XDRYINTP2G_I=>XDRYINTP2G, &
- XRIMINTP1_I=>XRIMINTP1, XRIMINTP2_I=>XRIMINTP2
-USE MODD_REF, ONLY: XTHVREFZ
-!
-#ifdef MNH_PGI
-USE MODE_PACK_PGI
-#endif
+!
+!#ifdef MNH_PGI
+!USE MODE_PACK_PGI
+!#endif
use mode_tools, only: Countjv
-use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
!
-USE MODI_COMPUTE_LAMBDA
-USE MODI_ELEC_COMPUTE_EX
+USE MODE_COMPUTE_LAMBDA, ONLY: COMPUTE_LAMBDA
+USE MODE_ELEC_COMPUTE_EX,ONLY: ELEC_COMPUTE_EX
USE MODI_MOMG
!
IMPLICIT NONE
@@ -254,7 +111,15 @@ IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF ! budget structure
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS),INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
!
INTEGER, INTENT(IN) :: KMICRO
REAL, INTENT(IN) :: PTSTEP ! Double Time step
@@ -262,6 +127,7 @@ REAL, INTENT(IN) :: PTSTEP ! Double Time ste
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
!
LOGICAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
!
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
@@ -342,6 +208,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PQHT ! Hail charge at t
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail charge source
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!
!
!* 0.2 Declaration of local variables
@@ -486,6 +353,23 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZRCMLTSR, ZRICFRR, ZRVHENC, ZRCHINC, ZRVHONH,
ZRGDRYH, ZRHMLTR, ZRDRYHG
!
!------------------------------------------------------------------
+ASSOCIATE(XCEXVT_I=>ICED%XCEXVT, XRTMIN_I=>ICED%XRTMIN, &
+ XALPHAI_I=>ICED%XALPHAI, XNUI_I=>ICED%XNUI, XAI_I=>ICED%XAI, XBI_I=>ICED%XBI, &
+ XDS_I=>ICED%XDS, XDG_I=>ICED%XDG, &
+ XCXS_I=>ICED%XCXS, XCXG_I=>ICED%XCXG, &
+ XCOLIS_I=>ICEP%XCOLIS, XCOLEXIS_I=>ICEP%XCOLEXIS, &
+ XCOLIG_I=>ICEP%XCOLIG, XCOLEXIG_I=>ICEP%XCOLEXIG, &
+ XCOLSG_I=>ICEP%XCOLSG, XCOLEXSG_I=>ICEP%XCOLEXSG, &
+ NGAMINC_I=>ICEP%NGAMINC, &
+ NACCLBDAR_I=>ICEP%NACCLBDAR, NACCLBDAS_I=>ICEP%NACCLBDAS, &
+ XACCINTP1S_I=>ICEP%XACCINTP1S, XACCINTP2S_I=>ICEP%XACCINTP2S, &
+ XACCINTP1R_I=>ICEP%XACCINTP1R, XACCINTP2R_I=>ICEP%XACCINTP2R, &
+ NDRYLBDAR_I=>ICEP%NDRYLBDAR, NDRYLBDAS_I=>ICEP%NDRYLBDAS, &
+ NDRYLBDAG_I=>ICEP%NDRYLBDAG, &
+ XDRYINTP1R_I=>ICEP%XDRYINTP1R, XDRYINTP2R_I=>ICEP%XDRYINTP2R, &
+ XDRYINTP1S_I=>ICEP%XDRYINTP1S, XDRYINTP2S_I=>ICEP%XDRYINTP2S, &
+ XDRYINTP1G_I=>ICEP%XDRYINTP1G, XDRYINTP2G_I=>ICEP%XDRYINTP2G, &
+ XRIMINTP1_I=>ICEP%XRIMINTP1, XRIMINTP2_I=>ICEP%XRIMINTP2 )
!
!* 1. INITIALIZATIONS
! ---------------
@@ -502,7 +386,7 @@ IKE = D%NKE
!
!* 1.2 select parameters between ICEx and LIMA
!
-IF (CCLOUD(1:3) == 'ICE') THEN
+IF (HCLOUD(1:3) == 'ICE') THEN
ZCEXVT = XCEXVT_I
IMOM_C = 1
IMOM_R = 1
@@ -514,7 +398,7 @@ IF (CCLOUD(1:3) == 'ICE') THEN
ELSE
IMOM_H = 0
END IF
-ELSE IF (CCLOUD == 'LIMA') THEN
+ELSE IF (HCLOUD == 'LIMA') THEN
ZCEXVT = XCEXVT_L
IMOM_C = NMOM_C
IMOM_R = NMOM_R
@@ -524,7 +408,7 @@ ELSE IF (CCLOUD == 'LIMA') THEN
IMOM_H = NMOM_H
END IF
!
-ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
+ZRHO00 = CST%XP00 / (CST%XRD * PTHVREFZIKB)
ZCOR00 = ZRHO00**ZCEXVT
!
IF (LINDUCTIVE) ALLOCATE (ZEFIELDW(KMICRO))
@@ -539,11 +423,11 @@ IF (KMICRO >= 0) THEN
IMICRO = COUNTJV(ODMICRO(:,:,:), II1(:), II2(:), II3(:))
!
! some microphysical tendencies are optional: the corresponding 1D arrays must be allocated
- IF (CCLOUD(1:3) == 'ICE') THEN ! ICE3 scheme
+ IF (HCLOUD(1:3) == 'ICE') THEN ! ICE3 scheme
ALLOCATE(ZRCMLTSR(IMICRO))
ALLOCATE(ZRICFRR(IMICRO))
END IF
- IF (CCLOUD == 'LIMA') THEN ! LIMA scheme
+ IF (HCLOUD == 'LIMA') THEN ! LIMA scheme
ALLOCATE(ZRVHENC(IMICRO))
ALLOCATE(ZRCHINC(IMICRO))
ALLOCATE(ZRVHONH(IMICRO))
@@ -651,11 +535,11 @@ IF (KMICRO >= 0) THEN
ZRSDRYG(JL) = PRSDRYG(II1(JL), II2(JL), II3(JL))
ZRGMLTR(JL) = PRGMLTR(II1(JL), II2(JL), II3(JL))
ZRCBERI(JL) = PRCBERI(II1(JL), II2(JL), II3(JL))
- IF (CCLOUD(1:3) == 'ICE') THEN
+ IF (HCLOUD(1:3) == 'ICE') THEN
ZRCMLTSR(JL) = PRCMLTSR(II1(JL), II2(JL), II3(JL))
ZRICFRR(JL) = PRICFRR(II1(JL), II2(JL), II3(JL))
END IF
- IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
ZCST(JL) = PCST(II1(JL), II2(JL), II3(JL))
ZCGT(JL) = PCGT(II1(JL), II2(JL), II3(JL))
ZRVHENC(JL) = PRVHENC(II1(JL), II2(JL), II3(JL))
@@ -751,7 +635,7 @@ IF (KMICRO >= 0) THEN
!* 1.5 select parameters between ICEx and LIMA
!
ALLOCATE(ZRTMIN(KRR))
- IF (CCLOUD(1:3) == 'ICE') THEN
+ IF (HCLOUD(1:3) == 'ICE') THEN
! in ini_rain_ice, xrtmin is initialized with dimension 6 (hail not activated) or 7 (hail activated)
ZRTMIN(1:KRR) = XRTMIN_I(1:KRR)
!
@@ -793,7 +677,7 @@ IF (KMICRO >= 0) THEN
ZRIMINTP1 = XRIMINTP1_I
ZRIMINTP2 = XRIMINTP2_I
!
- ELSE IF (CCLOUD == 'LIMA') THEN
+ ELSE IF (HCLOUD == 'LIMA') THEN
! in ini_lima, xrtmin is initialized with dimension 7
ZRTMIN(1:KRR) = XRTMIN_L(1:KRR)
!
@@ -840,32 +724,32 @@ IF (KMICRO >= 0) THEN
!* 1.6 update the slope parameter of the distribution
!* and compute N_x if necessary
!
- IF (CCLOUD(1:3) == 'ICE') ZCCT(:) = 0.
- CALL COMPUTE_LAMBDA(2, IMOM_C, KMICRO, ZRHODREF, ZRTMIN(2), ZRCT, ZCCT, ZLBDAC)
- CALL COMPUTE_LAMBDA(3, IMOM_R, KMICRO, ZRHODREF, ZRTMIN(3), ZRRT, ZCRT, ZLBDAR)
- CALL COMPUTE_LAMBDA(4, IMOM_I, KMICRO, ZRHODREF, ZRTMIN(4), ZRIT, ZCIT, ZLBDAI)
- CALL COMPUTE_LAMBDA(5, IMOM_S, KMICRO, ZRHODREF, ZRTMIN(5), ZRST, ZCST, ZLBDAS)
- CALL COMPUTE_LAMBDA(6, IMOM_G, KMICRO, ZRHODREF, ZRTMIN(6), ZRGT, ZCGT, ZLBDAG)
- IF (KRR == 7) CALL COMPUTE_LAMBDA(7, IMOM_H, KMICRO, ZRHODREF, ZRTMIN(7), ZRHT, ZCHT, ZLBDAH)
+ IF (HCLOUD(1:3) == 'ICE') ZCCT(:) = 0.
+ CALL COMPUTE_LAMBDA(2, IMOM_C, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(2), ZRCT, ZCCT, ZLBDAC)
+ CALL COMPUTE_LAMBDA(3, IMOM_R, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(3), ZRRT, ZCRT, ZLBDAR)
+ CALL COMPUTE_LAMBDA(4, IMOM_I, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(4), ZRIT, ZCIT, ZLBDAI)
+ CALL COMPUTE_LAMBDA(5, IMOM_S, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(5), ZRST, ZCST, ZLBDAS)
+ CALL COMPUTE_LAMBDA(6, IMOM_G, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(6), ZRGT, ZCGT, ZLBDAG)
+ IF (KRR == 7) CALL COMPUTE_LAMBDA(7, IMOM_H, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(7), ZRHT, ZCHT, ZLBDAH)
!
!
!* 1.7 update the parameter e in the charge-diameter relationship
!
! Compute e_x at time t
- IF (CCLOUD == 'LIMA') THEN
- CALL ELEC_COMPUTE_EX(2, IMOM_C, KMICRO, 1., ZRHODREF, ZRTMIN(2), ZRCT, ZQCT, ZECT, PLBDX=ZLBDAC, PCX=ZCCT)
- CALL ELEC_COMPUTE_EX(3, IMOM_R, KMICRO, 1., ZRHODREF, ZRTMIN(3), ZRRT, ZQRT, ZERT, PLBDX=ZLBDAR, PCX=ZCRT)
- CALL ELEC_COMPUTE_EX(4, IMOM_I, KMICRO, 1., ZRHODREF, ZRTMIN(4), ZRIT, ZQIT, ZEIT, PLBDX=ZLBDAI, PCX=ZCIT)
- CALL ELEC_COMPUTE_EX(5, IMOM_S, KMICRO, 1., ZRHODREF, ZRTMIN(5), ZRST, ZQST, ZEST, PLBDX=ZLBDAS, PCX=ZCST)
- CALL ELEC_COMPUTE_EX(6, IMOM_G, KMICRO, 1., ZRHODREF, ZRTMIN(6), ZRGT, ZQGT, ZEGT, PLBDX=ZLBDAG, PCX=ZCGT)
- IF (KRR == 7) CALL ELEC_COMPUTE_EX(7, IMOM_H, KMICRO, 1., ZRHODREF, ZRTMIN(7), ZRHT, ZQHT, ZEHT, PLBDX=ZLBDAH, PCX=ZCHT)
- ELSE IF (CCLOUD(1:3) == 'ICE') THEN
- CALL ELEC_COMPUTE_EX(2, 1, KMICRO, 1., ZRHODREF, ZRTMIN(2), ZRCT, ZQCT, ZECT)
- CALL ELEC_COMPUTE_EX(3, 1, KMICRO, 1., ZRHODREF, ZRTMIN(3), ZRRT, ZQRT, ZERT, PLBDX=ZLBDAR)
- CALL ELEC_COMPUTE_EX(4, 1, KMICRO, 1., ZRHODREF, ZRTMIN(4), ZRIT, ZQIT, ZEIT, PCX=ZCIT)
- CALL ELEC_COMPUTE_EX(5, 1, KMICRO, 1., ZRHODREF, ZRTMIN(5), ZRST, ZQST, ZEST, PLBDX=ZLBDAS)
- CALL ELEC_COMPUTE_EX(6, 1, KMICRO, 1., ZRHODREF, ZRTMIN(6), ZRGT, ZQGT, ZEGT, PLBDX=ZLBDAG)
- IF (KRR == 7) CALL ELEC_COMPUTE_EX(7, 1, KMICRO, 1., ZRHODREF, ZRTMIN(7), ZRHT, ZQHT, ZEHT, PLBDX=ZLBDAH)
+ IF (HCLOUD == 'LIMA') THEN
+ CALL ELEC_COMPUTE_EX(2, IMOM_C, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(2), ZRCT, ZQCT, ZECT, PLBDX=ZLBDAC, PCX=ZCCT)
+ CALL ELEC_COMPUTE_EX(3, IMOM_R, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(3), ZRRT, ZQRT, ZERT, PLBDX=ZLBDAR, PCX=ZCRT)
+ CALL ELEC_COMPUTE_EX(4, IMOM_I, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(4), ZRIT, ZQIT, ZEIT, PLBDX=ZLBDAI, PCX=ZCIT)
+ CALL ELEC_COMPUTE_EX(5, IMOM_S, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(5), ZRST, ZQST, ZEST, PLBDX=ZLBDAS, PCX=ZCST)
+ CALL ELEC_COMPUTE_EX(6, IMOM_G, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(6), ZRGT, ZQGT, ZEGT, PLBDX=ZLBDAG, PCX=ZCGT)
+ IF (KRR == 7) CALL ELEC_COMPUTE_EX(7, IMOM_H, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(7), ZRHT, ZQHT, ZEHT, PLBDX=ZLBDAH, PCX=ZCHT)
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ CALL ELEC_COMPUTE_EX(2, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(2), ZRCT, ZQCT, ZECT)
+ CALL ELEC_COMPUTE_EX(3, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(3), ZRRT, ZQRT, ZERT, PLBDX=ZLBDAR)
+ CALL ELEC_COMPUTE_EX(4, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(4), ZRIT, ZQIT, ZEIT, PCX=ZCIT)
+ CALL ELEC_COMPUTE_EX(5, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(5), ZRST, ZQST, ZEST, PLBDX=ZLBDAS)
+ CALL ELEC_COMPUTE_EX(6, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(6), ZRGT, ZQGT, ZEGT, PLBDX=ZLBDAG)
+ IF (KRR == 7) CALL ELEC_COMPUTE_EX(7, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(7), ZRHT, ZQHT, ZEHT, PLBDX=ZLBDAH)
END IF
!
!
@@ -922,10 +806,10 @@ IF (KMICRO >= 0) THEN
!
!* 2.2 spontaneous freezing (rhong)
!
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SFR', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'SFR', &
Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SFR', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'SFR', &
Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -938,20 +822,20 @@ IF (KMICRO >= 0) THEN
ZQRS(:) = 0.
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SFR', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'SFR', &
Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SFR', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'SFR', &
Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
!
!* 2.3 cloud ice melting (rimltc)
!
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'IMLT', &
Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'IMLT', &
Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -960,10 +844,10 @@ IF (KMICRO >= 0) THEN
ZQIS(:) = 0.
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'IMLT', &
Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'IMLT', &
Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -979,7 +863,7 @@ IF (KMICRO >= 0) THEN
ZWQ(:) = 0.
WHERE (ZRCHONI(:) > 0. .AND. &
ZRCT(:) > XRTMIN_ELEC(2) .AND. &
- ABS(ZQCT(:)) > XQTMIN(2) .AND. ABS(ZECT(:)) > XECMIN)
+ ABS(ZQCT(:)) > XQTMIN(2) .AND. ABS(ZECT(:)) > ELECP%XECMIN)
ZWQ(:) = XQHON * ZECT(:) * ZRCHONI(:)
ZWQ(:) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQCS(:) )
!
@@ -987,20 +871,20 @@ IF (KMICRO >= 0) THEN
ZQCS(:) = ZQCS(:) - ZWQ(:)
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'HON', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'HON', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
!
!* 2.6 deposition on snow/aggregates (rvdeps)
!
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPS', &
Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'DEPS', &
Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1013,16 +897,16 @@ IF (KMICRO >= 0) THEN
ZWQ(:) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ(:)) ),ZQSS(:) )
!
ZQSS(:) = ZQSS(:) - ZWQ(:)
- ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/XECHARGE )
- ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/XECHARGE )
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPS', &
Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'DEPS', &
Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'DEPS', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1033,10 +917,10 @@ IF (KMICRO >= 0) THEN
XRTMIN_ELEC(4), XQTMIN(4), XCOEF_RQ_I, &
ZWQ, ZQIS, ZQSS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'AGGS', &
Unpack( -zwq(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'AGGS', &
Unpack( zwq(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1045,10 +929,10 @@ IF (KMICRO >= 0) THEN
!
CALL ELEC_IAGGS_B()
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'NIIS', &
Unpack( -zwq_ni(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'NIIS', &
Unpack( zwq_ni(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1064,34 +948,34 @@ IF (KMICRO >= 0) THEN
XRTMIN_ELEC(4), XQTMIN(4), XCOEF_RQ_I, &
ZWQ, ZQIS, ZQSS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'AUTS', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'AUTS', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
!
!* 2.10 snow --> ice conversion (rscnvi)
!
- IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
CALL COMPUTE_CHARGE_TRANSFER (ZRICNVI, ZRST, ZQST, PTSTEP, &
XRTMIN_ELEC(5), XQTMIN(5), XCOEF_RQ_S, &
ZWQ, ZQSS, ZQIS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CNVI', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CNVI', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CNVI', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'CNVI', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
!* 2.11 water vapor deposition on ice crystals (rvdepi)
!
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'SUBI', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'SUBI', &
Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'SUBI', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'SUBI', &
Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1104,16 +988,16 @@ IF (KMICRO >= 0) THEN
ZWQ(:) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQIS(:) )
!
ZQIS(:) = ZQIS(:) - ZWQ(:)
- ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/XECHARGE )
- ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/XECHARGE )
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'SUBI', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'SUBI', &
Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'SUBI', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'SUBI', &
Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SUBI', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'SUBI', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
END IF
@@ -1121,10 +1005,10 @@ IF (KMICRO >= 0) THEN
!
!* 2.12 water vapor deposition on graupel (rvdepg)
!
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPG', &
Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'DEPG', &
Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1137,16 +1021,16 @@ IF (KMICRO >= 0) THEN
ZWQ(:) = SIGN( MIN( ABS(ZQGT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQGS(:) )
!
ZQGS(:) = ZQGS(:) - ZWQ(:)
- ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/XECHARGE )
- ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/XECHARGE )
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPG', &
Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'DEPG', &
Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'DEPG', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1162,10 +1046,10 @@ IF (KMICRO >= 0) THEN
XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
ZWQ, ZQCS, ZQRS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'AUTO', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'AUTO', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1176,20 +1060,20 @@ IF (KMICRO >= 0) THEN
XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
ZWQ, ZQCS, ZQRS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'ACCR', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'ACCR', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
!
!* 3.3 evaporation of raindrops (rrevav)
!
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'REVA', &
Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'REVA', &
Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1200,27 +1084,27 @@ IF (KMICRO >= 0) THEN
ZWQ(:) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQRS(:) )
!
ZQRS(:) = ZQRS(:) - ZWQ(:)
- ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/XECHARGE )
- ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/XECHARGE )
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'REVA', &
Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'REVA', &
Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'REVA', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
!
!* 3.4 conversion of drops to droplets (rrcvrc)
!
- IF (CCLOUD == 'LIMA') THEN
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'R2C1', &
+ IF (HCLOUD == 'LIMA') THEN
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'R2C1', &
Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'R2C1', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'R2C1', &
Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1228,10 +1112,10 @@ IF (KMICRO >= 0) THEN
XRTMIN_ELEC(3), XQTMIN(3), XCOEF_RQ_R, &
ZWQ, ZQRS, ZQCS)
!
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'R2C1', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'R2C1', &
Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'R2C1', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'R2C1', &
Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
END IF
@@ -1243,12 +1127,12 @@ IF (KMICRO >= 0) THEN
!
!* 4.1 cloud droplet riming of the aggregates
!
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'RIM', &
Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'RIM', &
Unpack( zqss(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'RIM', &
Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1278,7 +1162,7 @@ IF (KMICRO >= 0) THEN
GMASK(:) = .FALSE.
IGMASK = 0
DO JJ = 1, SIZE(GMASK)
- IF (ZRSRIMCG(JJ) > 0. .AND. ZZT(JJ) < XTT .AND. &
+ IF (ZRSRIMCG(JJ) > 0. .AND. ZZT(JJ) < CST%XTT .AND. &
ZRCT(JJ) > XRTMIN_ELEC(2) .AND. ZRST(JJ) > XRTMIN_ELEC(5) .AND. &
ZLBDAS(JJ) > 0.) THEN !++cb-- 12/07/23 condition ajoutee pour eviter log(0)
IGMASK = IGMASK + 1
@@ -1331,27 +1215,27 @@ IF (KMICRO >= 0) THEN
ZQSS(:) = ZQSS(:) - ZWQ(:)
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'RIM', &
Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'RIM', &
Unpack( zqss(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'RIM', &
Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
!
!* 4.2 Hallett-Mossop ice multiplication process due to snow riming (rhmsi)
!
- IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
CALL COMPUTE_CHARGE_TRANSFER (ZRSHMSI, ZRST, ZQST, PTSTEP, &
XRTMIN_ELEC(4), XQTMIN(4), XCOEF_RQ_S, &
ZWQ, ZQSS, ZQIS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'HMS', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'HMS', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HMS', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'HMS', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
END IF
@@ -1428,7 +1312,7 @@ IF (KMICRO >= 0) THEN
ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
ZCRT(:) > 0. .AND. ZCST(:) > 0. .AND. &
ZLBDAR(:) > 0. .AND. ZLBDAS(:) > 0. .AND. &
- ABS(ZERT(:)) > XERMIN) ! and zzt(:) < xtt ?
+ ABS(ZERT(:)) > ELECP%XERMIN) ! and zzt(:) < xtt ?
ZWQ4(:) = XFQRACCS * ZERT(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
ZCRT(:) * ZCST(:) * &
(XLBQRACCS1 * ZLBDAR(:)**(-2.0 - XFR) + &
@@ -1473,12 +1357,12 @@ IF (KMICRO >= 0) THEN
ZQGS(:) = ZQGS(:) + ZWQ5(:,4)
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACC', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'ACC', &
Unpack( (-zwq5(:,1) - zwq5(:,3)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'ACC', &
Unpack( ( zwq5(:,1) - zwq5(:,4)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'ACC', &
Unpack( ( zwq5(:,3) + zwq5(:,4)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1491,25 +1375,25 @@ IF (KMICRO >= 0) THEN
XRTMIN_ELEC(5), XQTMIN(5), XCOEF_RQ_S, &
ZWQ, ZQSS, ZQGS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'CMEL', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'CMEL', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
!
!* 4.5 cloud droplet collection onto aggregates by positive temperature (rcmltsr)
!
- IF (CCLOUD(1:3) == 'ICE') THEN
+ IF (HCLOUD(1:3) == 'ICE') THEN
CALL COMPUTE_CHARGE_TRANSFER (ZRCMLTSR, ZRCT, ZQCT, PTSTEP, &
XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
ZWQ, ZQCS, ZQRS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'CMEL', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'CMEL', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CMEL', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CMEL', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
END IF
@@ -1522,12 +1406,12 @@ IF (KMICRO >= 0) THEN
!
!* 5.1 rain contact freezing (ricfrrg, rrcfrig, ricfrr)
!
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CFRZ', &
Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CFRZ', &
Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'CFRZ', &
Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1535,7 +1419,7 @@ IF (KMICRO >= 0) THEN
WHERE (ZRRCFRIG(:) > 0. .AND. &
ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. &
ZCRT(:) > 0. .AND. &
- ABS(ZERT(:)) > XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ABS(ZERT(:)) > ELECP%XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3))
ZWQ(:) = XQRCFRIG * ZLBDAR(:)**XEXQRCFRIG * ZCIT(:) * ZCRT(:) * &
ZERT(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) ! QRCFRIG
ZWQ(:) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQRS(:) )
@@ -1557,12 +1441,12 @@ IF (KMICRO >= 0) THEN
!
!++CB-- 16/06/2022 il manque le traitement de qricfrr
!
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CFRZ', &
Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CFRZ', &
Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'CFRZ', &
Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1602,10 +1486,10 @@ IF (KMICRO >= 0) THEN
! charge separation during collision between ice and graupel
CALL ELEC_IDRYG_B() ! QIDRYG_boun
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIG', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'NIIG', &
Unpack( -zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'NIIG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'NIIG', &
Unpack( zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1714,7 +1598,7 @@ IF (KMICRO >= 0) THEN
ZLBDAS(:) > 0. .AND. ZLBDAG(:) > 0. .AND. &
ABS(ZQST(:)) > XQTMIN(5) .AND. ABS(ZEST(:)) > XESMIN)
ZWQ5(:,3) = ZWQ5(:,3) * XFQSDRYG * &
- ZCOLSG * EXP(ZCOLEXSG * (ZZT(:) - XTT)) * &
+ ZCOLSG * EXP(ZCOLEXSG * (ZZT(:) - CST%XTT)) * &
ZEST(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
ZCGT(:) * ZCST(:) * &
(XLBQSDRYG1 * ZLBDAS(:)**(-2.0-XFS) + &
@@ -1734,10 +1618,10 @@ IF (KMICRO >= 0) THEN
! compute QSDRYG_boun
CALL ELEC_SDRYG_B()
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NISG', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'NISG', &
Unpack( -zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'NISG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'NISG', &
Unpack( zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1807,7 +1691,7 @@ IF (KMICRO >= 0) THEN
ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
ZCRT(:) > 0. .AND. ZCGT(:) > 0. .AND. &
ZLBDAR(:) > 0. .AND. ZLBDAG(:) > 0. .AND. &
- ABS(ZERT(:)) > XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ABS(ZERT(:)) > ELECP%XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3))
ZWQ5(:,4) = ZWQ5(:,4) * XFQRDRYG * &
ZRHODREF(:)**(-ZCEXVT) * &
ZERT(:) * ZCGT(:) * ZCRT(:) * &
@@ -1823,16 +1707,16 @@ IF (KMICRO >= 0) THEN
ENDWHERE
! ZRDRYG(:) = ZWQ5(:,1) + ZWQ5(:,2) + ZWQ5(:,3) + ZWQ5(:,4)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'DRYG', &
Unpack( -zwq5(:,1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'DRYG', &
Unpack( -zwq5(:,4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'DRYG', &
Unpack( -zwq5(:,2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'DRYG', &
Unpack( -zwq5(:,3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'DRYG', &
Unpack( (zwq5(:,1) + zwq5(:,2) + zwq5(:,3) + zwq5(:,4)) * zrhodj(:), &
mask = odmicro(:, :, :), field = 0. ) )
end if
@@ -1842,15 +1726,15 @@ IF (KMICRO >= 0) THEN
!
!* 5.3 Hallett-Mossop ice multiplication process due to graupel riming (rhmgi)
!
- IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
CALL COMPUTE_CHARGE_TRANSFER (ZRGHMGI, ZRGT, ZQGT, PTSTEP, &
XRTMIN_ELEC(6), XQTMIN(6), XCOEF_RQ_G, &
ZWQ, ZQGS, ZQIS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'HMG', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'HMG', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HMG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'HMG', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
END IF
@@ -1900,8 +1784,8 @@ IF (KMICRO >= 0) THEN
!
!* 5.4.4 conversion of graupel into hail (rwetgh)
!
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'WETG', &
Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1932,19 +1816,19 @@ IF (KMICRO >= 0) THEN
END WHERE
END IF
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'WETG', &
Unpack( -zwq5(:,5) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'WETG', &
Unpack( -zwq5(:,8) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'WETG', &
Unpack( -zwq5(:,6) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'WETG', &
Unpack( -zwq5(:,7) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'WETG', &
Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
if ( krr == 7 ) &
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 6 ), 'WETG', &
Unpack( zwq5(:,9) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -1965,7 +1849,7 @@ IF (KMICRO >= 0) THEN
ZWQ(:) = 0.
!
WHERE (GMASK(:) .AND. &
- ZEFIELDW(:) /= 0. .AND. ABS(ZEGT(:)) > XEGMIN .AND. &
+ ZEFIELDW(:) /= 0. .AND. ABS(ZEGT(:)) > ELECP%XEGMIN .AND. &
ZLBDAG(:) > 0. .AND. ZCGT(:) > 0. .AND. &
ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRCT(:) > XRTMIN_ELEC(2))
ZWQ(:) = XIND1 * ZCGT(:) * ZRHOCOR(:) * &
@@ -1978,10 +1862,10 @@ IF (KMICRO >= 0) THEN
ZQCS(:) = ZQCS(:) - ZWQ(:)
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'INCG', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'INCG', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'INCG', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -2004,10 +1888,10 @@ IF (KMICRO >= 0) THEN
XRTMIN_ELEC(6), XQTMIN(6), XCOEF_RQ_G, &
ZWQ, ZQGS, ZQRS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'GMLT', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'GMLT', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'GMLT', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -2022,14 +1906,14 @@ IF (KMICRO >= 0) THEN
!
!* 6.1 collisional ice breakup (cibu)
!
- IF (CCLOUD == 'LIMA' .AND. LCIBU) &
+ IF (HCLOUD == 'LIMA' .AND. LCIBU) &
CALL COMPUTE_CHARGE_TRANSFER (ZRICIBU, ZRST, ZQST, PTSTEP, &
XRTMIN_ELEC(5), XQTMIN(5), XCOEF_RQ_S, &
ZWQ, ZQSS, ZQIS)
!
!* 6.2 raindrop shattering freezing (rdsf)
!
- IF (CCLOUD == 'LIMA' .AND. LRDSF) &
+ IF (HCLOUD == 'LIMA' .AND. LRDSF) &
CALL COMPUTE_CHARGE_TRANSFER (ZRIRDSF, ZRRT, ZQRT, PTSTEP, &
XRTMIN_ELEC(3), XQTMIN(3), XCOEF_RQ_R, &
ZWQ, ZQRS, ZQIS)
@@ -2086,18 +1970,18 @@ IF (KMICRO >= 0) THEN
ZQHS(:) = ZQHS(:) + ZWQ5(:,4)
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETH', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'WETH', &
Unpack( -zwq5(:, 1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETH', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'WETH', &
Unpack( -zwq5(:, 4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETH', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'WETH', &
Unpack( -zwq5(:, 2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETH', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'WETH', &
Unpack( -zwq5(:, 3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETH', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'WETH', &
Unpack( -zwq5(:, 5) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETH', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 6 ), 'WETH', &
Unpack( ( zwq5(:, 1) + zwq5(:, 2) + zwq5(:, 3) + zwq5(:, 4) + zwq5(:, 5) ) &
* zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
@@ -2154,18 +2038,18 @@ IF (KMICRO >= 0) THEN
XRTMIN_ELEC(7), XQTMIN(7), XCOEF_RQ_H, &
ZWQ, ZQHS, ZQGS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYH', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'DRYH', &
Unpack( -zwq5(:, 1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYH', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'DRYH', &
Unpack( -zwq5(:, 4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYH', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'DRYH', &
Unpack( -zwq5(:, 2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYH', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'DRYH', &
Unpack( -zwq5(:, 3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYH', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'DRYH', &
Unpack( (-zwq5(:, 5) - zwq(:)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'DRYH', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 6 ), 'DRYH', &
Unpack( ( zwq5(:, 1) + zwq5(:, 2) + zwq5(:, 3) + zwq5(:, 4) + zwq5(:, 5) + zwq(:) ) &
* zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
@@ -2177,10 +2061,10 @@ IF (KMICRO >= 0) THEN
XRTMIN_ELEC(7), XQTMIN(7), XCOEF_RQ_H, &
ZWQ, ZQHS, ZQRS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'HMLT', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'HMLT', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'HMLT', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 6 ), 'HMLT', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -2198,10 +2082,10 @@ IF (KMICRO >= 0) THEN
XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
ZWQ, ZQCS, ZQIS)
!
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'BERFI', &
Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'BERFI', &
Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -2211,12 +2095,12 @@ IF (KMICRO >= 0) THEN
!* 9. COMPUTE THE CHARGE TRANSFER ASSOCIATED WITH THE CORRECTION TERM
! ---------------------------------------------------------------
!
- IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
!
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'CORR2', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'CORR2', &
Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'CORR2', &
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'CORR2', &
Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
!
@@ -2226,8 +2110,8 @@ IF (KMICRO >= 0) THEN
ZWQ(:) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ1(:)) ),ZQCS(:) )
!
ZQCS(:) = ZQCS(:) - ZWQ1(:)
- ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:)/XECHARGE )
- ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:)/XECHARGE )
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:)/ELECD%XECHARGE )
END WHERE
!
!
@@ -2237,8 +2121,8 @@ IF (KMICRO >= 0) THEN
ZWQ2(:) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ2(:)) ),ZQRS(:) )
!
ZQRS(:) = ZQRS(:) - ZWQ2(:)
- ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ2(:)/XECHARGE )
- ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ2(:)/XECHARGE )
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ2(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ2(:)/ELECD%XECHARGE )
END WHERE
!
ZWQ3(:) = 0.
@@ -2247,20 +2131,20 @@ IF (KMICRO >= 0) THEN
ZWQ3(:) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ3(:)) ),ZQIS(:) )
!
ZQIS(:) = ZQIS(:) - ZWQ3(:)
- ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ3(:)/XECHARGE )
- ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ3(:)/XECHARGE )
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ3(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ3(:)/ELECD%XECHARGE )
END WHERE
!
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'CORR2', &
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'CORR2', &
Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'CORR2', &
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'CORR2', &
Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'CORR2', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'CORR2', &
Unpack( zwq1(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CORR2', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CORR2', &
Unpack( zwq2(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CORR2', &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CORR2', &
Unpack( zwq3(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
end if
END IF
@@ -2362,6 +2246,7 @@ IF (ALLOCATED(ZRHMLTR)) DEALLOCATE(ZRHMLTR)
IF (ALLOCATED(ZRDRYHG)) DEALLOCATE(ZRDRYHG)
!
!------------------------------------------------------------------
+END ASSOCIATE
!
CONTAINS
!
@@ -2394,7 +2279,7 @@ GELEC(:,:) = .FALSE.
ZDELTALWC(:) = 0.
ZFT(:) = 0.
!
-GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) < XTT
+GELEC(:,3) = ZZT(:) > (CST%XTT - 40.) .AND. ZZT(:) < CST%XTT
GELEC(:,1) = GELEC(:,3) .AND. &
ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
@@ -2409,9 +2294,9 @@ GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
!
WHERE (GELEC(:,4))
! f(DeltaT)
- ZFT(:) = - 1.7E-5 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT))**3 &
- - 0.003 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT))**2 &
- - 0.05 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT)) &
+ ZFT(:) = - 1.7E-5 * ((-21 / (XQTC - CST%XTT)) * (ZZT(:) - CST%XTT))**3 &
+ - 0.003 * ((-21 / (XQTC - CST%XTT)) * (ZZT(:) - CST%XTT))**2 &
+ - 0.05 * ((-21 / (XQTC - CST%XTT)) * (ZZT(:) - CST%XTT)) &
+ 0.13
!
! LWC - LWC_crit
@@ -2470,7 +2355,7 @@ WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
ZEW(:) = 0.8 * ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3)
END WHERE
!
-GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+GELEC(:,3) = ZZT(:) > (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT .AND. &
ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
GELEC(:,1) = GELEC(:,3) .AND. &
ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
@@ -2548,40 +2433,40 @@ ZRAR_CRIT(:) = 0.
!
IF (CNI_CHARGING == 'SAP98') THEN
!
- WHERE (ZZT(:) <= XTT .AND. ZZT(:) >= (XTT - 23.7)) ! Original from SAP98
- ZRAR_CRIT(:) = 1.0 + 7.93E-2 * (ZZT(:) - XTT) + &
- 4.48E-2 * (ZZT(:) - XTT)**2 + &
- 7.48E-3 * (ZZT(:) - XTT)**3 + &
- 5.47E-4 * (ZZT(:) - XTT)**4 + &
- 1.67E-5 * (ZZT(:) - XTT)**5 + &
- 1.76E-7 * (ZZT(:) - XTT)**6
+ WHERE (ZZT(:) <= CST%XTT .AND. ZZT(:) >= (CST%XTT - 23.7)) ! Original from SAP98
+ ZRAR_CRIT(:) = 1.0 + 7.93E-2 * (ZZT(:) - CST%XTT) + &
+ 4.48E-2 * (ZZT(:) - CST%XTT)**2 + &
+ 7.48E-3 * (ZZT(:) - CST%XTT)**3 + &
+ 5.47E-4 * (ZZT(:) - CST%XTT)**4 + &
+ 1.67E-5 * (ZZT(:) - CST%XTT)**5 + &
+ 1.76E-7 * (ZZT(:) - CST%XTT)**6
END WHERE
!
- WHERE (ZZT(:) < (XTT - 23.7) .AND. ZZT(:) > (XTT - 40.)) ! Added by Mansell
- ZRAR_CRIT(:) = 3.4 * (1.0 - (ABS(ZZT(:) - XTT + 23.7) / & ! et al. (2005)
+ WHERE (ZZT(:) < (CST%XTT - 23.7) .AND. ZZT(:) > (CST%XTT - 40.)) ! Added by Mansell
+ ZRAR_CRIT(:) = 3.4 * (1.0 - (ABS(ZZT(:) - CST%XTT + 23.7) / & ! et al. (2005)
(-23.7 + 40.))**3.)
END WHERE
!
- GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT
+ GELEC(:,3) = ZZT(:) >= (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT
!
ELSE IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
!
- WHERE (ZZT(:) > (XTT - 10.7))
+ WHERE (ZZT(:) > (CST%XTT - 10.7))
ZRAR_CRIT(:) = 0.66
END WHERE
- WHERE (ZZT(:) <= (XTT - 10.7) .AND. ZZT(:) >= (XTT - 23.7))
- ZRAR_CRIT(:) = -1.47 - 0.2 * (ZZT(:) - XTT)
+ WHERE (ZZT(:) <= (CST%XTT - 10.7) .AND. ZZT(:) >= (CST%XTT - 23.7))
+ ZRAR_CRIT(:) = -1.47 - 0.2 * (ZZT(:) - CST%XTT)
END WHERE
- WHERE (ZZT(:) < (XTT - 23.7) .AND. ZZT(:) > (XTT - 40.))
+ WHERE (ZZT(:) < (CST%XTT - 23.7) .AND. ZZT(:) > (CST%XTT - 40.))
ZRAR_CRIT(:) = 3.3
END WHERE
!
- GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ GELEC(:,3) = ZZT(:) > (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT .AND. &
ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
!
ELSE IF (CNI_CHARGING == 'TERAR') THEN
!
- GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT
+ GELEC(:,3) = ZZT(:) >= (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT
END IF
!
GELEC(:,1) = GELEC(:,3) .AND. &
@@ -2764,7 +2649,7 @@ ZDQ(:) = 0.
!
ZEW(:) = ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3)
!
-GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+GELEC(:,3) = ZZT(:) > (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT .AND. &
ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
GELEC(:,1) = GELEC(:,3) .AND. &
ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
@@ -2831,7 +2716,7 @@ WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
ZEW(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * 1.E3
END WHERE
!
-GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+GELEC(:,3) = ZZT(:) >= (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT .AND. &
ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
GELEC(:,1) = GELEC(:,3) .AND. &
ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
@@ -2969,7 +2854,7 @@ IF (IGAUX > 0) THEN
!
! Temperature index (0C --> -40C)
ZVECT1(1:IGAUX) = MAX( 1.00001, MIN( REAL(KIND_TEMP)-0.00001, &
- (ZVECT1(1:IGAUX) - XTT - 1.)/(-1.) ) )
+ (ZVECT1(1:IGAUX) - CST%XTT - 1.)/(-1.) ) )
IVECT1(1:IGAUX) = INT( ZVECT1(1:IGAUX) )
ZVECT1(1:IGAUX) = ZVECT1(1:IGAUX) - REAL(IVECT1(1:IGAUX))
!
@@ -3035,7 +2920,7 @@ IMPLICIT NONE
!* 1. COMPUTE THE COLLISION EFFICIENCY
! --------------------------------
!
-ZQCOLIS(:) = ZCOLIS * EXP(ZCOLEXIS * (ZZT(:) - XTT))
+ZQCOLIS(:) = ZCOLIS * EXP(ZCOLEXIS * (ZZT(:) - CST%XTT))
!
ZWQ_NI(:) = 0.
ZLIMIT(:) = 0.
@@ -3146,8 +3031,8 @@ ELSE
ENDWHERE
!
! For temperatures lower than -30C --> linear interpolation
- WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
- ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XTT + 40.) / 10.
+ WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (CST%XTT-30.) .AND. ZZT(:) >= (CST%XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - CST%XTT + 40.) / 10.
ENDWHERE
!
END IF
@@ -3177,7 +3062,7 @@ IMPLICIT NONE
!* 1. COMPUTE THE COLLISION EFFICIENCY
! --------------------------------
!
-ZQCOLIG(:) = ZCOLIG * EXP(ZCOLEXIG * (ZZT(:) - XTT))
+ZQCOLIG(:) = ZCOLIG * EXP(ZCOLEXIG * (ZZT(:) - CST%XTT))
!
ZWQ_NI(:) = 0.
ZLIMIT(:) = 0.
@@ -3288,8 +3173,8 @@ ELSE
ENDWHERE
!
! For temperatures lower than -30C --> linear interpolation
- WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
- ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XTT + 40.) / 10.
+ WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (CST%XTT-30.) .AND. ZZT(:) >= (CST%XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - CST%XTT + 40.) / 10.
ENDWHERE
!
END IF
@@ -3321,7 +3206,7 @@ IMPLICIT NONE
!* 1. COMPUTE THE COLLECTION EFFICIENCY
! ---------------------------------
!
-ZQCOLSG(:) = ZCOLSG * EXP (ZCOLEXSG * (ZZT(:) - XTT))
+ZQCOLSG(:) = ZCOLSG * EXP (ZCOLEXSG * (ZZT(:) - CST%XTT))
!
ZWQ_NI(:) = 0.
ZLIMIT(:) = 0.
@@ -3454,8 +3339,8 @@ ELSE
ENDWHERE
!
! For temperatures lower than -30C --> linear interpolation
- WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
- ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XTT + 40.) / 10.
+ WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (CST%XTT-30.) .AND. ZZT(:) >= (CST%XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - CST%XTT + 40.) / 10.
ENDWHERE
!
END IF
@@ -3574,3 +3459,4 @@ END FUNCTION BI_LIN_INTP_V
!------------------------------------------------------------------
!
END SUBROUTINE ELEC_TENDENCIES
+END MODULE MODE_ELEC_TENDENCIES
diff --git a/src/PHYEX/micro/mode_ice4_compute_pdf.f90 b/src/PHYEX/micro/mode_ice4_compute_pdf.f90
index 771d42c94ca8e72087891d2fcaf21ad5b222bfab..fce6431f53c8a1dee858c82c32f32b2713f7ba78 100644
--- a/src/PHYEX/micro/mode_ice4_compute_pdf.f90
+++ b/src/PHYEX/micro/mode_ice4_compute_pdf.f90
@@ -7,7 +7,7 @@ MODULE MODE_ICE4_COMPUTE_PDF
IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_COMPUTE_PDF(CST, ICEP, ICED, KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
- PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
+ LDMICRO, PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
!!
@@ -21,7 +21,7 @@ SUBROUTINE ICE4_COMPUTE_PDF(CST, ICEP, ICED, KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI
!!
!! MODIFICATIONS
!! -------------
-!!
+!! S. Riette Sept 23: LDMICRO mask
!
!
!* 0. DECLARATIONS
@@ -46,6 +46,7 @@ INTEGER, INTENT(IN) :: KSIZE
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method for cloud water
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method for cloud ice
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
+LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDMICRO ! Computation mask
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
@@ -77,22 +78,28 @@ REAL, DIMENSION(KSIZE) :: ZRCRAUTC, & !RC value to begin rain formation =XC
ZSUMRC, ZSUMRI
REAL :: ZCOEFFRCM
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
-INTEGER :: JI
+INTEGER :: JL
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ICE4_COMPUTE_PDF', 0, ZHOOK_HANDLE)!
!Cloud water split between high and low content part is done according to autoconversion option
-ZRCRAUTC(:)=ICEP%XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold
+!$mnh_expand_where(JL=1:KSIZE)
+WHERE (LDMICRO(:))
+ ZRCRAUTC(:)=ICEP%XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold
+ELSEWHERE
+ ZRCRAUTC(:)=0.
+END WHERE
+!$mnh_end_expand_where(JL=1:KSIZE)
IF(HSUBG_AUCV_RC=='NONE') THEN
!Cloud water is entirely in low or high part
- !$mnh_expand_where(JI=1:KSIZE)
- WHERE(PRCT(:)>ZRCRAUTC(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(PRCT(:)>ZRCRAUTC(:) .AND. LDMICRO(:))
PHLC_HCF(:)=1.
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- ELSEWHERE(PRCT(:)>ICED%XRTMIN(2))
+ ELSEWHERE(PRCT(:)>ICED%XRTMIN(2) .AND. LDMICRO(:))
PHLC_HCF(:)=0.
PHLC_LCF(:)=1.
PHLC_HRC(:)=0.
@@ -103,17 +110,17 @@ IF(HSUBG_AUCV_RC=='NONE') THEN
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
END WHERE
- !$mnh_end_expand_where(JI=1:KSIZE)
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
!Cloud water is only in the cloudy part and entirely in low or high part
- !$mnh_expand_where(JI=1:KSIZE)
- WHERE(PCF(:)>0. .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(PCF(:)>0. .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:) .AND. LDMICRO(:))
PHLC_HCF(:)=PCF(:)
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- ELSEWHERE(PCF(:)>0. .AND. PRCT(:)>ICED%XRTMIN(2))
+ ELSEWHERE(PCF(:)>0. .AND. PRCT(:)>ICED%XRTMIN(2) .AND. LDMICRO(:))
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.0
@@ -124,18 +131,24 @@ ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
END WHERE
- !$mnh_end_expand_where(JI=1:KSIZE)
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSEIF(HSUBG_AUCV_RC=='ADJU') THEN
- !$mnh_expand_where(JI=1:KSIZE)
- ZSUMRC(:)=PHLC_LRC(:)+PHLC_HRC(:)
- WHERE(ZSUMRC(:) .GT. 0.)
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(LDMICRO(:))
+ ZSUMRC(:)=PHLC_LRC(:)+PHLC_HRC(:)
+ ELSEWHERE
+ ZSUMRC(:)=0.
+ ENDWHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(ZSUMRC(:) .GT. 0. .AND. LDMICRO(:))
PHLC_LRC(:)=PHLC_LRC(:)*PRCT(:)/ZSUMRC(:)
PHLC_HRC(:)=PHLC_HRC(:)*PRCT(:)/ZSUMRC(:)
ELSEWHERE
PHLC_LRC(:)=0.
PHLC_HRC(:)=0.
ENDWHERE
- !$mnh_end_expand_where(JI=1:KSIZE)
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
!Cloud water is split between high and low part according to a PDF
! 'HLCRECTPDF' : rectangular PDF form
@@ -145,13 +158,13 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
! 'SIGM' : Redelsperger and Sommeria (1986)
IF(HSUBG_PR_PDF=='SIGM') THEN
! Redelsperger and Sommeria (1986) but organised according to Turner (2011, 2012)
- !$mnh_expand_where(JI=1:KSIZE)
- WHERE (PRCT(:)>ZRCRAUTC(:)+PSIGMA_RC(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE (PRCT(:)>ZRCRAUTC(:)+PSIGMA_RC(:) .AND. LDMICRO(:))
PHLC_HCF(:)=1.
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) )
+ ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) .AND. LDMICRO(:))
PHLC_HCF(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))/ &
&(2.*PSIGMA_RC(:))
PHLC_LCF(:)=MAX(0., PCF(:)-PHLC_HCF(:))
@@ -159,7 +172,7 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
&(PRCT(:)+PSIGMA_RC(:)+ZRCRAUTC(:))/ &
&(4.*PSIGMA_RC(:))
PHLC_LRC(:)=MAX(0., PRCT(:)-PHLC_HRC(:))
- ELSEWHERE(PRCT(:)>ICED%XRTMIN(2) .AND. PCF(:)>0.)
+ ELSEWHERE(PRCT(:)>ICED%XRTMIN(2) .AND. PCF(:)>0. .AND. LDMICRO(:))
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.
@@ -170,7 +183,7 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
END WHERE
- !$mnh_end_expand_where(JI=1:KSIZE)
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSEIF(HSUBG_PR_PDF=='HLCRECTPDF' .OR. HSUBG_PR_PDF=='HLCISOTRIPDF' .OR. &
&HSUBG_PR_PDF=='HLCTRIANGPDF' .OR. HSUBG_PR_PDF=='HLCQUADRAPDF') THEN
! Turner (2011, 2012)
@@ -182,51 +195,76 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
ELSE IF(HSUBG_PR_PDF=='HLCQUADRAPDF') THEN
ZCOEFFRCM=4.
END IF
- !$mnh_expand_where(JI=1:KSIZE)
- WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0.)
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. LDMICRO(:))
ZHLC_RCMAX(:)=ZCOEFFRCM*PRCT(:)/PCF(:)
+ ELSEWHERE
+ ZHLC_RCMAX(:)=0.
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
+
! Split available water and cloud fraction in two parts
! Calculate local mean values int he low and high parts for the 3 PDF forms:
IF(HSUBG_PR_PDF=='HLCRECTPDF') THEN
- WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
ZHLC_LRCLOCAL(:)=0.5*ZRCRAUTC(:)
ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + ZRCRAUTC(:))/2.0
+ ELSEWHERE
+ ZHLC_LRCLOCAL(:)=0.
+ ZHLC_HRCLOCAL(:)=0.
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSE IF(HSUBG_PR_PDF=='HLCTRIANGPDF') THEN
- WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
ZHLC_LRCLOCAL(:)=( ZRCRAUTC(:) *(3.0 * ZHLC_RCMAX(:) - 2.0 * ZRCRAUTC(:) ) ) &
/ (3.0 * (2.0 * ZHLC_RCMAX(:) - ZRCRAUTC(:) ) )
ZHLC_HRCLOCAL(:)=(ZHLC_RCMAX(:) + 2.0*ZRCRAUTC(:)) / 3.0
+ ELSEWHERE
+ ZHLC_LRCLOCAL(:)=0.
+ ZHLC_HRCLOCAL(:)=0.
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSE IF(HSUBG_PR_PDF=='HLCQUADRAPDF') THEN
- WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
ZHLC_LRCLOCAL(:)=(3.0 *ZRCRAUTC(:)**3 - 8.0 *ZRCRAUTC(:)**2 * ZHLC_RCMAX(:) &
+ 6.0*ZRCRAUTC(:) *ZHLC_RCMAX(:)**2 ) &
/ &
(4.0* ZRCRAUTC(:)**2 -12.0*ZRCRAUTC(:) *ZHLC_RCMAX(:) &
+ 12.0 * ZHLC_RCMAX(:)**2 )
ZHLC_HRCLOCAL(:)=(ZHLC_RCMAX(:) + 3.0*ZRCRAUTC(:))/4.0
+ ELSEWHERE
+ ZHLC_LRCLOCAL(:)=0.
+ ZHLC_HRCLOCAL(:)=0.
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSE IF(HSUBG_PR_PDF=='HLCISOTRIPDF') THEN
- WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
- WHERE((PRCT(:) / PCF(:)).LE.ZRCRAUTC(:))
- ZHLC_LRCLOCAL(:)=( (ZHLC_RCMAX(:))**3 &
- -(12.0 * (ZHLC_RCMAX(:))*(ZRCRAUTC(:))**2) &
- +(8.0 * ZRCRAUTC(:)**3) ) &
- /( (6.0 * (ZHLC_RCMAX(:))**2) &
- -(24.0 * (ZHLC_RCMAX(:)) * ZRCRAUTC(:)) &
- +(12.0 * ZRCRAUTC(:)**2) )
- ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + 2.0 * ZRCRAUTC(:) )/3.0
- ELSEWHERE
- ZHLC_LRCLOCAL(:)=(2.0/3.0) * ZRCRAUTC(:)
- ZHLC_HRCLOCAL(:)=(3.0*ZHLC_RCMAX(:)**3 - 8.0*ZRCRAUTC(:)**3) &
- / (6.0 * ZHLC_RCMAX(:)**2 - 12.0*ZRCRAUTC(:)**2)
- END WHERE
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE (PRCT(:).LE.ZRCRAUTC(:)*PCF(:) .AND. &
+ &PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. &
+ &ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
+ ZHLC_LRCLOCAL(:)=( (ZHLC_RCMAX(:))**3 &
+ -(12.0 * (ZHLC_RCMAX(:))*(ZRCRAUTC(:))**2) &
+ +(8.0 * ZRCRAUTC(:)**3) ) &
+ /( (6.0 * (ZHLC_RCMAX(:))**2) &
+ -(24.0 * (ZHLC_RCMAX(:)) * ZRCRAUTC(:)) &
+ +(12.0 * ZRCRAUTC(:)**2) )
+ ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + 2.0 * ZRCRAUTC(:) )/3.0
+ ELSEWHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
+ ZHLC_LRCLOCAL(:)=(2.0/3.0) * ZRCRAUTC(:)
+ ZHLC_HRCLOCAL(:)=(3.0*ZHLC_RCMAX(:)**3 - 8.0*ZRCRAUTC(:)**3) &
+ / (6.0 * ZHLC_RCMAX(:)**2 - 12.0*ZRCRAUTC(:)**2)
+ ELSEWHERE
+ ZHLC_LRCLOCAL(:)=0.
+ ZHLC_HRCLOCAL(:)=0.
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
END IF
! Compare r_cM to r_cR to know if cloud water content is high enough to split in two parts or not
- WHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
! Calculate final values for LCF and HCF:
PHLC_LCF(:)=PCF(:) &
*(ZHLC_HRCLOCAL(:)- &
@@ -237,7 +275,7 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
! Calculate final values for LRC and HRC:
PHLC_LRC(:)=ZHLC_LRCLOCAL(:)*PHLC_LCF(:)
PHLC_HRC(:)=MAX(0., PRCT(:)-PHLC_LRC(:))
- ELSEWHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).LE.ZRCRAUTC(:))
+ ELSEWHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).LE.ZRCRAUTC(:) .AND. LDMICRO(:))
! Put all available cloud water and his fraction in the low part
PHLC_LCF(:)=PCF(:)
PHLC_HCF(:)=0.
@@ -249,7 +287,7 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
PHLC_LRC(:)=0.
PHLC_HRC(:)=0.
END WHERE
- !$mnh_end_expand_where(JI=1:KSIZE)
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_PR_PDF case')
ENDIF
@@ -258,18 +296,22 @@ ELSE
ENDIF
!
!Ice water split between high and low content part is done according to autoconversion option
-!$mnh_expand_where(JI=1:KSIZE)
+!$mnh_expand_where(JL=1:KSIZE)
+WHERE(LDMICRO(:))
ZCRIAUTI(:)=MIN(ICEP%XCRIAUTI,10**(ICEP%XACRIAUTI*(PT(:)-CST%XTT)+ICEP%XBCRIAUTI)) ! Autoconversion ri threshold
-!$mnh_end_expand_where(JI=1:KSIZE)
+ELSEWHERE
+ ZCRIAUTI(:)=0.
+ENDWHERE
+!$mnh_end_expand_where(JL=1:KSIZE)
IF(HSUBG_AUCV_RI=='NONE') THEN
- !$mnh_expand_where(JI=1:KSIZE)
!Cloud water is entirely in low or high part
- WHERE(PRIT(:)>ZCRIAUTI(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(PRIT(:)>ZCRIAUTI(:) .AND. LDMICRO(:))
PHLI_HCF(:)=1.
PHLI_LCF(:)=0.
PHLI_HRI(:)=PRIT(:)
PHLI_LRI(:)=0.
- ELSEWHERE(PRIT(:)>ICED%XRTMIN(4))
+ ELSEWHERE(PRIT(:)>ICED%XRTMIN(4) .AND. LDMICRO(:))
PHLI_HCF(:)=0.
PHLI_LCF(:)=1.
PHLI_HRI(:)=0.
@@ -280,16 +322,16 @@ IF(HSUBG_AUCV_RI=='NONE') THEN
PHLI_HRI(:)=0.
PHLI_LRI(:)=0.
END WHERE
- !$mnh_end_expand_where(JI=1:KSIZE)
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
!Cloud water is only in the cloudy part and entirely in low or high part
- !$mnh_expand_where(JI=1:KSIZE)
- WHERE(PCF(:)>0. .AND. PRIT(:)>ZCRIAUTI(:)*PCF(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(PCF(:)>0. .AND. PRIT(:)>ZCRIAUTI(:)*PCF(:) .AND. LDMICRO(:))
PHLI_HCF(:)=PCF(:)
PHLI_LCF(:)=0.
PHLI_HRI(:)=PRIT(:)
PHLI_LRI(:)=0.
- ELSEWHERE(PCF(:)>0. .AND. PRIT(:)>ICED%XRTMIN(4))
+ ELSEWHERE(PCF(:)>0. .AND. PRIT(:)>ICED%XRTMIN(4) .AND. LDMICRO(:))
PHLI_HCF(:)=0.
PHLI_LCF(:)=PCF(:)
PHLI_HRI(:)=0.0
@@ -300,27 +342,36 @@ ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
PHLI_HRI(:)=0.
PHLI_LRI(:)=0.
END WHERE
- !$mnh_end_expand_where(JI=1:KSIZE)
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSEIF(HSUBG_AUCV_RI=='ADJU') THEN
- !$mnh_expand_where(JI=1:KSIZE)
- ZSUMRI(:)=PHLI_LRI(:)+PHLI_HRI(:)
- WHERE(ZSUMRI(:) .GT. 0.)
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(LDMICRO(:))
+ ZSUMRI(:)=PHLI_LRI(:)+PHLI_HRI(:)
+ ELSEWHERE
+ ZSUMRI(:)=0.
+ ENDWHERE
+ WHERE(ZSUMRI(:) .GT. 0. .AND. LDMICRO(:))
PHLI_LRI(:)=PHLI_LRI(:)*PRIT(:)/ZSUMRI(:)
PHLI_HRI(:)=PHLI_HRI(:)*PRIT(:)/ZSUMRI(:)
ELSEWHERE
PHLI_LRI(:)=0.
PHLI_HRI(:)=0.
ENDWHERE
- !$mnh_end_expand_where(JI=1:KSIZE)
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSE
!wrong HSUBG_AUCV_RI case
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'ICE4_COMPUTE_PDF', 'wrong HSUBG_AUCV_RI case' )
ENDIF
!
-!$mnh_expand_where(JI=1:KSIZE)
+!$mnh_expand_where(JL=1:KSIZE)
+WHERE(LDMICRO(:))
PRF(:)=MAX(PHLC_HCF(:),PHLI_HCF(:))
-!$mnh_end_expand_where(JI=1:KSIZE)
+ELSEWHERE
+ PRF(:)=0.
+ENDWHERE
+!$mnh_end_expand_where(JL=1:KSIZE)
!
IF (LHOOK) CALL DR_HOOK('ICE4_COMPUTE_PDF', 1, ZHOOK_HANDLE)
END SUBROUTINE ICE4_COMPUTE_PDF
+
END MODULE MODE_ICE4_COMPUTE_PDF
diff --git a/src/PHYEX/micro/mode_ice4_nucleation.f90 b/src/PHYEX/micro/mode_ice4_nucleation.f90
deleted file mode 100644
index 90a3fbba33b64d05decc1d75b8593f759ed98b83..0000000000000000000000000000000000000000
--- a/src/PHYEX/micro/mode_ice4_nucleation.f90
+++ /dev/null
@@ -1,155 +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(CST, PARAMI, ICEP, ICED, 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: CST_t
-USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
-USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
-USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-TYPE(CST_t), INTENT(IN) :: CST
-TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
-TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
-TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
-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=JPHOOK) :: 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
-INTEGER :: JI
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION', 0, ZHOOK_HANDLE)!
-!
-!$mnh_expand_where(JI=1:KSIZE)
-WHERE(ODCOMPUTE(:))
- GNEGT(:)=PT(:)<CST%XTT .AND. PRVT(:)>ICED%XRTMIN(1)
-ELSEWHERE
- GNEGT(:)=.FALSE.
-ENDWHERE
-!$mnh_end_expand_where(JI=1:KSIZE)
-
-ZUSW(:)=0.
-ZZW(:)=0.
-!$mnh_expand_where(JI=1:KSIZE)
-WHERE(GNEGT(:))
- ZZW(:)=ALOG(PT(:))
- ZUSW(:)=EXP(CST%XALPW - CST%XBETAW/PT(:) - CST%XGAMW*ZZW(:)) ! es_w
- ZZW(:)=EXP(CST%XALPI - CST%XBETAI/PT(:) - CST%XGAMI*ZZW(:)) ! es_i
-END WHERE
-!$mnh_end_expand_where(JI=1:KSIZE)
-
-ZSSI(:)=0.
-!$mnh_expand_where(JI=1:KSIZE)
-WHERE(GNEGT(:))
- ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
- ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (CST%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
-!$mnh_end_expand_where(JI=1:KSIZE)
-
-ZZW(:)=0.
-DO JI=1,KSIZE
- IF(GNEGT(JI)) THEN
- IF(PT(JI)<CST%XTT-5.0 .AND. ZSSI(JI)>0.0) THEN
- ZZW(JI)=ICEP%XNU20*EXP(ICEP%XALPHA2*ZSSI(JI)-ICEP%XBETA2)
- ELSEIF(PT(JI)<=CST%XTT-2.0 .AND. PT(JI)>=CST%XTT-5.0 .AND. ZSSI(JI)>0.0) THEN
- ZZW(JI)=MAX(ICEP%XNU20*EXP(-ICEP%XBETA2 ), &
- ICEP%XNU10*EXP(-ICEP%XBETA1*(PT(JI)-CST%XTT))*(ZSSI(JI)/ZUSW(JI))**ICEP%XALPHA1)
- ENDIF
- ENDIF
-ENDDO
-!$mnh_expand_where(JI=1:KSIZE)
-WHERE(GNEGT(:))
- ZZW(:)=ZZW(:)-PCIT(:)
- ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
-END WHERE
-!$mnh_end_expand_where(JI=1:KSIZE)
-
-PRVHENI_MR(:)=0.
-!$mnh_expand_where(JI=1:KSIZE)
-WHERE(GNEGT(:))
- !
- !* 3.1.2 update the r_i and r_v mixing ratios
- !
- PRVHENI_MR(:)=MAX(ZZW(:), 0.0)*ICEP%XMNU0/PRHODREF(:)
- PRVHENI_MR(:)=MIN(PRVT(:), PRVHENI_MR(:))
-END WHERE
-!$mnh_end_expand_where(JI=1:KSIZE)
-!Limitation due to 0 crossing of temperature
-IF(PARAMI%LFEEDBACKT) THEN
- ZW(:)=0.
- !$mnh_expand_where(JI=1:KSIZE)
- WHERE(GNEGT(:))
- ZW(:)=MIN(PRVHENI_MR(:), &
- MAX(0., (CST%XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / &
- MAX(PRVHENI_MR(:), 1.E-20)
- END WHERE
- PRVHENI_MR(:)=PRVHENI_MR(:)*ZW(:)
- ZZW(:)=ZZW(:)*ZW(:)
- !$mnh_end_expand_where(JI=1:KSIZE)
-ENDIF
-!$mnh_expand_where(JI=1:KSIZE)
-WHERE(GNEGT(:))
- PCIT(:)=MAX(ZZW(:)+PCIT(:), PCIT(:))
-END WHERE
-!$mnh_end_expand_where(JI=1:KSIZE)
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION', 1, ZHOOK_HANDLE)
-END SUBROUTINE ICE4_NUCLEATION
-END MODULE MODE_ICE4_NUCLEATION
diff --git a/src/PHYEX/micro/mode_ice4_pack.f90 b/src/PHYEX/micro/mode_ice4_pack.f90
index 75e770993ad5fc77efcde4265e1a84413f31e580..e4db9d953c4720ca095270234dcf2cc57a8ec775 100644
--- a/src/PHYEX/micro/mode_ice4_pack.f90
+++ b/src/PHYEX/micro/mode_ice4_pack.f90
@@ -36,6 +36,7 @@ SUBROUTINE ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
!! MODIFICATIONS
!! -------------
!! R. El Khatib 28-Apr-2023 Fix (and re-enable) the cache-blocking mechanism on top of phyex
+!! S. Riette Sept 23: all 3D arrays are suppressed from ice4_stepping
! -----------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -168,6 +169,7 @@ REAL, DIMENSION(KPROMA) :: &
& ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
& ZHLI_HCF, &
& ZHLI_HRI, &
+ & ZRAINFR, &
& ZRREVAV
REAL, DIMENSION(KSIZE2) :: ZSIGMA_RC ! Standard deviation of rc at time t
LOGICAL, DIMENSION(KPROMA) :: LLMICRO
@@ -205,16 +207,6 @@ LLSIGMA_RC=(PARAMI%CSUBG_AUCV_RC=='PDF ' .AND. PARAMI%CSUBG_PR_PDF=='SIGM')
LL_AUCV_ADJU=(PARAMI%CSUBG_AUCV_RC=='ADJU' .OR. PARAMI%CSUBG_AUCV_RI=='ADJU')
!
IF(PARAMI%LPACK_MICRO) THEN
- IF(KPROMA /= KSIZE .AND. (PARAMI%CSUBG_RR_EVAP=='PRFR' .OR. PARAMI%CSUBG_RC_RR_ACCR=='PRFR')) THEN
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'For now, KPROMA must be equal to KSIZE, see comments in code for explanation')
- ! Microphyscs was optimized by introducing chunks of KPROMA size
- ! Thus, in ice4_tendencies, the 1D array represent only a fraction of the points where microphysical species are present
- ! We cannot rebuild the entire 3D arrays in the subroutine, so we cannot call ice4_rainfr_vert in it
- ! 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
- ENDIF
- !
IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
DO JV=1, IBUNUM-IBUNUM_EXTRA
ZBU_PACK(:, JV)=0.
@@ -295,6 +287,7 @@ IF(PARAMI%LPACK_MICRO) THEN
ZHLI_HCF(IC) = PHLI_HCF(JIJ, JK)
ZHLI_HRI(IC) = PHLI_HRI(JIJ, JK)
ENDIF
+ ZRAINFR(IC)=PRAINFR(JIJ, JK)
IF (OELEC) ZLATHAM_IAGGS(IC) = PLATHAM_IAGGS(JIJ, JK)
! Save indices for later usages:
I1(IC) = JIJ
@@ -340,7 +333,7 @@ IF(PARAMI%LPACK_MICRO) THEN
&ZCIT, &
&ZVART, &
&ZHLC_HCF, ZHLC_HRC, &
- &ZHLI_HCF, ZHLI_HRI, PRAINFR, &
+ &ZHLI_HCF, ZHLI_HRI, ZRAINFR, &
&ZEXTPK, ZBU_SUM, ZRREVAV, &
&ZLATHAM_IAGGS)
!
@@ -361,6 +354,7 @@ IF(PARAMI%LPACK_MICRO) THEN
IF (KRR==7) THEN
PWR(I1(JL),I2(JL),IRH)=ZVART(JL, IRH)
ENDIF
+ PRAINFR(I1(JL),I2(JL))=ZRAINFR(JL)
ENDDO
IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
DO JV=1, IBUNUM-IBUNUM_EXTRA
diff --git a/src/PHYEX/micro/mode_ice4_rainfr_vert.f90 b/src/PHYEX/micro/mode_ice4_rainfr_vert.f90
index 43d8410c8399c909602dc320f6479bf76ef6584a..ec35f0da57fb15ee58f57dc1322c43810e4665bb 100644
--- a/src/PHYEX/micro/mode_ice4_rainfr_vert.f90
+++ b/src/PHYEX/micro/mode_ice4_rainfr_vert.f90
@@ -20,6 +20,7 @@ SUBROUTINE ICE4_RAINFR_VERT(D, ICED, PPRFR, PRR, PRS, PRG, PRH)
!! -------------
!!
! P. Wautelet 13/02/2019: bugfix: intent of PPRFR OUT->INOUT
+! S. Riette 21/9/23: collapse JI/JJ
!
!
!* 0. DECLARATIONS
@@ -33,19 +34,19 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
-TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRR !Rain field
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRS !Snow field
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRG !Graupel field
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRH !Hail field
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRH !Hail field
!
-INTEGER :: IKB, IKE, IKL, IIE, IIB, IJB, IJE
+INTEGER :: IKB, IKE, IKL, IIJB, IIJE
!* 0.2 declaration of local variables
!
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
-INTEGER :: JI, JJ, JK
+INTEGER :: JIJ, JK
LOGICAL :: MASK
!
!-------------------------------------------------------------------------------
@@ -54,32 +55,28 @@ IF (LHOOK) CALL DR_HOOK('ICE4_RAINFR_VERT',0,ZHOOK_HANDLE)
IKB=D%NKB
IKE=D%NKE
IKL=D%NKL
-IIB=D%NIB
-IIE=D%NIE
-IJB=D%NJB
-IJE=D%NJE
+IIJB=D%NIJB
+IIJE=D%NIJE
!
!-------------------------------------------------------------------------------
-DO JI = IIB,IIE
- DO JJ = IJB, IJE
- PPRFR(JI,JJ,IKE)=0.
- DO JK=IKE-IKL, IKB, -IKL
- IF(PRESENT(PRH)) THEN
- MASK=PRR(JI,JJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. ICED%XRTMIN(5) &
- .OR. PRG(JI,JJ,JK) .GT. ICED%XRTMIN(6) .OR. PRH(JI,JJ,JK) .GT. ICED%XRTMIN(7)
- ELSE
- MASK=PRR(JI,JJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. ICED%XRTMIN(5) &
- .OR. PRG(JI,JJ,JK) .GT. ICED%XRTMIN(6)
+DO JIJ = IIJB,IIJE
+ PPRFR(JIJ,IKE)=0.
+ DO JK=IKE-IKL, IKB, -IKL
+ IF(PRESENT(PRH)) THEN
+ MASK=PRR(JIJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JIJ,JK) .GT. ICED%XRTMIN(5) &
+ .OR. PRG(JIJ,JK) .GT. ICED%XRTMIN(6) .OR. PRH(JIJ,JK) .GT. ICED%XRTMIN(7)
+ ELSE
+ MASK=PRR(JIJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JIJ,JK) .GT. ICED%XRTMIN(5) &
+ .OR. PRG(JIJ,JK) .GT. ICED%XRTMIN(6)
+ END IF
+ IF (MASK) THEN
+ PPRFR(JIJ,JK)=MAX(PPRFR(JIJ,JK),PPRFR(JIJ,JK+IKL))
+ IF (PPRFR(JIJ,JK)==0.) THEN
+ PPRFR(JIJ,JK)=1.
END IF
- IF (MASK) THEN
- PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+IKL))
- IF (PPRFR(JI,JJ,JK)==0) THEN
- PPRFR(JI,JJ,JK)=1.
- END IF
- ELSE
- PPRFR(JI,JJ,JK)=0.
- END IF
- END DO
+ ELSE
+ PPRFR(JIJ,JK)=0.
+ END IF
END DO
END DO
!
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation.f90 b/src/PHYEX/micro/mode_ice4_sedimentation.f90
index 52d72c4e3e7ac0a51c50faf09f071ff1af79964d..82508848aa3eb880dc9b30c60e8f6bd88eab0364 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation.f90
@@ -7,7 +7,7 @@ MODULE MODE_ICE4_SEDIMENTATION
IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, BUCONF, &
- &OELEC, OSEDIM_BEARD, PTSTEP, KRR, PDZZ, &
+ &OELEC, OSEDIM_BEARD, HCLOUD, PTSTEP, KRR, PDZZ, PTHVREFZIKB, &
&PLVFACT, PLSFACT, PRHODREF, PPABST, PTHT, PT, PRHODJ, &
&PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRS, PINPRG, &
@@ -67,6 +67,7 @@ TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electric
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
LOGICAL, INTENT(IN) :: OELEC ! switch to activate cloud electrification
LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! Switch for effect of electrical forces on sedim.
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -95,6 +96,7 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS ! Snow ins
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!
! variables for cloud electricity
!
@@ -184,7 +186,7 @@ IF(PARAMI%CSEDIM=='STAT') THEN
!No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
ELSEIF(PARAMI%CSEDIM=='SPLI') THEN
CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
- &OELEC, OSEDIM_BEARD, PTSTEP, KRR, PDZZ, &
+ &OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, PTSTEP, KRR, PDZZ, &
&PRHODREF, PPABST, PTHT, PT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_split.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
index 829cb2189c7c2a85a945f7338cec1380437451d2..0e888959a8b20d3fad53d8d6c6e2a588ed1f49ba 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
@@ -7,7 +7,8 @@ MODULE MODE_ICE4_SEDIMENTATION_SPLIT
IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
- &OELEC, OSEDIM_BEARD, PTSTEP, KRR, PDZZ, &
+ &OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, &
+ &PTSTEP, KRR, PDZZ, &
&PRHODREF, PPABST, PTHT, PT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
@@ -62,6 +63,7 @@ TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electricity is activated
LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! if true, effect of electrical forces on sedim.
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
@@ -107,7 +109,7 @@ REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQ
REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGS ! Graupel electric charge source
REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail electric charge source
REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! Vertical E field
-!
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!* 0.2 declaration of local variables
!
!
@@ -389,13 +391,14 @@ CHARACTER(LEN=10) :: YSPE ! String for error message
INTEGER :: JIJ, JK
LOGICAL :: GPRESENT_PFPR
REAL :: ZINVTSTEP
-REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
+REAL :: ZZWLBDC, ZZRAY, ZZT, ZZWLBDA, ZZCC
REAL :: ZLBDA
REAL :: ZFSED, ZEXSED
REAL :: ZMRCHANGE
REAL, DIMENSION(D%NIJT) :: ZMAX_TSTEP ! Maximum CFL in column
REAL, DIMENSION(SIZE(ICED%XRTMIN)) :: ZRSMIN
REAL, DIMENSION(D%NIJT) :: ZREMAINT ! Remaining time until the timestep end
+LOGICAL :: ZANYREMAINT
REAL, DIMENSION(D%NIJT, 0:D%NKT+1) :: ZWSED ! Sedimentation fluxes
INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
@@ -445,11 +448,12 @@ END IF
!
PINPRX(:) = 0.
ZINVTSTEP=1./PTSTEP
-ZRSMIN(:) = ICED%XRTMIN(:) * ZINVTSTEP
+ZRSMIN = ICED%XRTMIN * ZINVTSTEP
ZREMAINT(:) = 0.
ZREMAINT(:) = PTSTEP
!
-DO WHILE (ANY(ZREMAINT>0.))
+ZANYREMAINT = .TRUE.
+DO WHILE (ZANYREMAINT)
!
! Effect of electrical forces on sedimentation
IF (OELEC .AND. OSEDIM_BEARD) THEN
@@ -483,10 +487,10 @@ DO WHILE (ANY(ZREMAINT>0.))
ZZWLBDC = PLBC(JIJ,JK) * PCONC3D(JIJ,JK) / &
&(PRHODREF(JIJ,JK) * PRXT(JIJ,JK))
ZZWLBDC = ZZWLBDC**ICED%XLBEXC
- ZRAY = PRAY(JIJ,JK) / ZZWLBDC
+ ZZRAY = PRAY(JIJ,JK) / ZZWLBDC
ZZT = PTHT(JIJ,JK) * (PPABST(JIJ,JK)/CST%XP00)**(CST%XRD/CST%XCPD)
ZZWLBDA = 6.6E-8*(101325./PPABST(JIJ,JK))*(ZZT/293.15)
- ZZCC = ICED%XCC*(1.+1.26*ZZWLBDA/ZRAY)
+ ZZCC = ICED%XCC*(1.+1.26*ZZWLBDA/ZZRAY)
ZWSED(JIJ, JK) = PRHODREF(JIJ,JK)**(-ICED%XCEXVT +1 ) * &
&ZZWLBDC**(-ICED%XDC)*ZZCC*PFSEDC(JIJ,JK) * PRXT(JIJ,JK)
!++cb++ nouveau : traitement de la sedimentation des charges portees par les gouttelettes
@@ -505,7 +509,8 @@ DO WHILE (ANY(ZREMAINT>0.))
ENDDO
ENDDO
IF (OELEC .AND. OSEDIM_BEARD) THEN
- CALL ELEC_BEARD_EFFECT(D, KSPE, GMASK, PT, PRHODREF, PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB, &
+ PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
@@ -548,7 +553,8 @@ DO WHILE (ANY(ZREMAINT>0.))
ENDDO
ENDDO
IF (OELEC .AND. OSEDIM_BEARD) THEN
- CALL ELEC_BEARD_EFFECT(D, KSPE, GMASK, PT, PRHODREF, PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB, &
+ PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
@@ -556,8 +562,6 @@ DO WHILE (ANY(ZREMAINT>0.))
END DO
END DO
END IF
-#ifdef REPRO48
-#else
ELSEIF(KSPE==5) THEN
! ******* for snow
ZWSED(:,:) = 0.
@@ -565,6 +569,19 @@ DO WHILE (ANY(ZREMAINT>0.))
ZWSEDQ(:,:) = 0.
ZLBDA3(:,:) = 0.
END IF
+#ifdef REPRO48
+ !The following lines must be kept equal to the computation in the general case ("for other species" case below)
+ ZFSED=ICEP%XFSEDS
+ ZEXSED=ICEP%XEXSEDS
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ IF(PRXT(JIJ,JK)>ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
+ ZWSED(JIJ, JK) = ZFSED * PRXT(JIJ, JK)**ZEXSED &
+ & * PRHODREF(JIJ, JK)**(ZEXSED-ICED%XCEXVT)
+ ENDIF
+ ENDDO
+ ENDDO
+#else
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
IF(PRXT(JIJ,JK)> ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
@@ -594,7 +611,8 @@ DO WHILE (ANY(ZREMAINT>0.))
ENDDO
ENDDO
IF (OELEC .AND. OSEDIM_BEARD) THEN
- CALL ELEC_BEARD_EFFECT(D, KSPE, GMASK, PT, PRHODREF, PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB,&
+ PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
@@ -609,12 +627,6 @@ DO WHILE (ANY(ZREMAINT>0.))
CASE(3)
ZFSED=ICEP%XFSEDR
ZEXSED=ICEP%XEXSEDR
-#ifdef REPRO48
- CASE(5)
- ZFSED=ICEP%XFSEDS
- ZEXSED=ICEP%XEXSEDS
-#else
-#endif
CASE(6)
ZFSED=ICEP%XFSEDG
ZEXSED=ICEP%XEXSEDG
@@ -692,7 +704,8 @@ DO WHILE (ANY(ZREMAINT>0.))
ENDDO
ENDDO
IF (OELEC .AND. OSEDIM_BEARD) THEN
- CALL ELEC_BEARD_EFFECT(D, KSPE, GMASK, PT, PRHODREF, PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB, &
+ PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
@@ -731,7 +744,13 @@ DO WHILE (ANY(ZREMAINT>0.))
ENDIF
ENDDO
ENDDO
-!
+ !
+ ZANYREMAINT = .FALSE.
+ DO JIJ=IIJB,IIJE
+ IF(ZREMAINT(JIJ)>0.) THEN
+ ZANYREMAINT = .TRUE.
+ END IF
+ END DO
END DO
!
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 1, ZHOOK_HANDLE)
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
index 60c599a483638c4ae09548075ad1248d20b51fc0..379a1ff26e88da2a65d3b9ee75ad6a6e0cd2530e 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
@@ -90,17 +90,12 @@ REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-ai
LOGICAL :: LLSEA_AND_TOWN
INTEGER :: JRR, JIJ, JK, IKB, IKE,IKL, IIJB, IIJE, IKTB, IKTE
INTEGER :: ISHIFT, IK, IKPLUS
-REAL :: ZQP, ZINVTSTEP, ZGAC, ZGC, ZGAC2, ZGC2, ZRAYDEFO, ZLBDAS
-REAL, DIMENSION(D%NIJT) :: ZWSEDW1, ZWSEDW2 ! sedimentation speed
+REAL :: ZINVTSTEP, ZGAC, ZGC, ZGAC2, ZGC2, ZRAYDEFO
REAL, DIMENSION(D%NIJT) :: ZTSORHODZ ! TimeStep Over (Rhodref times delta Z)
REAL, DIMENSION(D%NIJT,0:1,2:KRR) :: ZSED ! sedimentation flux array for each species and for above and current levels
-REAL :: FWSED1, FWSED2, PWSEDW, PWSEDWSUP, PINVTSTEP, PTSTEP1, PDZZ1, PRHODREF1, PRXT1
-
+!
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
-FWSED1(PWSEDW,PTSTEP1,PDZZ1,PRHODREF1,PRXT1,PINVTSTEP)=MIN(PRHODREF1*PDZZ1*PRXT1*PINVTSTEP,PWSEDW*PRHODREF1*PRXT1)
-FWSED2(PWSEDW,PTSTEP1,PDZZ1,PWSEDWSUP)=MAX(0.,1.-PDZZ1/(PTSTEP1*PWSEDW))*PWSEDWSUP
-
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT',0,ZHOOK_HANDLE)
!
@@ -244,6 +239,9 @@ CONTAINS
REAL :: ZCONC3D ! droplet condensation
REAL :: ZRAY ! Cloud Mean radius
REAL :: ZZWLBDA, ZZWLBDC, ZZCC
+ INTEGER :: JIJ
+ REAL :: ZQP
+ REAL :: ZWSEDW1, ZWSEDW2
!!REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
@@ -270,28 +268,28 @@ CONTAINS
ZZWLBDA=6.6E-8*(101325./PPABST(JIJ,JK))*(PTHT(JIJ,JK)/293.15)
ZZWLBDC=(ZLBC*ZCONC3D/(PRHODREF(JIJ,JK)*PRXT(JIJ)))**ICED%XLBEXC
ZZCC=ICED%XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY) !! ZCC : Fall speed
- ZWSEDW1(JIJ)=PRHODREF(JIJ,JK)**(-ICED%XCEXVT ) * ZZWLBDC**(-ICED%XDC)*ZZCC*ZFSEDC
+ ZWSEDW1=PRHODREF(JIJ,JK)**(-ICED%XCEXVT ) * ZZWLBDC**(-ICED%XDC)*ZZCC*ZFSEDC
ELSE
- ZWSEDW1(JIJ)=0.
+ ZWSEDW1=0.
ENDIF
IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
ZZWLBDA=6.6E-8*(101325./PPABST(JIJ,JK))*(PTHT(JIJ,JK)/293.15)
ZZWLBDC=(ZLBC*ZCONC3D/(PRHODREF(JIJ,JK)*ZQP))**ICED%XLBEXC
ZZCC=ICED%XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY) !! ZCC : Fall speed
- ZWSEDW2(JIJ)=PRHODREF(JIJ,JK)**(-ICED%XCEXVT ) * ZZWLBDC**(-ICED%XDC)*ZZCC*ZFSEDC
+ ZWSEDW2=PRHODREF(JIJ,JK)**(-ICED%XCEXVT ) * ZZWLBDC**(-ICED%XDC)*ZZCC*ZFSEDC
ELSE
- ZWSEDW2(JIJ)=0.
+ ZWSEDW2=0.
ENDIF
ELSE
- ZWSEDW1(JIJ)=0.
- ZWSEDW2(JIJ)=0.
+ ZWSEDW1=0.
+ ZWSEDW2=0.
ENDIF
!- duplicated code -------------------------------------------------------------------------
- IF (ZWSEDW2(JIJ) /= 0.) THEN
- ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
- & + FWSED2(ZWSEDW2(JIJ),PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
+ IF (ZWSEDW2 /= 0.) THEN
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1,PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2,PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
ELSE
- ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1,PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
ENDIF
!-------------------------------------------------------------------------------------------
ENDDO
@@ -303,6 +301,9 @@ CONTAINS
SUBROUTINE PRISTINE_ICE(PRXT)
REAL, INTENT(IN) :: PRXT(D%NIJT) ! mr of specy X
+ INTEGER :: JIJ
+ REAL :: ZQP
+ REAL :: ZWSEDW1, ZWSEDW2
!!REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
@@ -314,31 +315,31 @@ CONTAINS
IF ((PRXT(JIJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
!calculation of w
IF ( PRXT(JIJ) > MAX(ICED%XRTMIN(JRR),1.0E-7 ) ) THEN
- ZWSEDW1(JIJ)= ICEP%XFSEDI * &
+ ZWSEDW1= ICEP%XFSEDI * &
& PRHODREF(JIJ,JK)**(-ICED%XCEXVT) * & ! McF&H
& MAX( 0.05E6,-0.15319E6-0.021454E6* &
& ALOG(PRHODREF(JIJ,JK)*PRXT(JIJ)) )**ICEP%XEXCSEDI
ELSE
- ZWSEDW1(JIJ)=0.
+ ZWSEDW1=0.
ENDIF
IF ( ZQP > MAX(ICED%XRTMIN(JRR),1.0E-7 ) ) THEN
- ZWSEDW2(JIJ)= ICEP%XFSEDI * &
+ ZWSEDW2= ICEP%XFSEDI * &
& PRHODREF(JIJ,JK)**(-ICED%XCEXVT) * & ! McF&H
& MAX( 0.05E6,-0.15319E6-0.021454E6* &
& ALOG(PRHODREF(JIJ,JK)*ZQP) )**ICEP%XEXCSEDI
ELSE
- ZWSEDW2(JIJ)=0.
+ ZWSEDW2=0.
ENDIF
ELSE
- ZWSEDW1(JIJ)=0.
- ZWSEDW2(JIJ)=0.
+ ZWSEDW1=0.
+ ZWSEDW2=0.
ENDIF
!- duplicated code -------------------------------------------------------------------------
- IF (ZWSEDW2(JIJ) /= 0.) THEN
- ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
- & + FWSED2(ZWSEDW2(JIJ),PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
+ IF (ZWSEDW2 /= 0.) THEN
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1,PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2,PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
ELSE
- ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1,PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
ENDIF
!-------------------------------------------------------------------------------------------
ENDDO
@@ -350,6 +351,9 @@ CONTAINS
SUBROUTINE SNOW(PRXT)
REAL, INTENT(IN) :: PRXT(D%NIJT) ! mr of specy X
+ INTEGER :: JIJ
+ REAL :: ZQP, ZLBDAS
+ REAL :: ZWSEDW1, ZWSEDW2
!!REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
@@ -371,31 +375,31 @@ CONTAINS
END IF
!calculation of w
IF ( PRXT(JIJ) > ICED%XRTMIN(JRR) ) THEN
- ZWSEDW1(JIJ)= ICEP%XFSEDS * &
+ ZWSEDW1= ICEP%XFSEDS * &
& PRHODREF(JIJ,JK)**(-ICED%XCEXVT) * &
& (1+(ICED%XFVELOS/ZLBDAS)**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS)* &
& ZLBDAS**(ICED%XBS+ICEP%XEXSEDS)
ELSE
- ZWSEDW1(JIJ)=0.
+ ZWSEDW1=0.
ENDIF
IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
- ZWSEDW2(JIJ)= ICEP%XFSEDS * &
+ ZWSEDW2= ICEP%XFSEDS * &
& PRHODREF(JIJ,JK)**(-ICED%XCEXVT) * &
& (1+(ICED%XFVELOS/ZLBDAS)**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS)* &
& ZLBDAS**(ICED%XBS+ICEP%XEXSEDS)
ELSE
- ZWSEDW2(JIJ)=0.
+ ZWSEDW2=0.
ENDIF
ELSE
- ZWSEDW1(JIJ)=0.
- ZWSEDW2(JIJ)=0.
+ ZWSEDW1=0.
+ ZWSEDW2=0.
ENDIF
!- duplicated code -------------------------------------------------------------------------
- IF (ZWSEDW2(JIJ) /= 0.) THEN
- ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
- & + FWSED2(ZWSEDW2(JIJ),PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
+ IF (ZWSEDW2 /= 0.) THEN
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1,PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2,PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
ELSE
- ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1,PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
ENDIF
!-------------------------------------------------------------------------------------------
ENDDO
@@ -409,6 +413,9 @@ CONTAINS
REAL, INTENT(IN) :: PFSED
REAL, INTENT(IN) :: PEXSED
REAL, INTENT(IN) :: PRXT(D%NIJT) ! mr of specy X
+ INTEGER :: JIJ
+ REAL :: ZQP
+ REAL :: ZWSEDW1, ZWSEDW2
!!REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
@@ -420,25 +427,25 @@ CONTAINS
IF ((PRXT(JIJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
!calculation of w
IF ( PRXT(JIJ) > ICED%XRTMIN(JRR) ) THEN
- ZWSEDW1(JIJ)= PFSED *PRXT(JIJ)**(PEXSED-1)*PRHODREF(JIJ,JK)**(PEXSED-ICED%XCEXVT-1)
+ ZWSEDW1= PFSED *PRXT(JIJ)**(PEXSED-1)*PRHODREF(JIJ,JK)**(PEXSED-ICED%XCEXVT-1)
ELSE
- ZWSEDW1(JIJ)=0.
+ ZWSEDW1=0.
ENDIF
IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
- ZWSEDW2(JIJ)= PFSED *ZQP**(PEXSED-1)*PRHODREF(JIJ,JK)**(PEXSED-ICED%XCEXVT-1)
+ ZWSEDW2= PFSED *ZQP**(PEXSED-1)*PRHODREF(JIJ,JK)**(PEXSED-ICED%XCEXVT-1)
ELSE
- ZWSEDW2(JIJ)=0.
+ ZWSEDW2=0.
ENDIF
ELSE
- ZWSEDW1(JIJ)=0.
- ZWSEDW2(JIJ)=0.
+ ZWSEDW1=0.
+ ZWSEDW2=0.
ENDIF
!- duplicated code -------------------------------------------------------------------------
- IF (ZWSEDW2(JIJ) /= 0.) THEN
- ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
- & + FWSED2(ZWSEDW2(JIJ),PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
+ IF (ZWSEDW2 /= 0.) THEN
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1,PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2,PTSTEP,PDZZ(JIJ,JK),ZSED(JIJ,IKPLUS,JRR))
ELSE
- ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1(JIJ),PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
+ ZSED(JIJ,IK,JRR)=FWSED1(ZWSEDW1,PTSTEP,PDZZ(JIJ,JK),PRHODREF(JIJ,JK),PRXT(JIJ),ZINVTSTEP)
ENDIF
!-------------------------------------------------------------------------------------------
ENDDO
@@ -454,5 +461,21 @@ CONTAINS
ISHIFT=1-ISHIFT
END SUBROUTINE SHIFT
+!
+!
+ELEMENTAL FUNCTION FWSED1(PWSEDW,PTSTEP1,PDZZ1,PRHODREF1,PRXT1,PINVTSTEP) RESULT(PVAR)
+ REAL, INTENT(IN) :: PWSEDW,PTSTEP1,PDZZ1,PRHODREF1,PRXT1,PINVTSTEP
+ REAL :: PVAR
+! 5 multiplications only => cost = 5X
+ PVAR = MIN(PRHODREF1*PDZZ1*PRXT1*PINVTSTEP,PWSEDW*PRHODREF1*PRXT1)
+END FUNCTION FWSED1
+!
+ELEMENTAL FUNCTION FWSED2(PWSEDW,PTSTEP1,PDZZ1,PWSEDWSUP) RESULT(PVAR)
+ REAL, INTENT(IN) :: PWSEDW,PTSTEP1,PDZZ1,PWSEDWSUP
+ REAL :: PVAR
+ PVAR = MAX(0.,1.-PDZZ1/(PTSTEP1*PWSEDW))*PWSEDWSUP
+END FUNCTION FWSED2
+
END SUBROUTINE ICE4_SEDIMENTATION_STAT
+
END MODULE MODE_ICE4_SEDIMENTATION_STAT
diff --git a/src/PHYEX/micro/mode_ice4_stepping.f90 b/src/PHYEX/micro/mode_ice4_stepping.f90
index 2494a19afb24944ecd7ede51364ddd4d845a9ddc..06cd511afc949e9d8f27cf5c1df4c7e6be5c42c1 100644
--- a/src/PHYEX/micro/mode_ice4_stepping.f90
+++ b/src/PHYEX/micro/mode_ice4_stepping.f90
@@ -36,14 +36,15 @@ SUBROUTINE ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
!! MODIFICATIONS
!! -------------
!! R. El Khatib 03-May-2023 Replace OMP SIMD loops by explicit loops : more portable and even slightly faster
+!! S. Riette Sept 23: 3D arrays suppressed from ice4_tendencies
! -----------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_BUDGET, ONLY: TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
@@ -98,10 +99,10 @@ REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HRC
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HCF
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HRI
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRAINFR
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRAINFR
REAL, DIMENSION(KPROMA,0:7), INTENT(INOUT) :: PEXTPK !To take into acount external tendencies inside the splitting
REAL, DIMENSION(KPROMA, IBUNUM-IBUNUM_EXTRA),INTENT(OUT) :: PBU_SUM
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRREVAV
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRREVAV
REAL, DIMENSION(MERGE(KPROMA,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
! enhancement of IAGGS
!
@@ -257,7 +258,7 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
!
!
! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
- CALL ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ CALL ICE4_TENDENCIES(CST, PARAMI, ICEP, ICED, BUCONF, &
&KPROMA, KMICRO, &
&KRR, LSOFT, LLCOMPUTE, &
&OSAVE_MICRO, OELEC, &
@@ -318,6 +319,7 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
DO JL=1, KMICRO
IF (ZA(JL, JV) < -1.E-20 .AND. PVART(JL, JV) > ICED%XRTMIN(JV)) THEN
ZMAXTIME(JL)=MIN(ZMAXTIME(JL), -(ZB(JL, JV)+PVART(JL, JV))/ZA(JL, JV))
+ ZMAXTIME(JL)=MAX(ZMAXTIME(JL), CST%XMNH_TINY) !to prevent rounding errors
ENDIF
ENDDO
ENDDO
diff --git a/src/PHYEX/micro/mode_ice4_tendencies.f90 b/src/PHYEX/micro/mode_ice4_tendencies.f90
index 611c82c1548a01a526448410c7f2d8b775bbaf86..215030e7a9e4f4d5bf545649e2389033a48fee7d 100644
--- a/src/PHYEX/micro/mode_ice4_tendencies.f90
+++ b/src/PHYEX/micro/mode_ice4_tendencies.f90
@@ -6,7 +6,7 @@
MODULE MODE_ICE4_TENDENCIES
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
+SUBROUTINE ICE4_TENDENCIES(CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
&KRR, ODSOFT, LDCOMPUTE, &
&OSAVE_MICRO, OELEC, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, &
@@ -41,7 +41,6 @@ SUBROUTINE ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
! ------------
!
USE MODD_BUDGET, ONLY: TBUDGETCONF_t
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
@@ -52,14 +51,12 @@ USE MODE_ICE4_RRHONG, ONLY: ICE4_RRHONG
USE MODE_ICE4_RIMLTC, ONLY: ICE4_RIMLTC
USE MODE_ICE4_RSRIMCG_OLD, ONLY: ICE4_RSRIMCG_OLD
USE MODE_ICE4_COMPUTE_PDF, ONLY: ICE4_COMPUTE_PDF
-USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
USE MODE_ICE4_SLOW, ONLY: ICE4_SLOW
USE MODE_ICE4_WARM, ONLY: ICE4_WARM
USE MODE_ICE4_FAST_RS, ONLY: ICE4_FAST_RS
USE MODE_ICE4_FAST_RG, ONLY: ICE4_FAST_RG
USE MODE_ICE4_FAST_RH, ONLY: ICE4_FAST_RH
USE MODE_ICE4_FAST_RI, ONLY: ICE4_FAST_RI
-USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
!
USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
@@ -67,7 +64,6 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
@@ -99,26 +95,26 @@ REAL, DIMENSION(KPROMA, 10), INTENT(INOUT) :: PRH_TEND
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PSSI
REAL, DIMENSION(KPROMA,0:7), INTENT(OUT) :: PA
REAL, DIMENSION(KPROMA,0:7), INTENT(OUT) :: PB
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HCF
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LCF
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HRC
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LRC
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LCF
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HRI
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LRI
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HRC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LRC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HRI
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LRI
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRAINFR ! Rain fraction
!
!* 0.2 declaration of local variables
!
REAL, DIMENSION(KPROMA,0:KRR) :: ZVART
-REAL, DIMENSION(KPROMA) :: ZT, ZRAINFR, &
+REAL, DIMENSION(KPROMA) :: ZT, &
& ZKA, ZDV, ZAI, ZCJ, &
& ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZLBDAR_RF, &
- & ZRGSI, ZRGSI_MR
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZRRT3D, ZRST3D, ZRGT3D, ZRHT3D
+ & ZRGSI, ZRGSI_MR, ZRAINFR
INTEGER :: JL, JV
LOGICAL, DIMENSION(KPROMA) :: LLWETG ! .TRUE. if graupel growths in wet mode
+LOGICAL :: LLMASK
REAL :: ZZW
LOGICAL :: LLRFR
!
@@ -144,10 +140,12 @@ ELSE
!
!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
! --------------------------------------
- CALL ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, KSIZE, LDCOMPUTE(:), &
- ZVART(:,ITH), PPRES(:), PRHODREF(:), PEXN(:), PLSFACT(:), ZT(:), &
- ZVART(:,IRV), &
- PCIT(:), PBU_INST(:, IRVHENI_MR))
+ DO JL=1, KSIZE
+ CALL ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, LDCOMPUTE(JL), &
+ ZVART(JL,ITH), PPRES(JL), PRHODREF(JL), PEXN(JL), PLSFACT(JL), ZT(JL), &
+ ZVART(JL,IRV), &
+ PCIT(JL), PBU_INST(JL, IRVHENI_MR))
+ ENDDO
DO JL=1, KSIZE
ZVART(JL,ITH)=ZVART(JL,ITH) + PBU_INST(JL, IRVHENI_MR)*PLSFACT(JL)
ZT(JL) = ZVART(JL,ITH) * PEXN(JL)
@@ -252,39 +250,31 @@ ENDIF ! ODSOFT
!
!Cloud water split between high and low content part is done here
CALL ICE4_COMPUTE_PDF(CST, ICEP, ICED, KSIZE, PARAMI%CSUBG_AUCV_RC, PARAMI%CSUBG_AUCV_RI, PARAMI%CSUBG_PR_PDF,&
- PRHODREF, ZVART(:,IRC), ZVART(:,IRI), PCF, ZT, PSIGMA_RC, &
+ LDCOMPUTE, PRHODREF, ZVART(:,IRC), ZVART(:,IRI), PCF, ZT, PSIGMA_RC, &
PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, ZRAINFR)
LLRFR=PARAMI%CSUBG_RC_RR_ACCR=='PRFR' .OR. PARAMI%CSUBG_RR_EVAP=='PRFR'
IF (LLRFR) THEN
- !Diagnostic of precipitation fraction
- PRAINFR(:,:) = 0.
- ZRRT3D (:,:) = 0.
- ZRST3D (:,:) = 0.
- ZRGT3D (:,:) = 0.
- ZRHT3D (:,:) = 0.
- DO JL=1,KSIZE
- PRAINFR(K1(JL), K2(JL)) = ZRAINFR(JL)
- ZRRT3D (K1(JL), K2(JL)) = ZVART(JL,IRR)
- ZRST3D (K1(JL), K2(JL)) = ZVART(JL,IRS)
- ZRGT3D (K1(JL), K2(JL)) = ZVART(JL,IRG)
- END DO
- IF (KRR==7) THEN
- DO JL=1,KSIZE
- ZRHT3D (K1(JL), K2(JL)) = ZVART(JL,IRH)
- ENDDO
- CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR(:,:), &
- &ZRRT3D(:,:), ZRST3D(:,:), ZRGT3D(:,:), ZRHT3D(:,:))
- ELSE
- CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR(:,:), &
- &ZRRT3D(:,:), ZRST3D(:,:), ZRGT3D(:,:))
- ENDIF
- DO JL=1,KSIZE
- ZRAINFR(JL)=PRAINFR(K1(JL), K2(JL))
- END DO
+ !To be exact, ICE4_RAINFR_VERT should be called here with the updated PRAINFR
+ !But this call would require the full 3D arrays for rain, snow and graupel which
+ !are not available here (due to separation between 1D and 3D computation for GPU).
+ !
+ !We replace the full computation by a small update to ensure consistency
+ DO JL=1, KSIZE
+ PRAINFR(JL)=MAX(PRAINFR(JL), ZRAINFR(JL))
+ IF(KRR==7) THEN
+ LLMASK=ZVART(JL,IRR) .GT. ICED%XRTMIN(3) .OR. ZVART(JL,IRS) .GT. ICED%XRTMIN(5) .OR. &
+ &ZVART(JL,IRG) .GT. ICED%XRTMIN(6) .OR. ZVART(JL,IRH) .GT. ICED%XRTMIN(7)
+ ELSE
+ LLMASK=ZVART(JL,IRR) .GT. ICED%XRTMIN(3) .OR. ZVART(JL,IRS) .GT. ICED%XRTMIN(5) .OR. &
+ &ZVART(JL,IRG) .GT. ICED%XRTMIN(6)
+ ENDIF
+ IF(LLMASK .AND. PRAINFR(JL)==0.) THEN
+ PRAINFR(JL)=1.
+ ENDIF
+ ENDDO
ELSE
- PRAINFR(:,:)=1.
- ZRAINFR(:)=1.
+ PRAINFR(:)=1.
ENDIF
!
!* compute the slope parameters
@@ -298,8 +288,8 @@ DO JL=1, KSIZE
ENDIF
!ZLBDAR_RF is used when we consider rain concentrated in its fraction
IF(LLRFR) THEN
- IF(ZVART(JL,IRR)>0. .AND. ZRAINFR(JL)>0.) THEN
- ZLBDAR_RF(JL)=ICED%XLBR*(PRHODREF(JL)*MAX(ZVART(JL,IRR)/ZRAINFR(JL), ICED%XRTMIN(3)))**ICED%XLBEXR
+ IF(ZVART(JL,IRR)>0. .AND. PRAINFR(JL)>0.) THEN
+ ZLBDAR_RF(JL)=ICED%XLBR*(PRHODREF(JL)*MAX(ZVART(JL,IRR)/PRAINFR(JL), ICED%XRTMIN(3)))**ICED%XLBEXR
ELSE
ZLBDAR_RF(JL)=0.
ENDIF
@@ -358,7 +348,7 @@ IF(PARAMI%LWARM) THEN ! Check if the formation of the raindrops by the slow
&PRHODREF, PLVFACT, ZT, PPRES, ZVART(:,ITH),&
&ZLBDAR, ZLBDAR_RF, ZKA, ZDV, ZCJ, &
&PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
- &PCF, ZRAINFR, &
+ &PCF, PRAINFR, &
&ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRR), &
&PBU_INST(:, IRCAUTR), PBU_INST(:, IRCACCR), PBU_INST(:, IRREVAV))
ELSE
@@ -567,5 +557,7 @@ ENDDO
!
IF (LHOOK) CALL DR_HOOK('ICE4_TENDENCIES', 1, ZHOOK_HANDLE)
!
+CONTAINS
+INCLUDE "ice4_nucleation.func.h"
END SUBROUTINE ICE4_TENDENCIES
END MODULE MODE_ICE4_TENDENCIES
diff --git a/src/PHYEX/micro/mode_ice4_warm.f90 b/src/PHYEX/micro/mode_ice4_warm.f90
index edcb2e465f5c8470b0aafddc8a80d19dd77de3c1..0ad459b1975c7394c1d127da483890e6f62ea15d 100644
--- a/src/PHYEX/micro/mode_ice4_warm.f90
+++ b/src/PHYEX/micro/mode_ice4_warm.f90
@@ -135,7 +135,7 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
IF(LMASK1) THEN
!Accretion due to rain falling in high cloud content
!HCF*accretion(HRC/HCF) with simplification
- PRCACCR(:) = ICEP%XFCACCR * PHLC_HRC(JL) &
+ PRCACCR(JL) = ICEP%XFCACCR * PHLC_HRC(JL) &
&*PLBDAR_RF(JL)**ICEP%XEXCACCR &
&*PRHODREF(JL)**(-ICED%XCEXVT)
ELSE
diff --git a/src/PHYEX/micro/mode_icecloud.f90 b/src/PHYEX/micro/mode_icecloud.f90
index 5f44bf9a07a50a38d50f8df88cba054496f40e19..cbfcde5ca782d164b527fd773e3c50ea6bb5cb30 100644
--- a/src/PHYEX/micro/mode_icecloud.f90
+++ b/src/PHYEX/micro/mode_icecloud.f90
@@ -106,14 +106,11 @@ DO JIJ = IIJB, IIJE
SSIU(JIJ) = MIN(ZI2W,ZRHI)
SSIO(JIJ) = SSIU(JIJ)
W2D(JIJ) = 1.
-
IF (PT(JIJ)>273.1 .OR. ZR<=0. .OR. ESATI(PT(JIJ)) >= PP(JIJ)*0.5) THEN
SSIU(JIJ) = SSIU(JIJ) - 1.
SSIO(JIJ) = SSIU(JIJ)
IF(PWCLD(JIJ)>=0.) SIFRC(JIJ) = PWCLD(JIJ)
- CYCLE
- ENDIF
-
+ ELSE
ZRHIN = MAX(0.05, MIN(1.,ZRHW))
@@ -200,7 +197,7 @@ DO JIJ = IIJB, IIJE
SSIO(JIJ) = SSIO(JIJ) - 1.
IF (XW2D > 1.) W2D(JIJ) = 1./(1. - SIFRC(JIJ) + XW2D*SIFRC(JIJ))
-
+ END IF
ENDDO
IF (LHOOK) CALL DR_HOOK('ICECLOUD',1,ZHOOK_HANDLE)
diff --git a/src/PHYEX/micro/mode_ini_lima_cold_mixed.f90 b/src/PHYEX/micro/mode_ini_lima_cold_mixed.f90
index e8774847097e970a599f89335616b835b54b3c94..0f6c055af6426f00ebb763dc1a7bd4675aec260b 100644
--- a/src/PHYEX/micro/mode_ini_lima_cold_mixed.f90
+++ b/src/PHYEX/micro/mode_ini_lima_cold_mixed.f90
@@ -130,6 +130,8 @@ REAL :: ZBOUND_RDSF_RMIN ! XDCRLIM*Lbda_r : lower bound used in the tabulated
REAL :: ZRATE_R ! Geometrical growth of Lbda_r in the tabulated function
REAL :: ZKHI_LWM ! Coefficient of Lawson et al. (2015)
!
+REAL :: ZRHOIW ! ice density
+!
!-------------------------------------------------------------------------------
!
!
@@ -151,19 +153,73 @@ SELECT CASE (CPRISTINE_ICE_LIMA)
XBI = 2.5 ! Plates
XC_I = 747. ! Plates
XDI = 1.0 ! Plates
+ XGAMMAI = 0.096
+ XDELTAI = 1.83
XC1I = 1./XPI ! Plates
CASE('COLU')
XAI = 2.14E-3 ! Columns
XBI = 1.7 ! Columns
XC_I = 1.96E5 ! Columns
XDI = 1.585 ! Columns
+ XGAMMAI = 0.659
+ XDELTAI = 2.0
XC1I = 0.8 ! Columns
CASE('BURO')
XAI = 44.0 ! Bullet rosettes
XBI = 3.0 ! Bullet rosettes
XC_I = 4.E5 ! Bullet rosettes
XDI = 1.663 ! Bullet rosettes
+ XGAMMAI = 0.062
+ XDELTAI = 1.81
XC1I = 0.5 ! Bullet rosettes
+ CASE('YPLA')
+ XAI = 0.745 ! Plates_from Yang et al (2013)
+ XBI = 2.47 ! Plates_from Yang et al (2013)
+ XC_I = 63. ! Plates_from Yang et al (2013)
+ XDI = 0.68 ! Plates_from Yang et al (2013)
+ XGAMMAI = 0.096
+ XDELTAI = 1.83
+ XC1I = 1./XPI ! Plates_from Yang et al (2013)
+ CASE('YCOL')
+ XAI = 261.102 ! Columns_from Yang et al (2013)
+ XBI = 2.99 ! Columns_from Yang et al (2013)
+ XC_I = 671 ! Columns_from Yang et al (2013)
+ XDI = 0.62 ! Columns_from Yang et al (2013)
+ XGAMMAI = 0.659
+ XDELTAI = 2.0
+ XC1I = 0.8 ! Columns_from Yang et al (2013)
+ CASE('YBUR')
+ XAI = 1.268 ! Bullet rosettes_from Yang et al (2013)
+ XBI = 2.59 ! Bullet rosettes_from Yang et al (2013)
+ XC_I = 128 ! Bullet rosettes_from Yang et al (2013)
+ XDI = 0.72 ! Bullet rosettes_from Yang et al (2013)
+ XGAMMAI = 0.062
+ XDELTAI = 1.81
+ XC1I = 0.5 ! Bullet rosettes_from Yang et al (2013)
+ CASE('YDRO')
+ XAI = 1.268 ! Droxtals_from Yang et al (2013)
+ XBI = 2.59 ! Droxtals_from Yang et al (2013)
+ XC_I = 128 ! Droxtals_from Yang et al (2013)
+ XDI = 0.72 ! Droxtals_from Yang et al (2013)
+ XGAMMAI = 0.673
+ XDELTAI = 2.0
+ XC1I = 0.5 ! Droxtals_from Yang et al (2013)
+ CASE('YHCO')
+ XAI = 217.586 ! Hollow_Columns_from Yang et al (2013)
+ XBI = 2.99 ! Hollow_Columns_from Yang et al (2013)
+ XC_I = 641 ! Hollow_Columns_from Yang et al (2013)
+ XDI = 0.63 ! Hollow_Columns_from Yang et al (2013)
+ XGAMMAI = 0.659
+ XDELTAI = 2.0
+ XC1I = 0.8 ! Hollow_Columns_from Yang et al (2013)
+ CASE('YHBU')
+ XAI = 1.258 ! Hollow_Bullet rosettes_from Yang et al (2013)
+ XBI = 2.61 ! Hollow_Bullet rosettes_from Yang et al (2013)
+ XC_I = 147 ! Hollow_Bullet rosettes_from Yang et al (2013)
+ XDI = 0.73 ! Hollow_Bullet rosettes_from Yang et al (2013)
+ XGAMMAI = 0.061
+ XDELTAI = 1.81
+ XC1I = 0.5 ! Hollow_Bullet rosettes_from Yang et al (2013)
END SELECT
!
! Note that XCCI=N_i (a locally predicted value) and XCXI=0.0, implicitly
@@ -337,6 +393,10 @@ ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
!XLBDAG_MAX = ( ZCONC_MAX/XCCG )**(1./XCXG)
!XLBDAH_MAX = ( ZCONC_MAX/XCCH )**(1./XCXH)
!
+! constante for ecRad effective radius
+ZRHOIW = 0.917
+XREFFI = (3*XAI/(2*ZRHOIW*10**3*XGAMMAI)*MOMG(XALPHAI,XNUI,XBI)/MOMG(XALPHAI,XNUI,XDELTAI))*1E6
+!
!-------------------------------------------------------------------------------
!
!
diff --git a/src/PHYEX/micro/mode_lima_sedimentation.f90 b/src/PHYEX/micro/mode_lima_sedimentation.f90
index 9c59f23d3b7e454a9081897e019db570bacff274..d9342305c5bf0ac7ad153c2ebd43d52d4a20950f 100644
--- a/src/PHYEX/micro/mode_lima_sedimentation.f90
+++ b/src/PHYEX/micro/mode_lima_sedimentation.f90
@@ -7,9 +7,9 @@ MODULE MODE_LIMA_SEDIMENTATION
IMPLICIT NONE
CONTAINS
! ######################################################################
- SUBROUTINE LIMA_SEDIMENTATION (D, CST, &
+ SUBROUTINE LIMA_SEDIMENTATION (D, CST, ICED, HCLOUD, &
HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, OELEC, &
- PDZZ, PRHODREF, &
+ PDZZ, PRHODREF, PTHVREFZIKB, &
PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR, PFPR, &
PEFIELDW, PQS)
! ######################################################################
@@ -51,6 +51,7 @@ CONTAINS
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
USE MODD_ELEC_DESCR, ONLY: LSEDIM_BEARD
USE MODD_ELEC_PARAM, ONLY: XFQSED, XDQ
USE MODD_PARAM_LIMA, ONLY: XCEXVT, XRTMIN, XCTMIN, NSPLITSED, &
@@ -64,8 +65,8 @@ USE MODD_PARAM_LIMA_MIXED, ONLY: XCCG, XCXG, XCCH, XCXH
use mode_tools, only: Countjv
-USE MODI_GAMMA, ONLY: GAMMA_X0D
-USE MODI_ELEC_COMPUTE_EX
+USE MODI_GAMMA, ONLY: GAMMA_X0D
+USE MODE_ELEC_COMPUTE_EX, ONLY: ELEC_COMPUTE_EX
USE MODE_ELEC_BEARD_EFFECT, ONLY: ELEC_BEARD_EFFECT
!
IMPLICIT NONE
@@ -74,6 +75,7 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
CHARACTER(1), INTENT(IN) :: HPHASE ! Liquid or solid hydrometeors
INTEGER, INTENT(IN) :: KMOMENTS ! Number of moments
INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
@@ -91,6 +93,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCS ! C. source
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPR ! Instant precip rate
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFPR ! Precip. fluxes in altitude
REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PEFIELDW ! Vertical component of the electric field
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
REAL, DIMENSION(:,:,:), INTENT(INOUT), OPTIONAL :: PQS ! Elec. charge density source
!
!* 0.2 Declarations of local variables :
@@ -243,7 +247,7 @@ DO JN = 1 , NSPLITSED(KID)
IF (OELEC .AND. LSEDIM_BEARD) THEN
ALLOCATE(ZLBDA3(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)))
ZLBDA3(:,:,:) = UNPACK( ZLBDA(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- CALL ELEC_BEARD_EFFECT(D, KID, GSEDIM, PT, PRHODREF, &
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KID, GSEDIM, PT, PRHODREF, PTHVREFZIKB, &
PRS, PQS, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
DEALLOCATE(ZLBDA3)
END IF
@@ -263,10 +267,10 @@ DO JN = 1 , NSPLITSED(KID)
IF (OELEC) THEN
! compute e of the q-D relationship
IF (IMOMENTS == 2) THEN ! 2-moment species
- CALL ELEC_COMPUTE_EX (KID, IMOMENTS, ISEDIM, PTSTEP, ZRHODREF, XRTMIN(KID), &
+ CALL ELEC_COMPUTE_EX (KID, IMOMENTS, ISEDIM, HCLOUD, PTSTEP, ZRHODREF, XRTMIN(KID), &
ZRS, ZQS, ZES, PLBDX=ZLBDA, PCX=ZCS)
ELSE ! 1-moment species
- CALL ELEC_COMPUTE_EX (KID, IMOMENTS, ISEDIM, PTSTEP, ZRHODREF, XRTMIN(KID), &
+ CALL ELEC_COMPUTE_EX (KID, IMOMENTS, ISEDIM, HCLOUD, PTSTEP, ZRHODREF, XRTMIN(KID), &
ZRS, ZQS, ZES, PLBDX=ZLBDA)
END IF
!
diff --git a/src/PHYEX/micro/modi_lima.f90 b/src/PHYEX/micro/modi_lima.f90
index a2c536238d29c46a42143be62a9c9d360cf90309..74f5ba53b482491dfa36636c728b1761c53a6d01 100644
--- a/src/PHYEX/micro/modi_lima.f90
+++ b/src/PHYEX/micro/modi_lima.f90
@@ -3,9 +3,9 @@ MODULE MODI_LIMA
IMPLICIT NONE
INTERFACE
!
- SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
- PTSTEP, OELEC, &
- PRHODREF, PEXNREF, PDZZ, &
+ SUBROUTINE LIMA ( D, CST, ICED, ICEP, ELECD, ELECP, BUCONF, TBUDGETS, KBUDGETS,&
+ PTSTEP, OELEC, HCLOUD, &
+ PRHODREF, PEXNREF, PDZZ, PTHVREFZIKB, &
PRHODJ, PPABST, &
NCCN, NIFN, NIMM, &
PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
@@ -16,12 +16,20 @@ INTERFACE
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR_n,ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n,ONLY: RAIN_ICE_PARAM_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
@@ -29,6 +37,7 @@ INTEGER, INTENT(IN) :: KBUDGETS
REAL, INTENT(IN) :: PTSTEP ! Time step
!
LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electrification is activated
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -65,11 +74,12 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFPR ! Precipitation fluxes in altitude
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLATHAM_IAGGS ! Factor for IAGGS modification due to Efield
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PLATHAM_IAGGS ! Factor for IAGGS modification due to Efield
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PEFIELDW ! Vertical component of the electric field
REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PSV_ELEC_T ! Charge density at time t
REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(INOUT) :: PSV_ELEC_S ! Charge density sources
!
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
END SUBROUTINE LIMA
END INTERFACE
END MODULE MODI_LIMA
diff --git a/src/PHYEX/micro/modi_rain_ice.f90 b/src/PHYEX/micro/modi_rain_ice.f90
index 17f83cbc4916f6a6e55f2fc1edd6e6d3bfb1112a..e0bcef9df4c63039398a8caac95509d4df1b3f31 100644
--- a/src/PHYEX/micro/modi_rain_ice.f90
+++ b/src/PHYEX/micro/modi_rain_ice.f90
@@ -5,7 +5,7 @@
IMPLICIT NONE
INTERFACE
SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, ELECP, ELECD, BUCONF, &
- KPROMA, OCND2, OELEC, OSEDIM_BEARD, &
+ OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, &
PTSTEP, KRR, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -39,12 +39,11 @@ TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
-INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
-LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
LOGICAL, INTENT(IN) :: OELEC ! Switch for cloud electricity
LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! Switch for effect of electrical forces on sedim.
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -81,7 +80,7 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR! Rain instant precip
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS! Snow instant precip
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(MERGE(D%NIJT, 0, PARAMI%LDEPOSC)), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
!
@@ -89,24 +88,25 @@ TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
!
! scalar variables for cloud electricity
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQPIT ! Positive ion -
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCT ! Cloud droplet |
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRT ! Rain | electric
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIT ! Ice crystals | charge
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQST ! Snow | at t
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGT ! Graupel |
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQNIT ! Negative ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQPIT ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCT ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRT ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIT ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQST ! Snow | at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGT ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQNIT ! Negative ion -
!
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQPIS ! Positive ion -
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCS ! Cloud droplet |
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRS ! Rain | electric
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIS ! Ice crystals | charge
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQSS ! Snow | source
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGS ! Graupel |
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQNIS ! Negative ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQPIS ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCS ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRS ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIS ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQSS ! Snow | source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGS ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQNIS ! Negative ion -
!
-REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! vertical electric field
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), OPTIONAL, INTENT(IN) :: PEFIELDW ! vertical electric field
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
! enhancement of IAGGS
!
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
diff --git a/src/MNH/momg.f90 b/src/PHYEX/micro/momg.f90
similarity index 100%
rename from src/MNH/momg.f90
rename to src/PHYEX/micro/momg.f90
diff --git a/src/PHYEX/micro/radtr_satel.f90 b/src/PHYEX/micro/radtr_satel.f90
deleted file mode 100644
index 5f29acd95a57c40e775b0d2b07a23b00bb83727e..0000000000000000000000000000000000000000
--- a/src/PHYEX/micro/radtr_satel.f90
+++ /dev/null
@@ -1,756 +0,0 @@
-!MNH_LIC Copyright 2000-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_RADTR_SATEL
-! #######################
-IMPLICIT NONE
-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 )
-IMPLICIT NONE
-!
-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_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAMN
-USE MODD_NEB_n, ONLY: NEBN
-USE MODD_TURB_n, ONLY: TURBN
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-!
-USE MODD_RAD_TRANSF
-USE MODE_ll
-USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
-!
-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, ZDUM
-TYPE(DIMPHYEX_t) :: D
-!----------------------------------------------------------------------------
-!
-!* 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
-CALL FILL_DIMPHYEX(D, IIU, IJU, IKU)
-!
-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(:,:,:,2), PRT(:,:,:,5), PRT(:,:,:,6), PSIGS, PMFCONV, ZNCLD, &
- ! ZSIGRC, OUSERI, OSIGMAS, .FALSE., .FALSE., &
- ! ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, ZSIGQSAT2D )
- CALL CONDENSATION(D, CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
- &'T', 'CB02', 'CB', &
- &PPABST, PZZ, ZRHO, ZTEMP, ZRV_IN, ZRV_OUT, ZRC_IN, ZRC_OUT, ZRI_IN, ZRI_OUT, &
- &PRT(:,:,:,2), PRT(:,:,:,5), PRT(:,:,:,6), PSIGS, .FALSE., PMFCONV, ZNCLD, ZSIGRC, .FALSE., &
- &OSIGMAS, .FALSE., &
- &ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, 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/PHYEX/micro/rain_ice.f90 b/src/PHYEX/micro/rain_ice.f90
index 8c000324b0b3eba5b9520d006ca770cd3d532273..51c9afa6e42a4e639f7e293d1742833e04dd2d94 100644
--- a/src/PHYEX/micro/rain_ice.f90
+++ b/src/PHYEX/micro/rain_ice.f90
@@ -5,7 +5,7 @@
!-----------------------------------------------------------------
! ######spl
SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, ELECP, ELECD, BUCONF, &
- KPROMA, OCND2, OELEC, OSEDIM_BEARD, &
+ OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, &
PTSTEP, KRR, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -167,17 +167,18 @@
!! (C. Abiven, Y. Léauté, V. Seigner, S. Riette) Phasing of Turner rain subgrid param
!! (S. Riette) Source code split into several files
!! 02/2019 C.Lac add rain fraction as an output field
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! 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)
-! P. Wautelet 17/01/2020: move Quicksort to tools.f90
-! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
-! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
+!! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!! 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)
+!! P. Wautelet 17/01/2020: move Quicksort to tools.f90
+!! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
!! R. El Khatib 24-Aug-2021 Optimizations
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
! C. Barthe 03/2023: Add call to cloud electrification
! C. Barthe 06/2023: Add retroaction of electric field on IAGGS
! C. Barthe 07/2023: use new data structures for electricity
+!! S. Riette Sept 23: e from ice4_tendencies
!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -238,12 +239,12 @@ USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
+USE MODE_ICE4_COMPUTE_PDF, ONLY: ICE4_COMPUTE_PDF
USE MODE_ICE4_SEDIMENTATION, ONLY: ICE4_SEDIMENTATION
USE MODE_ICE4_PACK, ONLY: ICE4_PACK
-USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
USE MODE_ICE4_CORRECT_NEGATIVITIES, ONLY: ICE4_CORRECT_NEGATIVITIES
!
-USE MODI_ELEC_TENDENCIES
+USE MODE_ELEC_TENDENCIES, ONLY : ELEC_TENDENCIES
!
IMPLICIT NONE
!
@@ -259,12 +260,11 @@ TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
-INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
-LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
LOGICAL, INTENT(IN) :: OELEC ! Switch for cloud electricity
LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! Switch for effect of electrical forces on sedim.
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -301,32 +301,33 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR! Rain instant precip
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS! Snow instant precip
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(MERGE(D%NIJT, 0, PARAMI%LDEPOSC)), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
!
! scalar variables for cloud electricity
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQPIT ! Positive ion -
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCT ! Cloud droplet |
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRT ! Rain | electric
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIT ! Ice crystals | charge
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQST ! Snow | at t
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGT ! Graupel |
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQNIT ! Negative ion -
-!
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQPIS ! Positive ion -
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCS ! Cloud droplet |
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRS ! Rain | electric
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIS ! Ice crystals | charge
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQSS ! Snow | source
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGS ! Graupel |
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQNIS ! Negative ion -
-!
-REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! vertical electric field
-REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQPIT ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCT ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRT ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIT ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQST ! Snow | at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGT ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQNIT ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQPIS ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCS ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRS ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIS ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQSS ! Snow | source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGS ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQNIS ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), OPTIONAL, INTENT(IN) :: PEFIELDW ! vertical electric field
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
! enhancement of IAGGS
!
! optional variables
@@ -345,13 +346,18 @@ REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
INTEGER :: JIJ, JK
-INTEGER :: IKTB, IKTE, IKB, IIJB, IIJE
+INTEGER :: IKTB, IKTE, IKB, IKT, IIJB, IIJE, IIJT
!
LOGICAL, DIMENSION(D%NIJT,D%NKT) :: LLMICRO ! mask to limit computation
!Arrays for nucleation call outisde of LLMICRO points
REAL, DIMENSION(D%NIJT, D%NKT) :: ZT ! Temperature
REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_RVHENI ! heterogeneous nucleation
REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_LVFACT, ZZ_LSFACT
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZSIGMA_RC
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZHLC_LCF
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZHLC_LRC
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZHLI_LCF
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZHLI_LRI
!
REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
!For total tendencies computation
@@ -380,13 +386,12 @@ IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 0, ZHOOK_HANDLE)
IKTB=D%NKTB
IKTE=D%NKTE
IKB=D%NKB
+IKT=D%NKT
IIJB=D%NIJB
IIJE=D%NIJE
+IIJT=D%NIJT
!-------------------------------------------------------------------------------
!
-IF(PARAMI%LOCND2) THEN
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'LOCND2 OPTION NOT CODED IN THIS RAIN_ICE VERSION')
-END IF
ZINV_TSTEP=1./PTSTEP
!
! LSFACT and LVFACT without exner, and LLMICRO
@@ -432,7 +437,7 @@ ENDDO
!
IF(.NOT. PARAMI%LSEDIM_AFTER) THEN
CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, BUCONF, &
- &OELEC, OSEDIM_BEARD, PTSTEP, KRR, PDZZ, &
+ &OELEC, OSEDIM_BEARD, HCLOUD, PTSTEP, KRR, PDZZ, PTHVREFZIKB, &
&ZZ_LVFACT, ZZ_LSFACT, PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
&PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRS, PINPRG, &
@@ -473,7 +478,7 @@ DO JK = IKTB,IKTE
ENDDO
!
!
-!* 4. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF LLMICRO POINTS
+!* 4.1 COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF LLMICRO POINTS
! -----------------------------------------------------------------
!
!The nucleation must be called everywhere
@@ -490,11 +495,15 @@ DO JK=IKTB,IKTE
ENDIF
ENDDO
ENDDO
-CALL ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, D%NIJT*D%NKT, LLW3D(:,:), &
- PTHT(:, :), PPABST(:, :), PRHODREF(:, :), &
- PEXN(:, :), ZW3D(:, :), ZT(:, :), &
- PRVT(:, :), &
- PCIT(:, :), ZZ_RVHENI(:, :))
+DO JK=IKTB,IKTE
+ DO JIJ=IIJB,IIJE
+ CALL ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, LLW3D(JIJ, JK), &
+ PTHT(JIJ, JK), PPABST(JIJ, JK), PRHODREF(JIJ, JK), &
+ PEXN(JIJ, JK), ZW3D(JIJ, JK), ZT(JIJ, JK), &
+ PRVT(JIJ, JK), &
+ PCIT(JIJ, JK), ZZ_RVHENI(JIJ, JK))
+ ENDDO
+ENDDO
DO JK = IKTB, IKTE
DO JIJ=IIJB, IIJE
ZZ_RVHENI(JIJ,JK) = MIN(PRVS(JIJ,JK), ZZ_RVHENI(JIJ,JK)/PTSTEP)
@@ -502,11 +511,76 @@ DO JK = IKTB, IKTE
ENDDO
!
!
+!* 4.2 COMPUTES PRECIPITATION FRACTION
+! -------------------------------
+!
+!The ICE4_RAINFR_VERT call was previously in ice4_tendencies to be computed again at each iteration.
+!The computation has been moved here to separate (for GPUs) the part of the code
+!where column computation can occur (here, alongside with the sedimentation) and
+!other routines where computation are only 0D (point by point).
+!This is not completly exact but we can think that the precipitation fraction
+!diagnostic does not evolve too much during a time-step.
+!ICE4_RAINFR_VERT needs the output of ICE4_COMPUTE_PDF; thus this routine
+!is called here but it's still called from within ice4_tendencies.
+IF (PARAMI%CSUBG_RC_RR_ACCR=='PRFR' .OR. PARAMI%CSUBG_RR_EVAP=='PRFR') THEN
+ IF (PARAMI%CSUBG_AUCV_RC=='PDF ' .AND. PARAMI%CSUBG_PR_PDF=='SIGM') THEN
+ DO JK = IKTB, IKTE
+ DO JIJ=IIJB, IIJE
+ ZSIGMA_RC(JIJ, JK)=PSIGS(JIJ, JK)**2
+ ENDDO
+ ENDDO
+ ENDIF
+ IF (PARAMI%CSUBG_AUCV_RC=='ADJU' .OR. PARAMI%CSUBG_AUCV_RI=='ADJU') THEN
+ DO JK = IKTB, IKTE
+ DO JIJ=IIJB, IIJE
+ ZHLC_LRC(JIJ, JK) = ZWR(JIJ, JK, IRC) - PHLC_HRC(JIJ, JK)
+ ZHLI_LRI(JIJ, JK) = ZWR(JIJ, JK, IRI) - PHLI_HRI(JIJ, JK)
+ IF(ZWR(JIJ, JK, IRC)>0.) THEN
+ ZHLC_LCF(JIJ, JK) = PCLDFR(JIJ, JK)- PHLC_HCF(JIJ, JK)
+ ELSE
+ ZHLC_LCF(JIJ, JK)=0.
+ ENDIF
+ IF(ZWR(JIJ, JK, IRI)>0.) THEN
+ ZHLI_LCF(JIJ, JK) = PCLDFR(JIJ, JK)- PHLI_HCF(JIJ, JK)
+ ELSE
+ ZHLI_LCF(JIJ, JK)=0.
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDIF
+ !We cannot use ZWR(:,:,IRC) which is not contiguous
+ CALL ICE4_COMPUTE_PDF(CST, ICEP, ICED, IIJT*(IKTE-IKTB+1), PARAMI%CSUBG_AUCV_RC, PARAMI%CSUBG_AUCV_RI, PARAMI%CSUBG_PR_PDF,&
+ LLMICRO(:,:), PRHODREF(:,:), PRCT(:,:), PRIT(:,:), &
+ PCLDFR(:,:), ZT(:,:), ZSIGMA_RC(:,:), &
+ PHLC_HCF(:,:), ZHLC_LCF(:,:), PHLC_HRC(:,:), ZHLC_LRC(:,:), &
+ PHLI_HCF(:,:), ZHLI_LCF(:,:), PHLI_HRI(:,:), ZHLI_LRI(:,:), &
+ PRAINFR(:,:))
+!CALL ICE4_COMPUTE_PDF2D(D, CST, ICEP, ICED, PARAMI%CSUBG_AUCV_RC, PARAMI%CSUBG_AUCV_RI, PARAMI%CSUBG_PR_PDF, &
+! LLMICRO, PRHODREF, ZWR(:,:,IRC), ZWR(:,:,IRI), PCLDFR, ZT, ZSIGMA_RC,&
+! PHLC_HCF, ZHLC_LCF, PHLC_HRC, ZHLC_LRC, &
+! PHLI_HCF, ZHLI_LCF, PHLI_HRI, ZHLI_LRI, PRAINFR)
+ IF (PRESENT(PRHS)) THEN
+ CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, ZWR(:,:,IRR), &
+ &ZWR(:,:,IRS), ZWR(:,:,IRG), ZWR(:,:,IRH))
+ ELSE
+ CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, ZWR(:,:,IRR), &
+ &ZWR(:,:,IRS), ZWR(:,:,IRG))
+ ENDIF
+ELSE
+ PRAINFR(:,:)=1.
+ENDIF
+!
+!
!* 5. TENDENCIES COMPUTATION
! ----------------------
!
IF(PARAMI%LPACK_MICRO) THEN
- ISIZE=COUNT(LLMICRO) ! Number of points with active microphysics
+ ISIZE=0
+ DO JK=1,D%NKT
+ DO JIJ=1,D%NIJT
+ IF(LLMICRO(JIJ,JK)) ISIZE=ISIZE+1 ! Number of points with active microphysics
+ END DO
+ END DO
!PARAMI%NPROMICRO is the requested size for cache_blocking loop
!IPROMA is the effective size
!This parameter must be computed here because it is used for array dimensioning in ice4_pack
@@ -574,8 +648,10 @@ IF (OELEC) THEN
! RVHENI : ajout de prvheni ?
! traitement des deux termes extra ? irwetgh_mr et irsrimcg_mr ?
IF (KRR == 7) THEN
- CALL ELEC_TENDENCIES(D, KRR, IELEC, PTSTEP, GMASK_ELEC, &
- PRHODREF, PRHODJ, ZT, PCIT, &
+ CALL ELEC_TENDENCIES(D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, PRHODREF, PRHODJ, ZT, PCIT, &
PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
@@ -605,8 +681,10 @@ IF (OELEC) THEN
PRDRYHG=ZMICRO_TEND(:,:,IRDRYHG), PRHMLTR=ZMICRO_TEND(:,:,IRHMLTR), &
PRHT=PRHT, PRHS=PRHS, PQHT=PQHT, PQHS=PQHS )
ELSE
- CALL ELEC_TENDENCIES(D, KRR, ISIZE, PTSTEP, LLMICRO, &
- PRHODREF, PRHODJ, ZT, PCIT, &
+ CALL ELEC_TENDENCIES(D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, ISIZE, PTSTEP, LLMICRO, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, PRHODREF, PRHODJ, ZT, PCIT, &
PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
@@ -732,7 +810,7 @@ END IF
!
IF(PARAMI%LSEDIM_AFTER) THEN
CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, BUCONF, &
- &OELEC, OSEDIM_BEARD, PTSTEP, KRR, PDZZ, &
+ &OELEC, OSEDIM_BEARD, HCLOUD, PTSTEP, KRR, PDZZ, PTHVREFZIKB, &
&ZZ_LVFACT, ZZ_LSFACT, PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
&PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRS, PINPRG, &
@@ -785,4 +863,6 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 1, ZHOOK_HANDLE)
!
+CONTAINS
+INCLUDE "ice4_nucleation.func.h"
END SUBROUTINE RAIN_ICE
diff --git a/src/PHYEX/turb/modd_param_mfshalln.f90 b/src/PHYEX/turb/modd_param_mfshalln.f90
index 6c50a6fe6587be13a1ff4cb86289877e777c2e4e..a4724bcc176a2fc67855d781dc54eb89890da0d0 100644
--- a/src/PHYEX/turb/modd_param_mfshalln.f90
+++ b/src/PHYEX/turb/modd_param_mfshalln.f90
@@ -82,6 +82,7 @@ REAL :: XGZ !< Tuning of the surface initialisation for Grey Zo
!
LOGICAL :: LTHETAS_MF !< .TRUE. to use ThetaS1 instead of ThetaL
REAL :: XLAMBDA_MF !< Thermodynamic parameter: Lambda to compute ThetaS1 from ThetaL
+LOGICAL :: LVERLIMUP !< .TRUE. to use correction on vertical limitation of updraft (issue #38 PHYEX)
END TYPE PARAM_MFSHALL_t
@@ -119,13 +120,15 @@ REAL, POINTER :: XR=>NULL()
LOGICAL, POINTER :: LTHETAS_MF=>NULL()
REAL, POINTER :: XLAMBDA_MF=>NULL()
LOGICAL, POINTER :: LGZ=>NULL()
-REAL, POINTER :: XGZ=>NULL()
+REAL, POINTER :: XGZ=>NULL()
+LOGICAL, POINTER :: LVERLIMUP=>NULL()
!
NAMELIST/NAM_PARAM_MFSHALLn/XIMPL_MF,CMF_UPDRAFT,CMF_CLOUD,LMIXUV,LMF_FLX,&
XALP_PERT,XABUO,XBENTR,XBDETR,XCMF,XENTR_MF,&
XCRAD_MF,XENTR_DRY,XDETR_DRY,XDETR_LUP,XKCF_MF,&
XKRC_MF,XTAUSIGMF,XPRES_UV,XALPHA_MF,XSIGMA_MF,&
- XFRAC_UP_MAX,XA1,XB,XC,XBETA1,XR,LTHETAS_MF,LGZ,XGZ
+ XFRAC_UP_MAX,XA1,XB,XC,XBETA1,XR,LTHETAS_MF,LGZ,XGZ,&
+ LVERLIMUP
!
!-------------------------------------------------------------------------------
!
@@ -176,6 +179,7 @@ LTHETAS_MF=>PARAM_MFSHALL_MODEL(KTO)%LTHETAS_MF
XLAMBDA_MF=>PARAM_MFSHALL_MODEL(KTO)%XLAMBDA_MF
LGZ=>PARAM_MFSHALL_MODEL(KTO)%LGZ
XGZ=>PARAM_MFSHALL_MODEL(KTO)%XGZ
+LVERLIMUP=>PARAM_MFSHALL_MODEL(KTO)%LVERLIMUP
!
ENDIF
!
@@ -285,6 +289,8 @@ IF(LLDEFAULTVAL) THEN
XLAMBDA_MF=0.
LGZ=.FALSE.
XGZ=1.83 ! between 1.83 and 1.33
+ LVERLIMUP=.FALSE.
+ IF(HPROGRAM=='MESONH') LVERLIMUP=.TRUE.
ENDIF
!
!* 2. NAMELIST
diff --git a/src/PHYEX/turb/modd_turbn.f90 b/src/PHYEX/turb/modd_turbn.f90
index a3f2c6e9df4054b8b84a257cb31d1d5b27f8be5c..ef3ad4cbe1da3b08d6e7aca87a58f73b0079519e 100644
--- a/src/PHYEX/turb/modd_turbn.f90
+++ b/src/PHYEX/turb/modd_turbn.f90
@@ -122,6 +122,7 @@ REAL :: XCEI_MAX !< maximum threshold for the instability index C
!(beginning of the saturation of the amplification)
REAL, DIMENSION(:,:,:), POINTER :: XCEI !< Cloud Entrainment instability index to emphasize localy
! turbulent fluxes
+ LOGICAL :: LTURB_PRECIP ! switch to apply turbulence to precipitating hydrometeor mixing ratios
!
END TYPE TURB_t
@@ -180,6 +181,7 @@ REAL, POINTER :: XCOEF_AMPL_SAT=>NULL()
REAL, POINTER :: XCEI_MIN=>NULL()
REAL, POINTER :: XCEI_MAX =>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCEI=>NULL()
+LOGICAL, POINTER :: LTURB_PRECIP=>NULL()
!
NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
LSIG_CONV,LRMC01,CTOM,&
@@ -188,7 +190,7 @@ NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
XALTHGRAD, XCLDTHOLD, XLINI, LHARAT, &
LPROJQITURB, LSMOOTH_PRANDTL, XMINSIGS, NTURBSPLIT, &
LCLOUDMODIFLM, CTURBLEN_CLOUD, &
- XCOEF_AMPL_SAT, XCEI_MIN, XCEI_MAX
+ XCOEF_AMPL_SAT, XCEI_MIN, XCEI_MAX, LTURB_PRECIP
!
!-------------------------------------------------------------------------------
!
@@ -276,6 +278,7 @@ XCOEF_AMPL_SAT=>TURB_MODEL(KTO)%XCOEF_AMPL_SAT
XCEI_MIN=>TURB_MODEL(KTO)%XCEI_MIN
XCEI_MAX =>TURB_MODEL(KTO)%XCEI_MAX
XCEI=>TURB_MODEL(KTO)%XCEI
+LTURB_PRECIP=>TURB_MODEL(KTO)%LTURB_PRECIP
!
ENDIF
!
@@ -386,6 +389,7 @@ IF(LLDEFAULTVAL) THEN
XCOEF_AMPL_SAT = 5.
XCEI_MIN = 0.001E-06
XCEI_MAX = 0.01E-06
+ LTURB_PRECIP =.FALSE.
!
IF(HPROGRAM=='AROME') THEN
XTKEMIN=1.E-6
diff --git a/src/PHYEX/turb/mode_bl_depth_diag.f90 b/src/PHYEX/turb/mode_bl_depth_diag.f90
index 8d91826c43e86f086f655bab19ede5b561a3c616..2cae3a3fe2cf48cfd1f0a9a4d55c52b57abde3cf 100644
--- a/src/PHYEX/turb/mode_bl_depth_diag.f90
+++ b/src/PHYEX/turb/mode_bl_depth_diag.f90
@@ -84,18 +84,19 @@ BL_DEPTH_DIAG3D(:) = 0.
!
DO JIJ=IIJB,IIJE
- IF (PSURF(JIJ)==0.) CYCLE
+ IF (PSURF(JIJ)/=0.) THEN
DO JK=IKB,IKE,IKL
- IF (PZZ(JIJ,JK-IKL)<=PZS(JIJ)) CYCLE
- ZFLX = PSURF(JIJ) * PFTOP_O_FSURF
- IF ( (PFLUX(JIJ,JK)-ZFLX)*(PFLUX(JIJ,JK-IKL)-ZFLX) <= 0. ) THEN
- BL_DEPTH_DIAG3D(JIJ) = (PZZ (JIJ,JK-IKL) - PZS(JIJ)) &
+ IF (PZZ(JIJ,JK-IKL)>PZS(JIJ)) THEN
+ ZFLX = PSURF(JIJ) * PFTOP_O_FSURF
+ IF ( (PFLUX(JIJ,JK)-ZFLX)*(PFLUX(JIJ,JK-IKL)-ZFLX) <= 0. ) THEN
+ BL_DEPTH_DIAG3D(JIJ) = (PZZ (JIJ,JK-IKL) - PZS(JIJ)) &
+ (PZZ (JIJ,JK) - PZZ (JIJ,JK-IKL)) &
* (ZFLX - PFLUX(JIJ,JK-IKL) ) &
/ (PFLUX(JIJ,JK) - PFLUX(JIJ,JK-IKL) )
- EXIT
+ END IF
END IF
END DO
+ END IF
END DO
!
!$mnh_expand_array(JIJ=IIJB:IIJE)
diff --git a/src/PHYEX/turb/mode_compute_bl89_ml.f90 b/src/PHYEX/turb/mode_compute_bl89_ml.f90
index 8ebf242e6e46eb0cc03322a68d8e5cead996cbca..47f3e4be5958c15f217726075ab7ea37a2489690 100644
--- a/src/PHYEX/turb/mode_compute_bl89_ml.f90
+++ b/src/PHYEX/turb/mode_compute_bl89_ml.f90
@@ -77,7 +77,6 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZDELTVPT,ZHLVPT
!Virtual Potential Temp at Half level and DeltaThv between
!2 mass levels
-INTEGER :: J1D !horizontal loop counter
INTEGER :: JKK !loop counters
INTEGER :: JIJ, JK
INTEGER :: IIJB,IIJE ! physical horizontal domain indices
@@ -132,32 +131,32 @@ IF (OUPORDN.EQV..TRUE.) THEN
ZVPT_DEP(:)=ZHLVPT(:,KK) ! departure point is on flux level
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!We must compute what happens between flux level KK and mass level KK
- DO J1D=IIJB,IIJE
- ZTEST0=0.5+SIGN(0.5,ZINTE(J1D)) ! test if there's energy to consume
+ DO JIJ=IIJB,IIJE
+ ZTEST0=0.5+SIGN(0.5,ZINTE(JIJ)) ! test if there's energy to consume
! Energy consumed if parcel cross the entire layer
- ZPOTE(J1D) = ZTEST0*(PG_O_THVREF(J1D) * &
- (0.5*(ZHLVPT(J1D,KK)+ PVPT(J1D,KK)) - ZVPT_DEP(J1D)) + &
- CSTURB%XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D)))) * &
- PDZZ2D(J1D,KK)*0.5
+ ZPOTE(JIJ) = ZTEST0*(PG_O_THVREF(JIJ) * &
+ (0.5*(ZHLVPT(JIJ,KK)+ PVPT(JIJ,KK)) - ZVPT_DEP(JIJ)) + &
+ CSTURB%XRM17*PSHEAR(JIJ,KK)*SQRT(ABS(PTKEM_DEP(JIJ)))) * &
+ PDZZ2D(JIJ,KK)*0.5
! Test if it rests some energy to consume
- ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
+ ZTEST =0.5+SIGN(0.5,ZINTE(JIJ)-ZPOTE(JIJ))
! Length travelled by parcel if it rests energy to consume
- ZLWORK1(J1D)=PDZZ2D(J1D,KK)*0.5
+ ZLWORK1(JIJ)=PDZZ2D(JIJ,KK)*0.5
! Lenght travelled by parcel to nullify energy
- ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
- ( ZHLVPT(J1D,KK) - ZVPT_DEP(J1D) ) &
- - CSTURB%XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D))) &
+ ZLWORK2(JIJ)= ( - PG_O_THVREF(JIJ) * &
+ ( ZHLVPT(JIJ,KK) - ZVPT_DEP(JIJ) ) &
+ - CSTURB%XRM17*PSHEAR(JIJ,KK)*SQRT(ABS(PTKEM_DEP(JIJ))) &
+ SQRT (ABS( &
- (CSTURB%XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D))) + &
- PG_O_THVREF(J1D) * (ZHLVPT(J1D,KK) - ZVPT_DEP(J1D)) )**2 &
- + 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
- * ZDELTVPT(J1D,KK) / PDZZ2D(J1D,KK) )) ) / &
- ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,KK) / PDZZ2D(J1D,KK) )
+ (CSTURB%XRM17*PSHEAR(JIJ,KK)*SQRT(ABS(PTKEM_DEP(JIJ))) + &
+ PG_O_THVREF(JIJ) * (ZHLVPT(JIJ,KK) - ZVPT_DEP(JIJ)) )**2 &
+ + 2. * ZINTE(JIJ) * PG_O_THVREF(JIJ) &
+ * ZDELTVPT(JIJ,KK) / PDZZ2D(JIJ,KK) )) ) / &
+ ( PG_O_THVREF(JIJ) * ZDELTVPT(JIJ,KK) / PDZZ2D(JIJ,KK) )
! Effective length travelled by parcel
- PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
- (1-ZTEST)*ZLWORK2(J1D))
+ PLWORK(JIJ)=PLWORK(JIJ)+ZTEST0*(ZTEST*ZLWORK1(JIJ)+ &
+ (1-ZTEST)*ZLWORK2(JIJ))
! Rest of energy to consume
- ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
+ ZINTE(JIJ) = ZINTE(JIJ) - ZPOTE(JIJ)
ENDDO
ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE)
@@ -168,28 +167,28 @@ IF (OUPORDN.EQV..TRUE.) THEN
DO JKK=KK+IKL,IKE,IKL
IF(ZTESTM > 0.) THEN
ZTESTM=0
- DO J1D=IIJB,IIJE
- ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
- ZPOTE(J1D) = ZTEST0*(PG_O_THVREF(J1D) * &
- (ZHLVPT(J1D,JKK) - ZVPT_DEP(J1D)) &
- + CSTURB%XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
- ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
+ DO JIJ=IIJB,IIJE
+ ZTEST0=0.5+SIGN(0.5,ZINTE(JIJ))
+ ZPOTE(JIJ) = ZTEST0*(PG_O_THVREF(JIJ) * &
+ (ZHLVPT(JIJ,JKK) - ZVPT_DEP(JIJ)) &
+ + CSTURB%XRM17*PSHEAR(JIJ,JKK)*SQRT(ABS(PTKEM_DEP(JIJ))))* PDZZ2D(JIJ,JKK)
+ ZTEST =0.5+SIGN(0.5,ZINTE(JIJ)-ZPOTE(JIJ))
ZTESTM=ZTESTM+ZTEST0
- ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
+ ZLWORK1(JIJ)=PDZZ2D(JIJ,JKK)
!ZLWORK2 jump of the last reached level
- ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
- ( PVPT(J1D,JKK-IKL) - ZVPT_DEP(J1D) ) &
- - CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ ZLWORK2(JIJ)= ( - PG_O_THVREF(JIJ) * &
+ ( PVPT(JIJ,JKK-IKL) - ZVPT_DEP(JIJ) ) &
+ - CSTURB%XRM17*PSHEAR(JIJ,JKK)*sqrt(abs(PTKEM_DEP(JIJ))) &
+ SQRT (ABS( &
- (CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) + &
- PG_O_THVREF(J1D) * (PVPT(J1D,JKK-IKL) - ZVPT_DEP(J1D)) )**2 &
- + 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
- * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )) ) / &
- ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
+ (CSTURB%XRM17*PSHEAR(JIJ,JKK)*sqrt(abs(PTKEM_DEP(JIJ))) + &
+ PG_O_THVREF(JIJ) * (PVPT(JIJ,JKK-IKL) - ZVPT_DEP(JIJ)) )**2 &
+ + 2. * ZINTE(JIJ) * PG_O_THVREF(JIJ) &
+ * ZDELTVPT(JIJ,JKK) / PDZZ2D(JIJ,JKK) )) ) / &
+ ( PG_O_THVREF(JIJ) * ZDELTVPT(JIJ,JKK) / PDZZ2D(JIJ,JKK) )
!
- PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
- (1-ZTEST)*ZLWORK2(J1D))
- ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
+ PLWORK(JIJ)=PLWORK(JIJ)+ZTEST0*(ZTEST*ZLWORK1(JIJ)+ &
+ (1-ZTEST)*ZLWORK2(JIJ))
+ ZINTE(JIJ) = ZINTE(JIJ) - ZPOTE(JIJ)
END DO
ENDIF
END DO
@@ -209,27 +208,27 @@ IF (OUPORDN.EQV..FALSE.) THEN
DO JKK=KK,IKB,-IKL
IF(ZTESTM > 0.) THEN
ZTESTM=0
- DO J1D=IIJB,IIJE
- ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
- ZPOTE(J1D) = ZTEST0*(-PG_O_THVREF(J1D) * &
- (ZHLVPT(J1D,JKK) - PVPT(J1D,KK)) &
- + CSTURB%XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
- ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
+ DO JIJ=IIJB,IIJE
+ ZTEST0=0.5+SIGN(0.5,ZINTE(JIJ))
+ ZPOTE(JIJ) = ZTEST0*(-PG_O_THVREF(JIJ) * &
+ (ZHLVPT(JIJ,JKK) - PVPT(JIJ,KK)) &
+ + CSTURB%XRM17*PSHEAR(JIJ,JKK)*SQRT(ABS(PTKEM_DEP(JIJ))))* PDZZ2D(JIJ,JKK)
+ ZTEST =0.5+SIGN(0.5,ZINTE(JIJ)-ZPOTE(JIJ))
ZTESTM=ZTESTM+ZTEST0
- ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
- ZLWORK2(J1D)= ( + PG_O_THVREF(J1D) * &
- ( PVPT(J1D,JKK) - PVPT(J1D,KK) ) &
- -CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ ZLWORK1(JIJ)=PDZZ2D(JIJ,JKK)
+ ZLWORK2(JIJ)= ( + PG_O_THVREF(JIJ) * &
+ ( PVPT(JIJ,JKK) - PVPT(JIJ,KK) ) &
+ -CSTURB%XRM17*PSHEAR(JIJ,JKK)*sqrt(abs(PTKEM_DEP(JIJ))) &
+ SQRT (ABS( &
- (CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) - &
- PG_O_THVREF(J1D) * (PVPT(J1D,JKK) - PVPT(J1D,KK)) )**2 &
- + 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
- * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )) ) / &
- ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
+ (CSTURB%XRM17*PSHEAR(JIJ,JKK)*sqrt(abs(PTKEM_DEP(JIJ))) - &
+ PG_O_THVREF(JIJ) * (PVPT(JIJ,JKK) - PVPT(JIJ,KK)) )**2 &
+ + 2. * ZINTE(JIJ) * PG_O_THVREF(JIJ) &
+ * ZDELTVPT(JIJ,JKK) / PDZZ2D(JIJ,JKK) )) ) / &
+ ( PG_O_THVREF(JIJ) * ZDELTVPT(JIJ,JKK) / PDZZ2D(JIJ,JKK) )
!
- PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
- (1-ZTEST)*ZLWORK2(J1D))
- ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
+ PLWORK(JIJ)=PLWORK(JIJ)+ZTEST0*(ZTEST*ZLWORK1(JIJ)+ &
+ (1-ZTEST)*ZLWORK2(JIJ))
+ ZINTE(JIJ) = ZINTE(JIJ) - ZPOTE(JIJ)
END DO
ENDIF
END DO
diff --git a/src/PHYEX/turb/mode_compute_mf_cloud.f90 b/src/PHYEX/turb/mode_compute_mf_cloud.f90
index a9a6d456848a4ccfc3ed64fa2c5798c134574f2e..be31aef002ab4c5994fde856e3246378f12096ab 100644
--- a/src/PHYEX/turb/mode_compute_mf_cloud.f90
+++ b/src/PHYEX/turb/mode_compute_mf_cloud.f90
@@ -117,10 +117,10 @@ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD',0,ZHOOK_HANDLE)
!
! 2.1 Internal domain
-PRC_MF = 0.
-PRI_MF = 0.
-PCF_MF = 0.
-PSIGMF = 0.
+PRC_MF(:,:) = 0.
+PRI_MF(:,:) = 0.
+PCF_MF(:,:) = 0.
+PSIGMF(:,:) = 0.
IF (PARAMMF%CMF_CLOUD == 'DIRE') THEN
!Direct cloud scheme
diff --git a/src/PHYEX/turb/mode_compute_updraft.f90 b/src/PHYEX/turb/mode_compute_updraft.f90
index 810cb023091493b45d8985171b38932395252e92..41ff952bd1df21ab670a3c0eab7ae85a89448ab6 100644
--- a/src/PHYEX/turb/mode_compute_updraft.f90
+++ b/src/PHYEX/turb/mode_compute_updraft.f90
@@ -190,7 +190,7 @@ REAL :: ZTMAX,ZRMAX ! control value
REAL, DIMENSION(D%NIJT) :: ZSURF
REAL, DIMENSION(D%NIJT,D%NKT) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
!
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK, KDEPTH
REAL, DIMENSION(D%NIJT,16) :: ZBUF
!
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
@@ -446,7 +446,10 @@ GTESTETL(:)=.FALSE.
DO JK=IKB,IKE-IKL,IKL
! IF the updraft top is reached for all column, stop the loop on levels
- ITEST=COUNT(GTEST(:))
+ ITEST=0
+ DO JIJ=IIJB,IIJE
+ IF(GTEST(JIJ)) ITEST = ITEST + 1
+ END DO
IF (ITEST==0) CYCLE
! Computation of entrainment and detrainment with KF90
@@ -588,33 +591,38 @@ DO JK=IKB,IKE-IKL,IKL
PRSAT_UP(:,JK+IKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+IKL)) + &
& ZRSATI(:)*PFRAC_ICE_UP(:,JK+IKL)
ENDWHERE
-
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL
- WHERE(GTEST(:))
- PTHV_UP(:,JK+IKL) = ZTH_UP(:,JK+IKL)* &
- & ((1+ZRVORD*PRV_UP(:,JK+IKL))/(1+PRT_UP(:,JK+IKL)))
- WHERE (ZBUO_INTEG_DRY(:,JK)>0.)
- ZW_UP2(:,JK+IKL) = ZW_UP2(:,JK) + 2.*(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)* &
- &ZBUO_INTEG_DRY(:,JK)
- ELSEWHERE
- ZW_UP2(:,JK+IKL) = ZW_UP2(:,JK) + 2.*PARAMMF%XABUO* ZBUO_INTEG_DRY(:,JK)
- ENDWHERE
- ZW_UP2(:,JK+IKL) = ZW_UP2(:,JK+IKL)*(1.-(PARAMMF%XBDETR*ZMIX3_CLD(:)+ &
- &PARAMMF%XBENTR*ZMIX2_CLD(:)))&
- /(1.+(PARAMMF%XBDETR*ZMIX3_CLD(:)+PARAMMF%XBENTR*ZMIX2_CLD(:))) &
- +2.*(PARAMMF%XABUO)*ZBUO_INTEG_CLD(:,JK)/ &
- &(1.+(PARAMMF%XBDETR*ZMIX3_CLD(:)+PARAMMF%XBENTR*ZMIX2_CLD(:)))
- ENDWHERE
+ DO JIJ=IIJB,IIJE
+ IF(GTEST(JIJ)) THEN
+ PTHV_UP(JIJ,JK+IKL) = ZTH_UP(JIJ,JK+IKL)* &
+ & ((1+ZRVORD*PRV_UP(JIJ,JK+IKL))/(1+PRT_UP(JIJ,JK+IKL)))
+ IF (ZBUO_INTEG_DRY(JIJ,JK)>0.) THEN
+ ZW_UP2(JIJ,JK+IKL) = ZW_UP2(JIJ,JK) + 2.*(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)* &
+ &ZBUO_INTEG_DRY(JIJ,JK)
+ ELSE
+ ZW_UP2(JIJ,JK+IKL) = ZW_UP2(JIJ,JK) + 2.*PARAMMF%XABUO* ZBUO_INTEG_DRY(JIJ,JK)
+ END IF
+ ZW_UP2(JIJ,JK+IKL) = ZW_UP2(JIJ,JK+IKL)*(1.-(PARAMMF%XBDETR*ZMIX3_CLD(JIJ)+ &
+ &PARAMMF%XBENTR*ZMIX2_CLD(JIJ)))&
+ /(1.+(PARAMMF%XBDETR*ZMIX3_CLD(JIJ)+PARAMMF%XBENTR*ZMIX2_CLD(JIJ))) &
+ +2.*(PARAMMF%XABUO)*ZBUO_INTEG_CLD(JIJ,JK)/ &
+ &(1.+(PARAMMF%XBDETR*ZMIX3_CLD(JIJ)+PARAMMF%XBENTR*ZMIX2_CLD(JIJ)))
+ END IF
+ END DO
! Test if the updraft has reach the ETL
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (GTEST(:).AND.(PBUO_INTEG(:,JK)<=0.))
KKETL(:) = JK+IKL
GTESTETL(:)=.TRUE.
ELSEWHERE
GTESTETL(:)=.FALSE.
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! Test is we have reached the top of the updraft
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (GTEST(:).AND.((ZW_UP2(:,JK+IKL)<=0.).OR.(PEMF(:,JK+IKL)<=0.)))
ZW_UP2(:,JK+IKL)=0.
PEMF(:,JK+IKL)=0.
@@ -628,28 +636,36 @@ DO JK=IKB,IKE-IKL,IKL
PFRAC_UP(:,JK+IKL)=0.
KKCTL(:)=JK+IKL
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! compute frac_up at JK+KKL
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (GTEST(:))
PFRAC_UP(:,JK+IKL)=PEMF(:,JK+IKL)/&
&(SQRT(ZW_UP2(:,JK+IKL))*ZRHO_F(:,JK+IKL))
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! Updraft fraction must be smaller than XFRAC_UP_MAX
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (GTEST(:))
PFRAC_UP(:,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(:,JK+IKL))
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! When cloudy and non-buoyant, updraft fraction must decrease
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE ((GTEST(:).AND.GTESTETL(:)).AND.GTESTLCL(:))
PFRAC_UP(:,JK+IKL)=MIN(PFRAC_UP(:,JK+IKL),PFRAC_UP(:,JK))
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! Mass flux is updated with the new updraft fraction
+
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
IF (OENTR_DETR) PEMF(:,JK+IKL)=PFRAC_UP(:,JK+IKL)*SQRT(ZW_UP2(:,JK+IKL))* &
&ZRHO_F(:,JK+IKL)
- !$mnh_end_expand_where(JIJ=IIJB:IIJE)
-
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF !OENTR_DETR
ENDDO
@@ -672,14 +688,24 @@ IF(OENTR_DETR) THEN
DO JIJ=IIJB,IIJE
PDEPTH(JIJ) = MAX(0., PZZ(JIJ,KKCTL(JIJ)) - PZZ(JIJ,KKLCL(JIJ)) )
END DO
-
+ IF(PARAMMF%LVERLIMUP) THEN
+ DO JK=1,IKT
+ DO JIJ=IIJB,IIJE
+ KDEPTH(JIJ,JK) = MIN(MAX(0., PZZ(JIJ,JK) - PZZ(JIJ,KKLCL(JIJ)) ), PDEPTH(JIJ))
+ END DO
+ END DO
+ END IF
!$mnh_expand_array(JIJ=IIJB:IIJE)
GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
DO JK=1,IKT
!$mnh_expand_array(JIJ=IIJB:IIJE)
GWORK2(:,JK) = GWORK1(:)
- ZCOEF(:,JK) = (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ IF(PARAMMF%LVERLIMUP) THEN
+ ZCOEF(:,JK) = (1.-(KDEPTH(:,JK)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ ELSE
+ ZCOEF(:,JK) = (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ END IF
ZCOEF(:,JK)=MIN(MAX(ZCOEF(:,JK),0.),1.)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDDO
@@ -693,8 +719,6 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',1,ZHOOK_HANDLE)
CONTAINS
-INCLUDE "th_r_from_thl_rt.func.h"
-INCLUDE "compute_frac_ice.func.h"
SUBROUTINE COMPUTE_ENTR_DETR(D, CST, NEBN, PARAMMF,&
KK,KKB,KKE,KKL,OTEST,OTESTLCL,&
PFRAC_ICE,PRHODREF,&
@@ -1104,6 +1128,8 @@ DO JIJ=IIJB,IIJE
ENDDO
END SUBROUTINE COMPUTE_ENTR_DETR
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
END SUBROUTINE COMPUTE_UPDRAFT
END MODULE MODE_COMPUTE_UPDRAFT
diff --git a/src/PHYEX/turb/mode_compute_updraft_raha.f90 b/src/PHYEX/turb/mode_compute_updraft_raha.f90
index 9eb868cc8664947d4a6196cb2a6d52d1dacb344b..25e1f32a4dbfe82b01857a9ba4b8dc4a72538c87 100644
--- a/src/PHYEX/turb/mode_compute_updraft_raha.f90
+++ b/src/PHYEX/turb/mode_compute_updraft_raha.f90
@@ -581,27 +581,25 @@ PEMF(:,IKB+IKL) = ZRHO_F(:,IKB+IKL)*PFRAC_UP(:,IKB+IKL)* &
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
DO JK=IKB+IKL,IKE-IKL,IKL ! Vertical loop
- !$mnh_expand_where(JIJ=IIJB:IIJE)
-
- GTEST(:) = (ZW_UP2(:,JK) > ZEPS)
-
- WHERE (GTEST(:))
- WHERE(JK<IALIM(:))
- PEMF(:,JK+IKL) = MAX(0.,PEMF(:,JK) + ZPHI(:)*ZZDZ(:,JK)* &
- & (PENTR(:,JK) - PDETR(:,JK)))
- ELSEWHERE
- ZMIX1(:)=ZZDZ(:,JK)*(PENTR(:,JK)-PDETR(:,JK))
- PEMF(:,JK+IKL)=PEMF(:,JK)*EXP(ZMIX1(:))
- ENDWHERE
-
-! Updraft fraction must be smaller than XFRAC_UP_MAX
- PFRAC_UP(:,JK+IKL)=PEMF(:,JK+IKL)/&
- &(SQRT(ZW_UP2(:,JK+IKL))*ZRHO_F(:,JK+IKL))
- PFRAC_UP(:,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(:,JK+IKL))
- PEMF(:,JK+IKL) = ZRHO_F(:,JK+IKL)*PFRAC_UP(:,JK+IKL)*&
- & SQRT(ZW_UP2(:,JK+IKL))
- ENDWHERE
- !$mnh_end_expand_where(JIJ=IIJB:IIJE)
+ DO JIJ=IIJB,IIJE
+ GTEST(JIJ) = (ZW_UP2(JIJ,JK) > ZEPS)
+ IF(GTEST(JIJ)) THEN
+ IF(JK<IALIM(JIJ)) THEN
+ PEMF(JIJ,JK+IKL) = MAX(0.,PEMF(JIJ,JK) + ZPHI(JIJ)*ZZDZ(JIJ,JK)* &
+ & (PENTR(JIJ,JK) - PDETR(JIJ,JK)))
+ ELSE
+ ZMIX1(JIJ)=ZZDZ(JIJ,JK)*(PENTR(JIJ,JK)-PDETR(JIJ,JK))
+ PEMF(JIJ,JK+IKL)=PEMF(JIJ,JK)*EXP(ZMIX1(JIJ))
+ END IF
+
+ ! Updraft fraction must be smaller than XFRAC_UP_MAX
+ PFRAC_UP(JIJ,JK+IKL)=PEMF(JIJ,JK+IKL)/&
+ &(SQRT(ZW_UP2(JIJ,JK+IKL))*ZRHO_F(JIJ,JK+IKL))
+ PFRAC_UP(JIJ,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(JIJ,JK+IKL))
+ PEMF(JIJ,JK+IKL) = ZRHO_F(JIJ,JK+IKL)*PFRAC_UP(JIJ,JK+IKL)*&
+ & SQRT(ZW_UP2(JIJ,JK+IKL))
+ END IF
+ END DO
ENDDO
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
diff --git a/src/PHYEX/turb/mode_emoist.f90 b/src/PHYEX/turb/mode_emoist.f90
index 2ea9b0a80c76943e47c687a2168d024797c45d75..91e02042e8d3cfbd5d2c143df8db8f16bff12e0a 100644
--- a/src/PHYEX/turb/mode_emoist.f90
+++ b/src/PHYEX/turb/mode_emoist.f90
@@ -106,17 +106,17 @@ IKT=D%NKT
!
IF (OOCEAN) THEN
IF ( KRR == 0 ) THEN ! Unsalted
- !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PEMOIST(:,:) = 0.
- !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PEMOIST(:,:) = 1. ! Salted case
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
-!
+ !
ELSE
-!
+ !
IF ( KRR == 0 ) THEN ! dry case
PEMOIST(:,:) = 0.
ELSE IF ( KRR == 1 ) THEN ! only vapor
@@ -127,7 +127,7 @@ ELSE
ELSE ! liquid water & ice present
ZDELTA = (CST%XRV/CST%XRD) - 1.
ZRW(:,:) = PRM(:,:,1)
-!
+ !
IF ( KRRI>0) THEN ! rc and ri case
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZRW(:,:) = ZRW(:,:) + PRM(:,:,3)
@@ -142,12 +142,12 @@ ELSE
(1.+ZDELTA) * (PRM(:,:,1) - PRM(:,:,2) - PRM(:,:,4)) &
-ZRW(:,:) &
) / (1. + ZRW(:,:))
- !
- ! Emoist = ZB + ZC * Amoist
- ! ZB is computed from line 1 to line 2
- ! ZC is computed from line 3 to line 5
- ! Amoist* 2 * SRC is computed at line 6
- !
+ !
+ ! Emoist = ZB + ZC * Amoist
+ ! ZB is computed from line 1 to line 2
+ ! ZC is computed from line 3 to line 5
+ ! Amoist* 2 * SRC is computed at line 6
+ !
PEMOIST(:,:) = ZDELTA * (PTHLM(:,:) + PLOCPEXNM(:,:)*( &
PRM(:,:,2)+PRM(:,:,4)))&
/ (1. + ZRW(:,:)) &
@@ -168,12 +168,12 @@ ELSE
(1.+ZDELTA) * (PRM(:,:,1) - PRM(:,:,2)) &
-ZRW(:,:) &
) / (1. + ZRW(:,:))
- !
- ! Emoist = ZB + ZC * Amoist
- ! ZB is computed from line 1 to line 2
- ! ZC is computed from line 3 to line 5
- ! Amoist* 2 * SRC is computed at line 6
- !
+ !
+ ! Emoist = ZB + ZC * Amoist
+ ! ZB is computed from line 1 to line 2
+ ! ZC is computed from line 3 to line 5
+ ! Amoist* 2 * SRC is computed at line 6
+ !
PEMOIST(:,:) = ZDELTA * (PTHLM(:,:) + PLOCPEXNM(:,:)* &
PRM(:,:,2)) / (1. + ZRW(:,:)) &
+( PLOCPEXNM(:,:) * ZA(:,:) &
@@ -183,7 +183,7 @@ ELSE
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
END IF
-!
+ !
END IF
!---------------------------------------------------------------------------
!
diff --git a/src/PHYEX/turb/mode_etheta.f90 b/src/PHYEX/turb/mode_etheta.f90
index 9296b922c226c77f4501b51efd0731b30a60c307..5fa44027e81b6ea18f97edae38253e178a30be79 100644
--- a/src/PHYEX/turb/mode_etheta.f90
+++ b/src/PHYEX/turb/mode_etheta.f90
@@ -114,9 +114,9 @@ IF (OOCEAN) THEN ! ocean case
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
IF ( KRR == 0) THEN ! dry case
- !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PETHETA(:,:) = 1.
- !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE IF ( KRR == 1 ) THEN ! only vapor
ZDELTA = (CST%XRV/CST%XRD) - 1.
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -127,7 +127,7 @@ ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZRW(:,:) = PRM(:,:,1)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-!
+ !
IF ( KRRI>0 ) THEN ! rc and ri case
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZRW(:,:) = ZRW(:,:) + PRM(:,:,3)
@@ -142,11 +142,11 @@ ELSE
(1.+ZDELTA) * (PRM(:,:,1) - PRM(:,:,2) - PRM(:,:,4)) &
-ZRW(:,:) &
) / (1. + ZRW(:,:))
- !
- ! Etheta = ZA + ZC * Atheta
- ! ZC is computed from line 2 to line 5
- ! - Atheta * 2. * SRC is computed at line 6
- !
+ !
+ ! Etheta = ZA + ZC * Atheta
+ ! ZC is computed from line 2 to line 5
+ ! - Atheta * 2. * SRC is computed at line 6
+ !
PETHETA(:,:) = ZA(:,:) &
+( PLOCPEXNM(:,:) * ZA(:,:) &
-(1.+ZDELTA) * (PTHLM(:,:) + PLOCPEXNM(:,:)*( &
@@ -165,11 +165,11 @@ ELSE
(1.+ZDELTA) * (PRM(:,:,1) - PRM(:,:,2)) &
-ZRW(:,:) &
) / (1. + ZRW(:,:))
- !
- ! Etheta = ZA + ZC * Atheta
- ! ZC is computed from line 2 to line 5
- ! - Atheta * 2. * SRC is computed at line 6
- !
+ !
+ ! Etheta = ZA + ZC * Atheta
+ ! ZC is computed from line 2 to line 5
+ ! - Atheta * 2. * SRC is computed at line 6
+ !
PETHETA(:,:) = ZA(:,:) &
+( PLOCPEXNM(:,:) * ZA(:,:) -(1.+ZDELTA) * (PTHLM(:,:) &
+ PLOCPEXNM(:,:)*PRM(:,:,2)) &
diff --git a/src/PHYEX/turb/mode_mf_turb.f90 b/src/PHYEX/turb/mode_mf_turb.f90
index dd39e118828ce8aefcc48266c5e14b931eec566d..07d0f168a855c77f6f7c08a89c6a95ebfdcd8b26 100644
--- a/src/PHYEX/turb/mode_mf_turb.f90
+++ b/src/PHYEX/turb/mode_mf_turb.f90
@@ -143,8 +143,8 @@ IIJE=D%NIJE
IIJB=D%NIJB
IKT=D%NKT
!
-PFLXZSVMF = 0.
-PSVDT = 0.
+PFLXZSVMF(:,:,:) = 0.
+PSVDT(:,:,:) = 0.
!
!----------------------------------------------------------------------------
diff --git a/src/PHYEX/turb/mode_mf_turb_expl.f90 b/src/PHYEX/turb/mode_mf_turb_expl.f90
index 16d1e9f8a545fa9feb9673b824d361b6470afc5c..90a3b115c91c36648a08740457a7b511cdfdde98 100644
--- a/src/PHYEX/turb/mode_mf_turb_expl.f90
+++ b/src/PHYEX/turb/mode_mf_turb_expl.f90
@@ -115,15 +115,15 @@ IKB=D%NKB
IKE=D%NKE
IKL=D%NKL
!
-PFLXZRMF = 0.
-PFLXZTHVMF = 0.
-PFLXZTHLMF = 0.
-PFLXZUMF = 0.
-PFLXZVMF = 0.
-PTHLDT = 0.
-PRTDT = 0.
-PUDT = 0.
-PVDT = 0.
+PFLXZRMF(:,:) = 0.
+PFLXZTHVMF(:,:) = 0.
+PFLXZTHLMF(:,:) = 0.
+PFLXZUMF(:,:) = 0.
+PFLXZVMF(:,:) = 0.
+PTHLDT(:,:) = 0.
+PRTDT(:,:) = 0.
+PUDT(:,:) = 0.
+PVDT(:,:) = 0.
!
!----------------------------------------------------------------------------
diff --git a/src/PHYEX/turb/mode_rmc01.f90 b/src/PHYEX/turb/mode_rmc01.f90
index 98f6db452f8880477d95205668fe0f53b25b4cbe..33a910df07f804749975d3ea78059a2769a28ca9 100644
--- a/src/PHYEX/turb/mode_rmc01.f90
+++ b/src/PHYEX/turb/mode_rmc01.f90
@@ -185,9 +185,9 @@ SELECT CASE (TURBN%CTURBLEN)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
-!* 4. factor controling the transition between SBL and free isotropic turb. (3D case)
-! --------------------------------------------------------------------
-!
+ !* 4. factor controling the transition between SBL and free isotropic turb. (3D case)
+ ! --------------------------------------------------------------------
+ !
ZGAM(:,IKA) = 0.
DO JK=IKTB,IKTE
!$mnh_expand_array(JIJ=IIJB:IIJE)
@@ -208,15 +208,15 @@ SELECT CASE (TURBN%CTURBLEN)
ZGAM(:,IKU) = 1.
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. factor controling the transition between SBL and free isotropic turb.(1D case)
-! --------------------------------------------------------------------
-!
+ !
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 5. factor controling the transition between SBL and free isotropic turb.(1D case)
+ ! --------------------------------------------------------------------
+ !
CASE DEFAULT
-!* SBL depth is used
+ !* SBL depth is used
ZGAM(:,:) = 1.
ZGAM(:,IKA) = 0.
DO JK=IKTB,IKTE
@@ -235,14 +235,14 @@ SELECT CASE (TURBN%CTURBLEN)
WHERE(PSBL_DEPTH(:)>0.)
ZGAM(:,IKU) = TANH( (ZZZ(:,IKU)-ZZZ(:,IKB))/PSBL_DEPTH(:) )
END WHERE
- !$mnh_end_expand_where(JIJ=IIJB:IIJE)
- !$mnh_expand_where(JIJ=IIJB:IIJE)
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (ZGAM(:,IKU-IKL)>0.99 )
ZGAM(:,JK) = 1.
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
-!
-!-------------------------------------------------------------------------------
+ !
+ !-------------------------------------------------------------------------------
END SELECT
!-------------------------------------------------------------------------------
!
@@ -250,10 +250,10 @@ END SELECT
! ---------------------------------
!
DO JK=1,IKT
-!$mnh_expand_array(JIJ=IIJB:IIJE)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
ZL(:,JK) = CST%XKARMAN/SQRT(CSTURB%XALPSBL)/CSTURB%XCMFS &
* ZZZ(:,JK)*PDIRCOSZW(:)/(ZPHIM(:,JK)**2*SQRT(ZPHIE(:,JK)))
-!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
diff --git a/src/PHYEX/turb/mode_turb_ver.f90 b/src/PHYEX/turb/mode_turb_ver.f90
index 5b767c7e0aa72375096a291797cb0e07931fbbc7..02c1a67500ade26748dec2fd8dfc661962931e26 100644
--- a/src/PHYEX/turb/mode_turb_ver.f90
+++ b/src/PHYEX/turb/mode_turb_ver.f90
@@ -325,8 +325,8 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFWR ! d(w'2r' )/dz
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFTHR ! d(w'th'r')/dz
-REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%CTOM=='TM06')),INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
-REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%LRMC01)),INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
+REAL, DIMENSION(D%NIJT),INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
+REAL, DIMENSION(D%NIJT),INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
REAL, DIMENSION(D%NIJT), INTENT(IN) :: PLMO ! Monin-Obukhov length
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
@@ -461,8 +461,13 @@ ENDIF
GUSERV = KRR/=0
!
CALL PHI3(D,CSTURB,TURBN,ZREDTH1,ZREDR1,ZRED2TH3,ZRED2R3,ZRED2THR3,TURBN%CTURBDIM,GUSERV,ZPHI3)
-IF(KRR/=0) &
-CALL PSI3(D,CSTURB,TURBN,ZREDR1,ZREDTH1,ZRED2R3,ZRED2TH3,ZRED2THR3,TURBN%CTURBDIM,GUSERV,ZPSI3)
+IF(KRR/=0) THEN
+ CALL PSI3(D,CSTURB,TURBN,ZREDR1,ZREDTH1,ZRED2R3,ZRED2TH3,ZRED2THR3,TURBN%CTURBDIM,GUSERV,ZPSI3)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZPSI3(:,:) = 1.
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
!
! Prandtl numbers for scalars
!
diff --git a/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90 b/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
index 642acf3e12abd8935db4dcf8e9b161c1a6b9942c..e895283b0fe679202672555b72d8bd15b05a8245 100644
--- a/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
@@ -325,8 +325,7 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-REAL, DIMENSION(MERGE(D%NIT,0,TURBN%CTOM=='TM06'),&
- MERGE(D%NJT,0,TURBN%CTOM=='TM06')), INTENT(INOUT):: PBL_DEPTH ! BL depth
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(INOUT):: PBL_DEPTH ! BL depth
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWTHV ! buoyancy flux
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRTHLS ! cumulated source for theta
@@ -496,7 +495,7 @@ IF (GFWTH) THEN
CALL M3_WTH_W2TH(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,Z3RDMOMENT)
CALL D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,&
& PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM,ZWORK1)
-!
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:)= ZF(:,:) + Z3RDMOMENT(:,:) * PFWTH(:,:)
ZDFDDTDZ(:,:) = ZDFDDTDZ(:,:) + ZWORK1(:,:) &
@@ -510,7 +509,7 @@ IF (GFTH2) THEN
CALL D_M3_WTH_WTH2_O_DDTDZ(D,CSTURB,TURBN,Z3RDMOMENT,PREDTH1,PREDR1,&
& PD,PBLL_O_E,PETHETA,ZWORK1)
CALL MZM_PHY(D,PFTH2,ZWORK2)
-!
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:) = ZF(:,:) + Z3RDMOMENT(:,:) &
* ZWORK2(:,:)
@@ -523,7 +522,7 @@ END IF
IF (GFWR) THEN
CALL M3_WTH_W2R(D,CSTURB,TURBN,PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK1)
CALL D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST,ZWORK2)
-!
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:) = ZF(:,:) + ZWORK1(:,:) * PFWR(:,:)
ZDFDDTDZ(:,:) = ZDFDDTDZ(:,:) + ZWORK2(:,:) &
@@ -537,7 +536,7 @@ IF (GFR2) THEN
CALL MZM_PHY(D,PFR2,ZWORK2)
CALL D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,&
& ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,ZWORK3)
-!
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:) = ZF(:,:) + ZWORK1(:,:) * ZWORK2(:,:)
ZDFDDTDZ(:,:) = ZDFDDTDZ(:,:) + ZWORK3(:,:) &
@@ -551,7 +550,7 @@ IF (GFTHR) THEN
& PLEPS,PEMOIST,Z3RDMOMENT)
CALL D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,TURBN,Z3RDMOMENT,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,ZWORK1)
CALL MZM_PHY(D,PFTHR, ZWORK2)
-!
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:) = ZF(:,:) + Z3RDMOMENT(:,:) &
* ZWORK2(:,:)
@@ -582,9 +581,9 @@ ELSE ! atmosp bottom
* 0.5 * (1. + PRHODJ(:,IKA) / PRHODJ(:,IKB))
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
-!
- ! atmos top
- ZF(:,IKE+1)=0.
+ !
+ ! atmos top
+ ZF(:,IKE+1)=0.
END IF
!
! Compute the split conservative potential temperature at t+deltat
@@ -602,7 +601,7 @@ IF (TURBN%LLEONARD) THEN
DO JK=1,IKT
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZALT(:,JK) = PZZ(:,JK)-PZS(:)
- !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
CALL MZM_PHY(D,PRHODJ,ZWORK1)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -891,7 +890,7 @@ IF (KRR /= 0) THEN
CALL M3_WR_W2R(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,ZKEFF,PTKEM,Z3RDMOMENT)
CALL D_M3_WR_W2R_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,&
& PBLL_O_E,PEMOIST,ZKEFF,PTKEM,ZWORK1)
- !
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:)= ZF(:,:) + Z3RDMOMENT(:,:) * PFWR(:,:)
ZDFDDRDZ(:,:) = ZDFDDRDZ(:,:) + ZWORK1(:,:) &
@@ -905,7 +904,7 @@ IF (KRR /= 0) THEN
CALL MZM_PHY(D,PFR2,ZWORK1)
CALL D_M3_WR_WR2_O_DDRDZ(D,CSTURB,TURBN,Z3RDMOMENT,PREDR1,&
& PREDTH1,PD,PBLL_O_E,PEMOIST,ZWORK2)
- !
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:) = ZF(:,:) + Z3RDMOMENT(:,:) &
* ZWORK1(:,:)
@@ -920,7 +919,7 @@ IF (KRR /= 0) THEN
& PTKEM,PBLL_O_E,PETHETA,PDR_DZ,ZWORK1)
CALL D_M3_WR_W2TH_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,&
& PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA,ZWORK2)
- !
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:) = ZF(:,:) + ZWORK1(:,:) * PFWTH(:,:)
ZDFDDRDZ(:,:) = ZDFDDRDZ(:,:) + ZWORK2(:,:) &
@@ -950,7 +949,7 @@ IF (KRR /= 0) THEN
CALL MZM_PHY(D,PFTHR,ZWORK1)
CALL D_M3_WR_WTHR_O_DDRDZ(D,CSTURB,TURBN,Z3RDMOMENT,PREDR1, &
& PREDTH1,PD,PBLL_O_E,PEMOIST,ZWORK2)
- !
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:) = ZF(:,:) + Z3RDMOMENT(:,:) &
* ZWORK1(:,:)
diff --git a/src/PHYEX/turb/modi_turb.f90 b/src/PHYEX/turb/modi_turb.f90
index 302d34ae89dbb7fc4ff5b39440d9495b3da70b78..e36d2aaa36d55d238aadb2590788274a135e419d 100644
--- a/src/PHYEX/turb/modi_turb.f90
+++ b/src/PHYEX/turb/modi_turb.f90
@@ -109,8 +109,8 @@ REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVT ! passive scal. va
REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
MERGE(D%NKT,0,OCOMPUTE_SRC)), INTENT(IN) :: PSRCT ! Second-order flux
! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
-REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%CTOM=='TM06')),INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
-REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%LRMC01)),INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
+REAL, DIMENSION(D%NIJT),INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
+REAL, DIMENSION(D%NIJT),INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
!
! variables for cloud mixing length
REAL, DIMENSION(MERGE(D%NIJT,0,OCLOUDMODIFLM),&
diff --git a/src/PHYEX/turb/shallow_mf.f90 b/src/PHYEX/turb/shallow_mf.f90
index 4488cea00924ce0abea7027e78b961794ec3d0f4..ae7a665ce932ad94538a014656203bfaecac7477 100644
--- a/src/PHYEX/turb/shallow_mf.f90
+++ b/src/PHYEX/turb/shallow_mf.f90
@@ -199,10 +199,10 @@ IKT=D%NKT
!
! updraft governing variables
IF (PARAMMF%CMF_UPDRAFT == 'EDKF' .OR. PARAMMF%CMF_UPDRAFT == 'RHCJ') THEN
- PENTR = 1.E20
- PDETR = 1.E20
- PEMF = 1.E20
- ZBUO_INTEG = 1.E20
+ PENTR(:,:) = 1.E20
+ PDETR(:,:) = 1.E20
+ PEMF(:,:) = 1.E20
+ ZBUO_INTEG(:,:) = 1.E20
ENDIF
! Thermodynamics functions
@@ -217,7 +217,7 @@ ENDIF
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZWK(:,:)=PTHM(:,:)*PEXNM(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-CALL COMPUTE_FRAC_ICE(NEBN%CFRAC_ICE_SHALLOW_MF,NEBN,ZFRAC_ICE(:,:),ZWK(:,:), IERR(:,:))
+CALL COMPUTE_FRAC_ICE(CST, NEBN%CFRAC_ICE_SHALLOW_MF,NEBN,ZFRAC_ICE(:,:),ZWK(:,:), IERR(:,:))
! Conservative variables at t-dt
CALL THL_RT_FROM_TH_R_MF(D, CST, KRR,KRRL,KRRI, &
@@ -327,7 +327,7 @@ ENDIF
! to be modified if 'DUAL' is evolving (momentum mixing for example)
IF( PARAMMF%CMF_UPDRAFT == 'DUAL') THEN
! Now thetav_up from vdfhghtnn is used!
- PFLXZTHVMF=0.
+ PFLXZTHVMF(:,:)=0.
! Yes/No UV mixing!
! PDUDT_MF=0.
! PDVDT_MF=0.
diff --git a/src/PHYEX/turb/th_r_from_thl_rt.func.h b/src/PHYEX/turb/th_r_from_thl_rt.func.h
index fc5071e3727276956b50b7149f44a1a5ac6b8be6..e1c5abe0b51e69ad7bbeb9189198a9747c865ed1 100644
--- a/src/PHYEX/turb/th_r_from_thl_rt.func.h
+++ b/src/PHYEX/turb/th_r_from_thl_rt.func.h
@@ -83,7 +83,7 @@ INTEGER, OPTIONAL, INTENT(IN) :: KE !last index to deal with (default if KT)
! 0.2 declaration of local variables
INTEGER :: II ! Loop control
INTEGER :: JITER ! number of iterations
-INTEGER :: J, IB, IE
+INTEGER :: JIJ, IIJB, IIJE
INTEGER, PARAMETER :: IEXN=1, IRVSAT=2, ICPH=3, IRLTEMP=4, ICPH2=5, IT=6, ILVOCPEXN=7, ILSOCPEXN=8, &
& IDRSATODT=9, IDRSATODTW=10, IDRSATODTI=11, IFOESW=12, IFOESI=13, &
& ILOGT=14, I99PP=15, I1PRT=16
@@ -97,40 +97,40 @@ REAL :: ZVAR1, ZVAR2, ZTPOW2, ZDELT
!
!
IF ( PRESENT(KB) ) THEN
- IB = KB
+ IIJB = KB
ELSE
- IB = 1
+ IIJB = 1
END IF
IF ( PRESENT(KE) ) THEN
- IE = KE
+ IIJE = KE
ELSE
- IE = KT
+ IIJE = KT
END IF
!Number of iterations
JITER=2
!
-!Computation of PBUF(IB:IE, ICPH2) depending on dummy arguments received
-PBUF(IB:IE, ICPH2)=0
-IF(PRESENT(PRR)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCL*PRR(IB:IE)
-IF(PRESENT(PRS)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCI*PRS(IB:IE)
-IF(PRESENT(PRG)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCI*PRG(IB:IE)
-IF(PRESENT(PRH)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCI*PRH(IB:IE)
+!Computation of PBUF(:, ICPH2) depending on dummy arguments received
+PBUF(:, ICPH2)=0
+IF(PRESENT(PRR)) PBUF(:, ICPH2)=PBUF(:, ICPH2) + CST%XCL*PRR(:)
+IF(PRESENT(PRS)) PBUF(:, ICPH2)=PBUF(:, ICPH2) + CST%XCI*PRS(:)
+IF(PRESENT(PRG)) PBUF(:, ICPH2)=PBUF(:, ICPH2) + CST%XCI*PRG(:)
+IF(PRESENT(PRH)) PBUF(:, ICPH2)=PBUF(:, ICPH2) + CST%XCI*PRH(:)
!
!Computation of an approximate state thanks to PRL and PRI guess
-PBUF(IB:IE, IEXN)=(PP(IB:IE)/CST%XP00) ** CST%RDSCPD
+PBUF(:, IEXN)=(PP(:)/CST%XP00) ** CST%RDSCPD
-DO J=IB,IE
- PBUF(J, I99PP)=0.99*PP(J)
- PRV(J)=PRT(J)-PRL(J)-PRI(J)
- PBUF(J, ICPH)=CST%XCPD+ CST%XCPV * PRV(J)+ CST%XCL * PRL(J) + CST%XCI * PRI(J) + PBUF(J, ICPH2)
- ZVAR2=PBUF(J, ICPH)*PBUF(J, IEXN)
- ZDELT=(PTHL(J)*PBUF(J, IEXN))-CST%XTT
- PBUF(J, ILVOCPEXN) = (CST%XLVTT + (CST%XCPV-CST%XCL) * ZDELT) /ZVAR2
- PBUF(J, ILSOCPEXN) = (CST%XLSTT + (CST%XCPV-CST%XCI) * ZDELT) /ZVAR2
- PTH(J)=PTHL(J)+PBUF(J, ILVOCPEXN)*PRL(J)+PBUF(J, ILSOCPEXN)*PRI(J)
- PBUF(J, I1PRT)=1+PRT(J)
+DO JIJ=IIJB,IIJE
+ PBUF(JIJ, I99PP)=0.99*PP(JIJ)
+ PRV(JIJ)=PRT(JIJ)-PRL(JIJ)-PRI(JIJ)
+ PBUF(JIJ, ICPH)=CST%XCPD+ CST%XCPV * PRV(JIJ)+ CST%XCL * PRL(JIJ) + CST%XCI * PRI(JIJ) + PBUF(JIJ, ICPH2)
+ ZVAR2=PBUF(JIJ, ICPH)*PBUF(JIJ, IEXN)
+ ZDELT=(PTHL(JIJ)*PBUF(JIJ, IEXN))-CST%XTT
+ PBUF(JIJ, ILVOCPEXN) = (CST%XLVTT + (CST%XCPV-CST%XCL) * ZDELT) /ZVAR2
+ PBUF(JIJ, ILSOCPEXN) = (CST%XLSTT + (CST%XCPV-CST%XCI) * ZDELT) /ZVAR2
+ PTH(JIJ)=PTHL(JIJ)+PBUF(JIJ, ILVOCPEXN)*PRL(JIJ)+PBUF(JIJ, ILSOCPEXN)*PRI(JIJ)
+ PBUF(JIJ, I1PRT)=1+PRT(JIJ)
ENDDO
!
!
@@ -139,73 +139,73 @@ ENDDO
DO II=1,JITER
IF (OOCEAN) THEN
- PBUF(IB:IE, IT)=PTH(IB:IE)
+ PBUF(:, IT)=PTH(:)
ELSE
- PBUF(IB:IE, IT)=PTH(IB:IE)*PBUF(IB:IE, IEXN)
+ PBUF(:, IT)=PTH(:)*PBUF(:, IEXN)
END IF
!Computation of liquid/ice fractions
- PFRAC_ICE(IB:IE) = 0.
- DO J=IB, IE
- IF(PRL(J)+PRI(J) > 1.E-20) THEN
- PFRAC_ICE(J) = PRI(J) / (PRL(J)+PRI(J))
+ PFRAC_ICE(:) = 0.
+ DO JIJ=IIJB, IIJE
+ IF(PRL(JIJ)+PRI(JIJ) > 1.E-20) THEN
+ PFRAC_ICE(JIJ) = PRI(JIJ) / (PRL(JIJ)+PRI(JIJ))
ENDIF
ENDDO
- CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEBN,PFRAC_ICE(IB:IE),PBUF(IB:IE, IT))
+ CALL COMPUTE_FRAC_ICE(CST, HFRAC_ICE,NEBN,PFRAC_ICE(:),PBUF(:, IT))
!Computation of Rvsat and dRsat/dT
!In this version QSAT, QSATI, DQSAT and DQASATI functions are not used
!due to performance issue
! Log does not vectorize on all compilers:
- PBUF(IB:IE, ILOGT)=LOG(PBUF(IB:IE, IT))
+ PBUF(:, ILOGT)=LOG(PBUF(:, IT))
- DO J=IB, IE
- PBUF(J, IFOESW) = MIN(EXP( CST%XALPW - CST%XBETAW/PBUF(J, IT) - CST%XGAMW*PBUF(J, ILOGT) ), PBUF(J, I99PP))
- PBUF(J, IFOESI) = MIN(EXP( CST%XALPI - CST%XBETAI/PBUF(J, IT) - CST%XGAMI*PBUF(J, ILOGT) ), PBUF(J, I99PP))
- PRSATW(J) = CST%XRD/CST%XRV*PBUF(J, IFOESW)/PP(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESW)/PP(J))
- PRSATI(J) = CST%XRD/CST%XRV*PBUF(J, IFOESI)/PP(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESI)/PP(J))
- ZTPOW2=PBUF(J, IT)**2
- PBUF(J, IDRSATODTW) = PRSATW(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESW)/PP(J) ) &
- * (CST%XBETAW/ZTPOW2 - CST%XGAMW/PBUF(J, IT))*PBUF(J, I1PRT)
- PBUF(J, IDRSATODTI) = PRSATI(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESI)/PP(J) ) &
- * (CST%XBETAI/ZTPOW2 - CST%XGAMI/PBUF(J, IT))*PBUF(J, I1PRT)
- !PRSATW(J) = QSAT(PBUF(J, IT),PP(J)) !qsatw
- !PRSATI(J) = QSATI(PBUF(J, IT),PP(J)) !qsati
- !PBUF(J, IDRSATODTW) = DQSAT(PBUF(J, IT),PP(J),PRSATW(J))*PBUF(J, I1PRT)
- !PBUF(J, IDRSATODTI) = DQSATI(PBUF(J, IT),PP(J),PRSATI(J))*PBUF(J, I1PRT)
- PRSATW(J) = PRSATW(J)*PBUF(J, I1PRT)
- PRSATI(J) = PRSATI(J)*PBUF(J, I1PRT)
- PBUF(J, IRVSAT) = PRSATW(J)*(1-PFRAC_ICE(J)) + PRSATI(J)*PFRAC_ICE(J)
- PBUF(J, IDRSATODT) = (PBUF(J, IDRSATODTW)*(1-PFRAC_ICE(J))+ &
- & PBUF(J, IDRSATODTI)*PFRAC_ICE(J))
+ DO JIJ=IIJB, IIJE
+ PBUF(JIJ, IFOESW) = MIN(EXP( CST%XALPW - CST%XBETAW/PBUF(JIJ, IT) - CST%XGAMW*PBUF(JIJ, ILOGT) ), PBUF(JIJ, I99PP))
+ PBUF(JIJ, IFOESI) = MIN(EXP( CST%XALPI - CST%XBETAI/PBUF(JIJ, IT) - CST%XGAMI*PBUF(JIJ, ILOGT) ), PBUF(JIJ, I99PP))
+ PRSATW(JIJ) = CST%XRD/CST%XRV*PBUF(JIJ, IFOESW)/PP(JIJ) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(JIJ, IFOESW)/PP(JIJ))
+ PRSATI(JIJ) = CST%XRD/CST%XRV*PBUF(JIJ, IFOESI)/PP(JIJ) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(JIJ, IFOESI)/PP(JIJ))
+ ZTPOW2=PBUF(JIJ, IT)**2
+ PBUF(JIJ, IDRSATODTW) = PRSATW(JIJ) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(JIJ, IFOESW)/PP(JIJ) ) &
+ * (CST%XBETAW/ZTPOW2 - CST%XGAMW/PBUF(JIJ, IT))*PBUF(JIJ, I1PRT)
+ PBUF(JIJ, IDRSATODTI) = PRSATI(JIJ) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(JIJ, IFOESI)/PP(JIJ) ) &
+ * (CST%XBETAI/ZTPOW2 - CST%XGAMI/PBUF(JIJ, IT))*PBUF(JIJ, I1PRT)
+ !PRSATW(JIJ) = QSAT(PBUF(JIJ, IT),PP(JIJ)) !qsatw
+ !PRSATI(JIJ) = QSATI(PBUF(JIJ, IT),PP(JIJ)) !qsati
+ !PBUF(JIJ, IDRSATODTW) = DQSAT(PBUF(JIJ, IT),PP(JIJ),PRSATW(JIJ))*PBUF(JIJ, I1PRT)
+ !PBUF(JIJ, IDRSATODTI) = DQSATI(PBUF(JIJ, IT),PP(JIJ),PRSATI(JIJ))*PBUF(JIJ, I1PRT)
+ PRSATW(JIJ) = PRSATW(JIJ)*PBUF(JIJ, I1PRT)
+ PRSATI(JIJ) = PRSATI(JIJ)*PBUF(JIJ, I1PRT)
+ PBUF(JIJ, IRVSAT) = PRSATW(JIJ)*(1-PFRAC_ICE(JIJ)) + PRSATI(JIJ)*PFRAC_ICE(JIJ)
+ PBUF(JIJ, IDRSATODT) = (PBUF(JIJ, IDRSATODTW)*(1-PFRAC_ICE(JIJ))+ &
+ & PBUF(JIJ, IDRSATODTI)*PFRAC_ICE(JIJ))
!Computation of new PRL, PRI and PRV
- !Correction term applied to (PRV(J)-PBUF(J, IRVSAT)) is computed assuming that
- !PBUF(J, ILVOCPEXN), PBUF(J, ILSOCPEXN) and PBUF(J, ICPH) don't vary too much with T. It takes into account
+ !Correction term applied to (PRV(JIJ)-PBUF(JIJ, IRVSAT)) is computed assuming that
+ !PBUF(JIJ, ILVOCPEXN), PBUF(JIJ, ILSOCPEXN) and PBUF(JIJ, ICPH) don't vary too much with T. It takes into account
!the variation (estimated linear) of Qsat with T
- PBUF(J, IRLTEMP)=(PRV(J)-PBUF(J, IRVSAT))/ &
- &(1 + PBUF(J, IDRSATODT)*PBUF(J, IEXN)* &
- & (PBUF(J, ILVOCPEXN)*(1-PFRAC_ICE(J))+PBUF(J, ILSOCPEXN)*PFRAC_ICE(J)))
- PBUF(J, IRLTEMP)=MIN(MAX(-PRL(J)-PRI(J), PBUF(J, IRLTEMP)),PRV(J))
- PRV(J)=PRV(J)-PBUF(J, IRLTEMP)
- PRL(J)=PRL(J)+PRI(J)+PBUF(J, IRLTEMP)
- PRI(J)=PFRAC_ICE(J) * (PRL(J))
- PRL(J)=(1-PFRAC_ICE(J)) * (PRT(J) - PRV(J))
+ PBUF(JIJ, IRLTEMP)=(PRV(JIJ)-PBUF(JIJ, IRVSAT))/ &
+ &(1 + PBUF(JIJ, IDRSATODT)*PBUF(JIJ, IEXN)* &
+ & (PBUF(JIJ, ILVOCPEXN)*(1-PFRAC_ICE(JIJ))+PBUF(JIJ, ILSOCPEXN)*PFRAC_ICE(JIJ)))
+ PBUF(JIJ, IRLTEMP)=MIN(MAX(-PRL(JIJ)-PRI(JIJ), PBUF(JIJ, IRLTEMP)),PRV(JIJ))
+ PRV(JIJ)=PRV(JIJ)-PBUF(JIJ, IRLTEMP)
+ PRL(JIJ)=PRL(JIJ)+PRI(JIJ)+PBUF(JIJ, IRLTEMP)
+ PRI(JIJ)=PFRAC_ICE(JIJ) * (PRL(JIJ))
+ PRL(JIJ)=(1-PFRAC_ICE(JIJ)) * (PRT(JIJ) - PRV(JIJ))
!Computation of Cph (as defined in Meso-NH doc, equation 2.2, to be used with mixing ratios)
- PBUF(J, ICPH)=CST%XCPD+ CST%XCPV * PRV(J)+ CST%XCL * PRL(J) + CST%XCI * PRI(J) + PBUF(J, ICPH2)
+ PBUF(JIJ, ICPH)=CST%XCPD+ CST%XCPV * PRV(JIJ)+ CST%XCL * PRL(JIJ) + CST%XCI * PRI(JIJ) + PBUF(JIJ, ICPH2)
!Computation of L/Cph/EXN, then new PTH
- ZVAR2=PBUF(J, ICPH)*PBUF(J, IEXN)
- PBUF(J, ILVOCPEXN) = (CST%XLVTT + (CST%XCPV-CST%XCL) * (PBUF(J, IT)-CST%XTT)) /ZVAR2
- PBUF(J, ILSOCPEXN) = (CST%XLSTT + (CST%XCPV-CST%XCI) * (PBUF(J, IT)-CST%XTT)) /ZVAR2
- PTH(J)=PTHL(J)+PBUF(J, ILVOCPEXN)*PRL(J)+PBUF(J, ILSOCPEXN)*PRI(J)
+ ZVAR2=PBUF(JIJ, ICPH)*PBUF(JIJ, IEXN)
+ PBUF(JIJ, ILVOCPEXN) = (CST%XLVTT + (CST%XCPV-CST%XCL) * (PBUF(JIJ, IT)-CST%XTT)) /ZVAR2
+ PBUF(JIJ, ILSOCPEXN) = (CST%XLSTT + (CST%XCPV-CST%XCI) * (PBUF(JIJ, IT)-CST%XTT)) /ZVAR2
+ PTH(JIJ)=PTHL(JIJ)+PBUF(JIJ, ILVOCPEXN)*PRL(JIJ)+PBUF(JIJ, ILSOCPEXN)*PRI(JIJ)
!Computation of estimated mixing ration at saturation
!To compute the adjustement a first order development was used
- ZVAR1=PTH(J)*PBUF(J, IEXN)-PBUF(J, IT)
- PRSATW(J)=PRSATW(J) + PBUF(J, IDRSATODTW)*ZVAR1
- PRSATI(J)=PRSATI(J) + PBUF(J, IDRSATODTI)*ZVAR1
+ ZVAR1=PTH(JIJ)*PBUF(JIJ, IEXN)-PBUF(JIJ, IT)
+ PRSATW(JIJ)=PRSATW(JIJ) + PBUF(JIJ, IDRSATODTW)*ZVAR1
+ PRSATI(JIJ)=PRSATI(JIJ) + PBUF(JIJ, IDRSATODTI)*ZVAR1
ENDDO
ENDDO
diff --git a/src/PHYEX/turb/turb.f90 b/src/PHYEX/turb/turb.f90
index 42b1d1cb8485d0e037f5b0264d79ffc8c090e022..168e0caeac8ebdbf45e58743e7183f4328959c33 100644
--- a/src/PHYEX/turb/turb.f90
+++ b/src/PHYEX/turb/turb.f90
@@ -244,7 +244,7 @@ USE MODE_SHUMAN_PHY, ONLY: MZF_PHY,MXF_PHY,MYF_PHY
USE YOMHOOK , ONLY: LHOOK, DR_HOOK, JPHOOK
!
USE MODD_BUDGET, ONLY: NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
- NBUDGET_RI, NBUDGET_SV1, &
+ NBUDGET_RI, NBUDGET_SV1, NBUDGET_RG, NBUDGET_RH, NBUDGET_RR, NBUDGET_RS, &
TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
@@ -277,6 +277,7 @@ USE MODE_TURB_VER, ONLY: TURB_VER
USE MODE_UPDATE_LM, ONLY: UPDATE_LM
!
USE MODI_LES_MEAN_SUBGRID_PHY
+USE MODI_SECOND_MNH, ONLY: SECOND_MNH
!
!
IMPLICIT NONE
@@ -352,8 +353,8 @@ REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVT ! passive scal. va
REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
MERGE(D%NKT,0,OCOMPUTE_SRC)), INTENT(IN) :: PSRCT ! Second-order flux
! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
-REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%CTOM=='TM06')),INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
-REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%LRMC01)),INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
+REAL, DIMENSION(D%NIJT),INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
+REAL, DIMENSION(D%NIJT),INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
!
! variables for cloud mixing length
REAL, DIMENSION(MERGE(D%NIJT,0,OCLOUDMODIFLM),&
@@ -502,6 +503,11 @@ REAL :: ZALPHA ! work coefficient :
REAL :: ZTIME1, ZTIME2
TYPE(TFIELDMETADATA) :: TZFIELD
!
+REAL, DIMENSION(D%NIJT,D%NKT,MERGE(KSV+KRR,KSV,TURBN%LTURB_PRECIP)) :: ZWORKT, ZWORKS
+REAL, DIMENSION(D%NIJT, MERGE(KSV+KRR,KSV,TURBN%LTURB_PRECIP)) :: ZWORKSFSV
+REAL, DIMENSION(D%NIJT,D%NKT,MERGE(KSV+KRR,KSV,TURBN%LTURB_PRECIP)) :: ZWORKWSV
+INTEGER :: ISV
+!
!* 1.PRELIMINARIES
! -------------
!
@@ -541,6 +547,15 @@ END IF
!Save LIMA scalar variables sources
ZRSVS(:,:,1:KSV)=PRSVS(:,:,1:KSV)
!
+ISV=KSV
+IF (TURBN%LTURB_PRECIP) ISV=KSV+KRR
+ZWORKT(:,:,1:KSV)=PSVT(:,:,:)
+ZWORKS(:,:,1:KSV)=PRSVS(:,:,:)
+IF (TURBN%LTURB_PRECIP) ZWORKT(:,:,KSV+1:KSV+KRR)=PRT(:,:,:)
+IF (TURBN%LTURB_PRECIP) ZWORKS(:,:,KSV+1:KSV+KRR)=PRRS(:,:,:)
+ZWORKSFSV(:,:)=0.
+ZWORKWSV(:,:,:)=0.
+ZWORKSFSV(:,1:KSV)=PSFSV(:,:)
!
!----------------------------------------------------------------------------
!
@@ -555,27 +570,27 @@ ZCP(:,:)=CST%XCPD
IF (KRR > 0) ZCP(:,:) = ZCP(:,:) + CST%XCPV * PRT(:,:,1)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
DO JRR = 2,1+KRRL ! loop on the liquid components
-!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZCP(:,:) = ZCP(:,:) + CST%XCL * PRT(:,:,JRR)
-!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END DO
!
DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
-!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZCP(:,:) = ZCP(:,:) + CST%XCI * PRT(:,:,JRR)
-!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END DO
!
!* 2.2 Exner function at t
!
IF (OOCEAN) THEN
-!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZEXN(:,:) = 1.
-!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
-!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZEXN(:,:) = (PPABST(:,:)/CST%XP00) ** (CST%XRD/CST%XCPD)
-!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
!* 2.3 dissipative heating coeff a t
@@ -590,18 +605,18 @@ ZATHETA(:,:) = 0.0
ZAMOIST(:,:) = 0.0
!
IF (KRRL >=1) THEN
-!
-!* 2.4 Temperature at t
-!
+ !
+ !* 2.4 Temperature at t
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZT(:,:) = PTHLT(:,:) * ZEXN(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-!
-!* 2.5 Lv/Cph/Exn
-!
+ !
+ !* 2.5 Lv/Cph/Exn
+ !
IF ( KRRI >= 1 ) THEN
IF (NEBN%LSTATNW) THEN
- !wc call new functions depending on statnew
+ !wc call new functions depending on statnew
CALL COMPUTE_FUNCTION_THERMO_NEW_STAT(CST%XALPW,CST%XBETAW,CST%XGAMW,CST%XLVTT,CST%XCL,ZT,ZEXN,ZCP, &
ZLVOCPEXNM,ZAMOIST,ZATHETA)
CALL COMPUTE_FUNCTION_THERMO_NEW_STAT(CST%XALPI,CST%XBETAI,CST%XGAMI,CST%XLSTT,CST%XCI,ZT,ZEXN,ZCP, &
@@ -612,14 +627,14 @@ IF (KRRL >=1) THEN
CALL COMPUTE_FUNCTION_THERMO(CST%XALPI,CST%XBETAI,CST%XGAMI,CST%XLSTT,CST%XCI,ZT,ZEXN,ZCP, &
ZLSOCPEXNM,ZAMOIST_ICE,ZATHETA_ICE)
ENDIF
-!
+ !
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
WHERE(PRT(:,:,2)+PRT(:,:,4)>0.0)
ZFRAC_ICE(:,:) = PRT(:,:,4) / ( PRT(:,:,2) &
+PRT(:,:,4) )
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
-!
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZLOCPEXNM(:,:) = (1.0-ZFRAC_ICE(:,:))*ZLVOCPEXNM(:,:) &
+ZFRAC_ICE(:,:) *ZLSOCPEXNM(:,:)
@@ -638,8 +653,8 @@ IF (KRRL >=1) THEN
ZLOCPEXNM,ZAMOIST,ZATHETA)
ENDIF
END IF
-!
-!
+ !
+ !
IF ( TPFILE%LOPENED .AND. TURBN%LTURB_DIAG ) THEN
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'ATHETA', &
@@ -653,7 +668,7 @@ IF (KRRL >=1) THEN
NDIMS = 3, &
LTIMEDEP = .TRUE. )
CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZATHETA)
-!
+ !
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'AMOIST', &
CSTDNAME = '', &
@@ -667,7 +682,7 @@ IF (KRRL >=1) THEN
LTIMEDEP = .TRUE. )
CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZAMOIST)
END IF
-!
+ !
ELSE
ZLOCPEXNM(:,:)=0.
END IF ! loop end on KRRL >= 1
@@ -721,16 +736,16 @@ END IF
IF (.NOT. TURBN%LHARAT) THEN
SELECT CASE (TURBN%CTURBLEN)
-!
-!* 3.1 BL89 mixing length
-! ------------------
+ !
+ !* 3.1 BL89 mixing length
+ ! ------------------
CASE ('BL89')
ZSHEAR(:,:)=0.
CALL BL89(D,CST,CSTURB,TURBN,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN)
-!
-!* 3.2 RM17 mixing length
-! ------------------
+ !
+ !* 3.2 RM17 mixing length
+ ! ------------------
CASE ('RM17')
CALL GZ_U_UW_PHY(D,PUT,PDZZ,ZWORK1)
@@ -746,9 +761,9 @@ SELECT CASE (TURBN%CTURBLEN)
+ ZDVDZ(:,:)*ZDVDZ(:,:))
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
CALL BL89(D,CST,CSTURB,TURBN,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN)
-!
-!* 3.3 Grey-zone combined RM17 & Deardorff mixing lengths
-! --------------------------------------------------
+ !
+ !* 3.3 Grey-zone combined RM17 & Deardorff mixing lengths
+ ! --------------------------------------------------
CASE ('HM21')
CALL GZ_U_UW_PHY(D,PUT,PDZZ,ZWORK1)
@@ -775,22 +790,22 @@ SELECT CASE (TURBN%CTURBLEN)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZLM(:,:) = MIN(ZLM(:,:),TURBN%XCADAP*ZLMW(:,:))
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-!
-!* 3.4 Delta mixing length
-! -------------------
-!
+ !
+ !* 3.4 Delta mixing length
+ ! -------------------
+ !
CASE ('DELT')
CALL DELT(ZLM,ODZ=.TRUE.)
-!
-!* 3.5 Deardorff mixing length
-! -----------------------
-!
+ !
+ !* 3.5 Deardorff mixing length
+ ! -----------------------
+ !
CASE ('DEAR')
CALL DEAR(ZLM)
-!
-!* 3.6 Blackadar mixing length
-! -----------------------
-!
+ !
+ !* 3.6 Blackadar mixing length
+ ! -----------------------
+ !
CASE ('BLKR')
ZL0 = 100.
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -806,14 +821,14 @@ SELECT CASE (TURBN%CTURBLEN)
ZLM(:,JK) = ZALPHA * ZLM(:,JK) * ZL0 / ( ZL0 + ZALPHA*ZLM(:,JK) )
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
-!
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZLM(:,IKTB-1) = ZLM(:,IKTB)
ZLM(:,IKTE+1) = ZLM(:,IKTE)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
-!
-!
-!
+ !
+ !
+ !
END SELECT
!
!* 3.5 Mixing length modification for cloud
@@ -889,7 +904,7 @@ IF (TURBN%LROTATE_WIND) THEN
PCOSSLOPE,PSINSLOPE, &
PDXX,PDYY,PDZZ, &
ZUSLOPE,ZVSLOPE )
-!
+ !
CALL UPDATE_ROTATE_WIND(D,ZUSLOPE,ZVSLOPE,HLBCX,HLBCY)
ELSE
ZUSLOPE(:)=PUT(:,IKA)
@@ -937,14 +952,14 @@ ZMTHR(:,:) = 0. ! w'th'r'
!
IF (TURBN%CTOM=='TM06') THEN
CALL TM06(D,CST,PTHVREF,PBL_DEPTH,PZZ,PSFTH,ZMWTH,ZMTH2)
-!
- CALL GZ_M_W_PHY(D,ZMWTH,PDZZ,ZWORK1) ! -d(w'2th' )/dz
- CALL GZ_W_M_PHY(D,ZMTH2,PDZZ,ZWORK2) ! -d(w'th'2 )/dz
- !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZFWTH(:,:) = -ZWORK1(:,:)
- ZFTH2(:,:) = -ZWORK2(:,:)
- !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-!
+ !
+ CALL GZ_M_W_PHY(D,ZMWTH,PDZZ,ZWORK1) ! -d(w'2th' )/dz
+ CALL GZ_W_M_PHY(D,ZMTH2,PDZZ,ZWORK2) ! -d(w'th'2 )/dz
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFWTH(:,:) = -ZWORK1(:,:)
+ ZFTH2(:,:) = -ZWORK2(:,:)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !
ZFWTH(:,IKTE:) = 0.
ZFWTH(:,:IKTB) = 0.
ZFWR(:,:) = 0.
@@ -991,33 +1006,37 @@ IF( BUCONF%LBUDGET_RV ) THEN
END IF
IF( BUCONF%LBUDGET_RC ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'VTURB', PRRS (:,:, 2) )
+IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'VTURB', PRRS (:,:, 3) )
IF( BUCONF%LBUDGET_RI ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'VTURB', PRRS (:,:, 4) )
+IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'VTURB', PRRS (:,:, 5) )
+IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'VTURB', PRRS (:,:, 6) )
+IF( BUCONF%LBUDGET_RH ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'VTURB', PRRS (:,:, 7) )
IF( BUCONF%LBUDGET_SV ) THEN
DO JSV = 1, KSV
- CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', PRSVS(:,:, JSV) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', ZWORKS(:,:, JSV) )
END DO
END IF
CALL TURB_VER(D,CST,CSTURB,TURBN,NEBN,TLES, &
KRR,KRRL,KRRI,KGRADIENTS, &
OOCEAN, ODEEPOC, OCOMPUTE_SRC, &
- KSV,KSV_LGBEG,KSV_LGEND, &
+ ISV,KSV_LGBEG,KSV_LGEND, &
ZEXPL, O2D, ONOMIXLG, OFLAT, &
OCOUPLES,OBLOWSNOW,OFLYER, PRSNOW, &
PTSTEP,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF,PSFU,PSFV, &
- PSFTH,PSFRV,PSFSV,PSFTH,PSFRV,PSFSV, &
+ PSFTH,PSFRV,ZWORKSFSV,PSFTH,PSFRV,ZWORKSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU33M, &
- PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
+ PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,ZWORKT, &
PTKET,ZLM,PLENGTHM,PLENGTHH,ZLEPS,MFMOIST, &
ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,PBL_DEPTH, &
PSBL_DEPTH,ZLMO,PHGRAD,PZS, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDP,PTP,PSIGS,PWTH,PWRC,PWSV, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,ZWORKS, &
+ PDP,PTP,PSIGS,PWTH,PWRC,ZWORKWSV, &
PSSTFL, PSSTFL_C, PSSRFL_C,PSSUFL_C,PSSVFL_C, &
PSSUFL,PSSVFL )
@@ -1027,6 +1046,27 @@ CALL TURB_VER(D,CST,CSTURB,TURBN,NEBN,TLES, &
! IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
! IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
!END IF
+IF (TURBN%LTURB_PRECIP) THEN
+ IF (KRR.GE.3) PRRS(:,:,3)=ZWORKS(:,:,KSV+3)
+ IF (KRR.GE.5) PRRS(:,:,5)=ZWORKS(:,:,KSV+5)
+ IF (KRR.GE.6) PRRS(:,:,6)=ZWORKS(:,:,KSV+6)
+ IF (KRR.GE.7) PRRS(:,:,7)=ZWORKS(:,:,KSV+7)
+END IF
+
+IF (TURBN%LTURB_PRECIP) THEN
+ IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'VTURB', PRRS(:,:, 3) )
+ IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'VTURB', PRRS(:,:, 5) )
+ IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'VTURB', PRRS(:,:, 6) )
+ IF( BUCONF%LBUDGET_RH .AND. KRR ==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'VTURB', PRRS(:,:, 7) )
+ IF (KRR.GE.3) PRRS(:,:,3)=ZWORKS(:,:,KSV+3)
+ IF (KRR.GE.5) PRRS(:,:,5)=ZWORKS(:,:,KSV+5)
+ IF (KRR.GE.6) PRRS(:,:,6)=ZWORKS(:,:,KSV+6)
+ IF (KRR.GE.7) PRRS(:,:,7)=ZWORKS(:,:,KSV+7)
+ IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'VTURB', PRRS(:,:, 3) )
+ IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'VTURB', PRRS(:,:, 5) )
+ IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'VTURB', PRRS(:,:, 6) )
+ IF( BUCONF%LBUDGET_RH .AND. KRR ==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'VTURB', PRRS(:,:, 7) )
+END IF
IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_U), 'VTURB', PRUS(:,:) )
IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_V), 'VTURB', PRVS(:,:) )
@@ -1054,11 +1094,15 @@ IF( BUCONF%LBUDGET_RV ) THEN
END IF
IF( BUCONF%LBUDGET_RC ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'VTURB', PRRS(:,:, 2) )
+IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'VTURB', PRRS(:,:, 3) )
IF( BUCONF%LBUDGET_RI ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'VTURB', PRRS(:,:, 4) )
+IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'VTURB', PRRS(:,:, 5) )
+IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'VTURB', PRRS(:,:, 6) )
+IF( BUCONF%LBUDGET_RH ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'VTURB', PRRS(:,:, 7) )
IF( BUCONF%LBUDGET_SV ) THEN
DO JSV = 1, KSV
- CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', PRSVS(:,:, JSV) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', ZWORKS(:,:, JSV) )
END DO
END IF
!
@@ -1089,15 +1133,19 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
END IF
IF( BUCONF%LBUDGET_RC ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'HTURB', PRRS(:,:, 2) )
+ IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'HTURB', PRRS(:,:, 3) )
IF( BUCONF%LBUDGET_RI ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'HTURB', PRRS(:,:, 4) )
+ IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'HTURB', PRRS(:,:, 5) )
+ IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'HTURB', PRRS(:,:, 6) )
+ IF( BUCONF%LBUDGET_RH ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'HTURB', PRRS(:,:, 7) )
IF( BUCONF%LBUDGET_SV ) THEN
DO JSV = 1, KSV
- CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', PRSVS(:,:, JSV) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', ZWORKS(:,:, JSV) )
END DO
END IF
CALL TURB_HOR_SPLT(D,CST,CSTURB, TURBN, NEBN, TLES, &
- KSPLIT, KRR, KRRL, KRRI, KSV,KSV_LGBEG,KSV_LGEND, &
+ KSPLIT, KRR, KRRL, KRRI, ISV,KSV_LGBEG,KSV_LGEND, &
PTSTEP,HLBCX,HLBCY, OFLAT,O2D, ONOMIXLG, &
OOCEAN,OCOMPUTE_SRC,OBLOWSNOW,PRSNOW, &
TPFILE, KHALO, &
@@ -1105,14 +1153,14 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF, &
- PSFTH,PSFRV,PSFSV, &
+ PSFTH,PSFRV,ZWORKSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU22M,ZTAU33M, &
- PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
+ PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,ZWORKT, &
PTKET,ZLM,ZLEPS, &
ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
PDP,PTP,PSIGS, &
ZTRH, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,ZWORKS )
!
! IF (HCLOUD == 'LIMA') THEN
! IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
@@ -1120,6 +1168,21 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
! IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
! IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
! END IF
+ !
+ IF (TURBN%LTURB_PRECIP) THEN
+ IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'HTURB', PRRS(:,:, 3) )
+ IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'HTURB', PRRS(:,:, 5) )
+ IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'HTURB', PRRS(:,:, 6) )
+ IF( BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'HTURB', PRRS(:,:, 7) )
+ IF (KRR.GE.3) PRRS(:,:,3)=ZWORKS(:,:,KSV+3)
+ IF (KRR.GE.5) PRRS(:,:,5)=ZWORKS(:,:,KSV+5)
+ IF (KRR.GE.6) PRRS(:,:,6)=ZWORKS(:,:,KSV+6)
+ IF (KRR.GE.7) PRRS(:,:,7)=ZWORKS(:,:,KSV+7)
+ IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'HTURB', PRRS(:,:, 3) )
+ IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'HTURB', PRRS(:,:, 5) )
+ IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'HTURB', PRRS(:,:, 6) )
+ IF( BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'HTURB', PRRS(:,:, 7) )
+ END IF
!
IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_U), 'HTURB', PRUS(:,:) )
IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_V), 'HTURB', PRVS(:,:) )
@@ -1147,11 +1210,15 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
END IF
IF( BUCONF%LBUDGET_RC ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'HTURB', PRRS(:,:, 2) )
+ IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'HTURB', PRRS(:,:, 3) )
IF( BUCONF%LBUDGET_RI ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'HTURB', PRRS(:,:, 4) )
+ IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'HTURB', PRRS(:,:, 5) )
+ IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'HTURB', PRRS(:,:, 6) )
+ IF( BUCONF%LBUDGET_RH ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'HTURB', PRRS(:,:, 7) )
IF( BUCONF%LBUDGET_SV ) THEN
DO JSV = 1, KSV
- CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', PRSVS(:,:, JSV) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', ZWORKS(:,:, JSV) )
END DO
END IF
END IF
@@ -1222,9 +1289,9 @@ ENDIF
! ---------------------------------------------------------
!
IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
-!
-! stores the mixing length
-!
+ !
+ ! stores the mixing length
+ !
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'LM', &
CSTDNAME = '', &
@@ -1237,11 +1304,11 @@ IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
NDIMS = 3, &
LTIMEDEP = .TRUE. )
CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZLM)
-!
+ !
IF (KRR /= 0) THEN
-!
-! stores the conservative potential temperature
-!
+ !
+ ! stores the conservative potential temperature
+ !
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'THLM', &
CSTDNAME = '', &
@@ -1254,9 +1321,9 @@ IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
NDIMS = 3, &
LTIMEDEP = .TRUE. )
CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PTHLT)
-!
-! stores the conservative mixing ratio
-!
+ !
+ ! stores the conservative mixing ratio
+ !
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'RNPM', &
CSTDNAME = '', &
@@ -1272,9 +1339,11 @@ IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
END IF
END IF
!
+PRSVS(:,:,:) = ZWORKS(:,:,1:KSV)
+IF (OFLYER) PWSV(:,:,:)=ZWORKWSV(:,:,1:KSV)
!* stores value of conservative variables & wind before turbulence tendency (AROME only)
IF(PRESENT(PDRUS_TURB)) THEN
-!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PDRUS_TURB(:,:) = PRUS(:,:) - PDRUS_TURB(:,:)
PDRVS_TURB(:,:) = PRVS(:,:) - PDRVS_TURB(:,:)
PDRTHLS_TURB(:,:) = PRTHLS(:,:) - PDRTHLS_TURB(:,:)
@@ -1303,7 +1372,7 @@ IF ( KRRL >= 1 ) THEN
* PRRS(:,:,2) &
+ ZLSOCPEXNM(:,:) * PRRS(:,:,4)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-!
+ !
ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PRT(:,:,1) = PRT(:,:,1) - PRT(:,:,2)
@@ -1314,8 +1383,9 @@ IF ( KRRL >= 1 ) THEN
* PRRS(:,:,2)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
-END IF
-
+END IF!
+!
+!
! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
CALL SOURCES_NEG_CORRECT_PHY(D,KSV,HCLOUD,HELEC,'NETUR',KRR,PTSTEP,PPABST,PTHLT,PRT,PRTHLS,PRRS,PRSVS)
!----------------------------------------------------------------------------
@@ -1337,11 +1407,11 @@ IF (TLES%LLES_CALL) THEN
ZWORK2D(:) = (PSFU(:)*PSFU(:)+PSFV(:)*PSFV(:))**0.25
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2D,TLES%X_LES_USTAR)
-!----------------------------------------------------------------------------
-!
-!* 10. LES for 3rd order moments
-! -------------------------
-!
+ !----------------------------------------------------------------------------
+ !
+ !* 10. LES for 3rd order moments
+ ! -------------------------
+ !
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZMWTH,TLES%X_LES_SUBGRID_W2Thl)
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZMTH2,TLES%X_LES_SUBGRID_WThl2)
IF (KRR>0) THEN
@@ -1349,12 +1419,12 @@ IF (TLES%LLES_CALL) THEN
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZMTHR,TLES%X_LES_SUBGRID_WThlRt)
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZMR2,TLES%X_LES_SUBGRID_WRt2)
END IF
-!
-!----------------------------------------------------------------------------
-!
-!* 11. LES quantities depending on <w'2> in "1DIM" mode
-! ------------------------------------------------
-!
+ !
+ !----------------------------------------------------------------------------
+ !
+ !* 11. LES quantities depending on <w'2> in "1DIM" mode
+ ! ------------------------------------------------
+ !
IF (TURBN%CTURBDIM=="1DIM") THEN
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1389,19 +1459,19 @@ IF (TLES%LLES_CALL) THEN
END DO
END IF
-!----------------------------------------------------------------------------
-!
-!* 12. LES mixing end dissipative lengths, presso-correlations
-! -------------------------------------------------------
-!
+ !----------------------------------------------------------------------------
+ !
+ !* 12. LES mixing end dissipative lengths, presso-correlations
+ ! -------------------------------------------------------
+ !
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZLM,TLES%X_LES_SUBGRID_LMix)
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZLEPS,TLES%X_LES_SUBGRID_LDiss)
-!
-!* presso-correlations for subgrid Tke are equal to zero.
-!
+ !
+ !* presso-correlations for subgrid Tke are equal to zero.
+ !
ZLEPS(:,:) = 0. !ZLEPS is used as a work array (not used anymore)
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZLEPS,TLES%X_LES_SUBGRID_WP)
-!
+ !
CALL SECOND_MNH(ZTIME2)
TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -1447,33 +1517,33 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PAMOIST,PATHETA
!
IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO',0,ZHOOK_HANDLE2)
ZEPS = CST%XMV / CST%XMD
-!
-!* 1.1 Lv/Cph at t
-!
+ !
+ !* 1.1 Lv/Cph at t
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PLOCPEXN(:,:) = ( PLTT + (CST%XCPV-PC) * (PT(:,:)-CST%XTT) ) &
/ PCP(:,:)
-!
-!* 1.2 Saturation vapor pressure at t
-!
+ !
+ !* 1.2 Saturation vapor pressure at t
+ !
ZRVSAT(:,:) = EXP( PALP - PBETA/PT(:,:) - PGAM*ALOG( PT(:,:) ) )
-!
-!* 1.3 saturation mixing ratio at t
-!
+ !
+ !* 1.3 saturation mixing ratio at t
+ !
ZRVSAT(:,:) = ZRVSAT(:,:) &
* ZEPS / ( PPABST(:,:) - ZRVSAT(:,:) )
-!
-!* 1.4 compute the saturation mixing ratio derivative (rvs')
-!
+ !
+ !* 1.4 compute the saturation mixing ratio derivative (rvs')
+ !
ZDRVSATDT(:,:) = ( PBETA / PT(:,:) - PGAM ) / PT(:,:) &
* ZRVSAT(:,:) * ( 1. + ZRVSAT(:,:) / ZEPS )
-!
-!* 1.5 compute Amoist
-!
+ !
+ !* 1.5 compute Amoist
+ !
PAMOIST(:,:)= 0.5 / ( 1.0 + ZDRVSATDT(:,:) * PLOCPEXN(:,:) )
-!
-!* 1.6 compute Atheta
-!
+ !
+ !* 1.6 compute Atheta
+ !
PATHETA(:,:)= PAMOIST(:,:) * PEXN(:,:) * &
( ( ZRVSAT(:,:) - PRT(:,:,1) ) * PLOCPEXN(:,:) / &
( 1. + ZDRVSATDT(:,:) * PLOCPEXN(:,:) ) * &
@@ -1485,9 +1555,9 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PAMOIST,PATHETA
) &
- ZDRVSATDT(:,:) &
)
-!
-!* 1.7 Lv/Cph/Exner at t-1
-!
+ !
+ !* 1.7 Lv/Cph/Exner at t-1
+ !
PLOCPEXN(:,:) = PLOCPEXN(:,:) / PEXN(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1515,7 +1585,6 @@ END SUBROUTINE COMPUTE_FUNCTION_THERMO
!
!* 0. DECLARATIONS
! ------------
-USE MODD_CST
!
IMPLICIT NONE
!
@@ -1531,35 +1600,35 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PAMOIST,PATHETA
!
IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO_NEW_STAT',0,ZHOOK_HANDLE2)
ZEPS = CST%XMV / CST%XMD
-!
-!* 1.1 Lv/Cph at t
-!
+ !
+ !* 1.1 Lv/Cph at t
+ !
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PLOCPEXN(:,:) = ( PLTT + (CST%XCPV-PC) * (PT(:,:)-CST%XTT) ) / PCP(:,:)
-!
-!* 1.2 Saturation vapor pressure at t
-!
+ !
+ !* 1.2 Saturation vapor pressure at t
+ !
ZRVSAT(:,:) = EXP( PALP - PBETA/PT(:,:) - PGAM*ALOG( PT(:,:) ) )
-!
-!* 1.3 saturation mixing ratio at t
-!
+ !
+ !* 1.3 saturation mixing ratio at t
+ !
ZRVSAT(:,:) = ZRVSAT(:,:) * ZEPS / ( PPABST(:,:) - ZRVSAT(:,:) )
-!
-!* 1.4 compute the saturation mixing ratio derivative (rvs')
-!
+ !
+ !* 1.4 compute the saturation mixing ratio derivative (rvs')
+ !
ZDRVSATDT(:,:) = ( PBETA / PT(:,:) - PGAM ) / PT(:,:) &
* ZRVSAT(:,:) * ( 1. + ZRVSAT(:,:) / ZEPS )
-!
-!* 1.5 compute Amoist
-!
+ !
+ !* 1.5 compute Amoist
+ !
PAMOIST(:,:)= 1.0 / ( 1.0 + ZDRVSATDT(:,:) * PLOCPEXN(:,:) )
-!
-!* 1.6 compute Atheta
-!
+ !
+ !* 1.6 compute Atheta
+ !
PATHETA(:,:)= PAMOIST(:,:) * PEXN(:,:) * ZDRVSATDT(:,:)
-!
-!* 1.7 Lv/Cph/Exner at t-1
-!
+ !
+ !* 1.7 Lv/Cph/Exner at t-1
+ !
PLOCPEXN(:,:) = PLOCPEXN(:,:) / PEXN(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1937,23 +2006,23 @@ IF (HTURBLEN_CL == TURBN%CTURBLEN) THEN
ZLM_CLOUD(:,:) = ZLM(:,:)
ELSE
SELECT CASE (HTURBLEN_CL)
-!
-!* 3.1 BL89 mixing length
-! ------------------
+ !
+ !* 3.1 BL89 mixing length
+ ! ------------------
CASE ('BL89','RM17','HM21')
ZSHEAR(:,:)=0.
CALL BL89(D,CST,CSTURB,TURBN,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD,OOCEAN)
-!
-!* 3.2 Delta mixing length
-! -------------------
+ !
+ !* 3.2 Delta mixing length
+ ! -------------------
CASE ('DELT')
CALL DELT(ZLM_CLOUD,ODZ=.TRUE.)
-!
-!* 3.3 Deardorff mixing length
-! -----------------------
+ !
+ !* 3.3 Deardorff mixing length
+ ! -----------------------
CASE ('DEAR')
CALL DEAR(ZLM_CLOUD)
-!
+ !
END SELECT
ENDIF
!
diff --git a/src/Rules.LXcray.mk b/src/Rules.LXcray.mk
index b1579f030f00360fb1d80bba93a12b5bbcbc5208..166dbcd9d2701f3f9a845f5220dae693beeb8cfb 100644
--- a/src/Rules.LXcray.mk
+++ b/src/Rules.LXcray.mk
@@ -55,7 +55,7 @@ ifeq "$(OPTLEVEL)" "DEBUG"
OPT = $(OPT_BASE) $(OPT_PERF0) $(OPT_CHECK)
OPT0 = $(OPT_BASE) $(OPT_PERF0) $(OPT_CHECK)
OPT_NOCB = $(OPT_BASE) $(OPT_PERF0)
-CFLAGS += -g -gdwarf-4
+CFLAGS += "-g -gdwarf-4"
endif
#
ifeq "$(OPTLEVEL)" "OPENACC"
@@ -249,9 +249,10 @@ MNH_COMPRESS=yes
MNH_GRIBAPI=no
#
NETCDF_SUPPFLAGS='-emf'
-ECCODES_FFLAGS='-emf -hsystem_alloc'
-ECCODES_CFLAGS=' -gdwarf-4 '
-EC_CONF='-DIEEE_LE=1'
+ECCODES_FFLAGS="-hcpu=x86-64 -emf"
+# -hsystem_alloc
+ECCODES_CFLAGS="-hcpu=x86-64 -gdwarf-4"
+EC_CONF= -DCMAKE_BUILD_TYPE="RELEASE" -DIEEE_LE=1
CDF_CONF= CPP=cpp
HDF_CONF= CPP=cpp
#
diff --git a/src/SURFEX/av_pgd.F90 b/src/SURFEX/av_pgd.F90
index 7d88e48f0b9a1c521e3bc04d466e4ee7b2f58398..e8b7b380720aa4b1508450cf514f8923301398c6 100644
--- a/src/SURFEX/av_pgd.F90
+++ b/src/SURFEX/av_pgd.F90
@@ -1677,6 +1677,7 @@ USE MODE_AV_PGD
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/av_pgd_1p.F90 b/src/SURFEX/av_pgd_1p.F90
index 663f88a82a73ca29d4892cdc6a2edf5a877757e1..d0e662401499866fcb78d57f98aa6d2e9d4f96e7 100644
--- a/src/SURFEX/av_pgd_1p.F90
+++ b/src/SURFEX/av_pgd_1p.F90
@@ -785,6 +785,7 @@ USE MODE_AV_PGD
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/averaged_albedo_teb.F90 b/src/SURFEX/averaged_albedo_teb.F90
index 0b8569df542b003debe1c15b4b80568076d0d70d..8bd0364c0de1c62825e6acd289e776985595685d 100644
--- a/src/SURFEX/averaged_albedo_teb.F90
+++ b/src/SURFEX/averaged_albedo_teb.F90
@@ -62,6 +62,8 @@ USE MODE_SURF_SNOW_FRAC
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+USE MODI_DIAG_MISC_TEB_INIT_n
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
diff --git a/src/SURFEX/avg_urban_fluxes.F90 b/src/SURFEX/avg_urban_fluxes.F90
index dcee5b764dd3a74426d85818e0f8f7f8be831d4a..cffb2cec6bdbf6408f4f5fd353c2b5ac210f5aaf 100644
--- a/src/SURFEX/avg_urban_fluxes.F90
+++ b/src/SURFEX/avg_urban_fluxes.F90
@@ -84,6 +84,8 @@ USE MODD_CSTS,ONLY : XCPD, XLVTT, XLSTT, XSTEFAN, XSURF_EPSILON
USE MODD_ISBA_PAR, ONLY : XEMISVEG
!
USE MODE_THERMOS
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
diff --git a/src/SURFEX/bem.F90 b/src/SURFEX/bem.F90
index cefa2915c9b2b3867047181055a754697fb3f235..5de544ed2fde728532b3e78b25b96c90a5dda4f3 100644
--- a/src/SURFEX/bem.F90
+++ b/src/SURFEX/bem.F90
@@ -174,6 +174,8 @@ USE MODE_CONV_DOE
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/bld_occ_calendar.F90 b/src/SURFEX/bld_occ_calendar.F90
index a24e47b8e5ed337172ed597c88f8fc90414203f8..4a1a96777b3c242f73e1a90583d78402da966980 100644
--- a/src/SURFEX/bld_occ_calendar.F90
+++ b/src/SURFEX/bld_occ_calendar.F90
@@ -28,6 +28,8 @@ USE MODI_DAY_OF_WEEK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/bldsoil_layer_e_budget.F90 b/src/SURFEX/bldsoil_layer_e_budget.F90
index 10f249c54d28593444c6a1a3dec09d556582afae..595330e45834baa5e3e44607542b49ef26c4474a 100644
--- a/src/SURFEX/bldsoil_layer_e_budget.F90
+++ b/src/SURFEX/bldsoil_layer_e_budget.F90
@@ -90,6 +90,8 @@ USE MODI_LAYER_E_BUDGET_GET_COEF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/carbon_dynamic.F90 b/src/SURFEX/carbon_dynamic.F90
index 95d1773afde1b1508cb824c9314c21cd8bbb55c8..dfefff9c2dc0cf88a9a95dcab53127cc2e7c1102 100644
--- a/src/SURFEX/carbon_dynamic.F90
+++ b/src/SURFEX/carbon_dynamic.F90
@@ -51,6 +51,7 @@ USE MODD_CSTS, ONLY : XSIYEA, XTT
USE MODD_SOILCARB_PAR, ONLY : XADVREF
!
USE MODE_HYDRO_DIF
+USE MODI_ABOR1_SFX
!
USE YOMHOOK, ONLY : LHOOK, DR_HOOK
USE PARKIND1, ONLY : JPRB
diff --git a/src/SURFEX/check_teb.F90 b/src/SURFEX/check_teb.F90
index 746bec726fd932c501736c6171ddcec2c7db4701..8d552501e76e07c0ebd7d77369921f7001bc3dce 100644
--- a/src/SURFEX/check_teb.F90
+++ b/src/SURFEX/check_teb.F90
@@ -51,6 +51,7 @@ SUBROUTINE CHECK_TEB (TOP, BOP, NT, NB, TD, TPN, TIR, GDM, GRM, HM, CT, &
USE PARKIND1, ONLY : JPRB
!
USE MODI_ABOR1_SFX
+ USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/compute_isba_parameters.F90 b/src/SURFEX/compute_isba_parameters.F90
index d365e323ece591f11867c99836db4fbf3759aba1..f0218f8eb59eb3ac7ad5db450d85ee19e35a342d 100644
--- a/src/SURFEX/compute_isba_parameters.F90
+++ b/src/SURFEX/compute_isba_parameters.F90
@@ -137,7 +137,7 @@ USE MODI_MAKE_CHOICE_ARRAY
USE MODI_READ_SURF
USE MODI_READ_ISBA_n
USE MODI_READ_ISBA_NUDGING_n
-!USE MODI_INIT_ISBA_LANDUSE
+USE MODI_INIT_ISBA_LANDUSE
USE MODI_READ_SBL_n
USE MODI_INIT_VEG_n
USE MODI_INIT_CHEMICAL_n
diff --git a/src/SURFEX/convert_patch_isba.F90 b/src/SURFEX/convert_patch_isba.F90
index 077479d44e07e0135022afc7e9742430c0472b78..d1484ea336a6d6c09385c3e25551f69919da22ea 100644
--- a/src/SURFEX/convert_patch_isba.F90
+++ b/src/SURFEX/convert_patch_isba.F90
@@ -106,6 +106,7 @@ USE MODI_VEGTYPE_TO_PATCH_IRRIG
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/coupling_seafluxn.F90 b/src/SURFEX/coupling_seafluxn.F90
index 0b2e046e6b641b1d618ebec9fffb350e839e2e89..f7884913a98b6b0938d3bc4a373699a4e0365819 100644
--- a/src/SURFEX/coupling_seafluxn.F90
+++ b/src/SURFEX/coupling_seafluxn.F90
@@ -115,6 +115,7 @@ USE MODI_SEAICE_GELATO1D_n
!
USE MODI_COUPLING_SLT_n
USE MODI_GET_LUOUT
+USE MODI_COUPLING_DMS_n
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/coupling_teb_orographyn.F90 b/src/SURFEX/coupling_teb_orographyn.F90
index 83698fe146933406e3fd36d4e97e104fc751dcc9..6f4d36866fa95074b41e25e3e91a28fe67613cc0 100644
--- a/src/SURFEX/coupling_teb_orographyn.F90
+++ b/src/SURFEX/coupling_teb_orographyn.F90
@@ -61,6 +61,7 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_COUPLING_TEB_n
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/coupling_tebn.F90 b/src/SURFEX/coupling_tebn.F90
index 919d77f05b8421e091596277d4baa46526322648..3626e37642f404c87e3d89aed12dd4ada8bb2a5c 100644
--- a/src/SURFEX/coupling_tebn.F90
+++ b/src/SURFEX/coupling_tebn.F90
@@ -114,6 +114,8 @@ USE MODI_TEB_CANOPY
USE MODI_TRAFFIC_FLUX_MODULATION
USE MODI_UTCI_TEB
USE MODI_UTCIC_STRESS
+USE MODI_BUDGET_HYDRO_n
+USE MODI_GET_LUOUT
!
USE YOMHOOK, ONLY : LHOOK, DR_HOOK
USE PARKIND1, ONLY : JPRB
diff --git a/src/SURFEX/coupling_townn.F90 b/src/SURFEX/coupling_townn.F90
index 70e9de4eb58f29d376baf562926c2bbb4d552806..ff83179ff371824572bdd1c1dde97f2cddbbc474 100644
--- a/src/SURFEX/coupling_townn.F90
+++ b/src/SURFEX/coupling_townn.F90
@@ -54,6 +54,7 @@ USE PARKIND1 ,ONLY : JPRB
USE MODI_COUPLING_IDEAL_FLUX
!
USE MODI_COUPLING_TEB_OROGRAPHY_n
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/floor_layer_e_budget.F90 b/src/SURFEX/floor_layer_e_budget.F90
index bd5fbb4db721e63b1510ea1a16181dd19ee6d34f..31b7907b3f5b803fe2b98148d22ea9f229762571 100644
--- a/src/SURFEX/floor_layer_e_budget.F90
+++ b/src/SURFEX/floor_layer_e_budget.F90
@@ -84,6 +84,8 @@ USE MODE_CONV_DOE
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/hvac_autosize.F90 b/src/SURFEX/hvac_autosize.F90
index 6e73993978a1f2b3695c6bac180d4851a167f332..541f4a4c09fa8dbb0ffb277cee2f1834500e99c0 100644
--- a/src/SURFEX/hvac_autosize.F90
+++ b/src/SURFEX/hvac_autosize.F90
@@ -64,10 +64,12 @@ USE MODI_DIAG_MISC_TEB_INIT_n
USE MODI_ALLOC_LW_COEF
USE MODI_DEALLOC_LW_COEF
USE MODI_EXPLICIT_LONGWAVE
+USE MODI_ABOR1_SFX
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
-!
+USE MODI_ALLOC_CHECK_TEB
+USE MODI_DEALLOC_CHECK_TEB
#ifdef AIX64
!$ USE OMP_LIB
#endif
diff --git a/src/SURFEX/ini_data_param_teb.F90 b/src/SURFEX/ini_data_param_teb.F90
index 6e45707b41b70202d050a61546c5e843c63018ff..4f6d07cc6e3df78e9b784ebb5eff817ea1438117 100644
--- a/src/SURFEX/ini_data_param_teb.F90
+++ b/src/SURFEX/ini_data_param_teb.F90
@@ -61,9 +61,11 @@ USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
USE MODD_CSTS, ONLY : XSURF_EPSILON
!
USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_BLDCODE
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/init_isba_landuse.F90 b/src/SURFEX/init_isba_landuse.F90
index 82816a301995a3598ed4f1efe96a967c9f305ad8..7258563d248b7a7209157d1b29db5e207b2b87ad 100644
--- a/src/SURFEX/init_isba_landuse.F90
+++ b/src/SURFEX/init_isba_landuse.F90
@@ -2,6 +2,79 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
+MODULE MODI_INIT_ISBA_LANDUSE
+
+INTERFACE
+
+!#############################################################
+SUBROUTINE INIT_ISBA_LANDUSE (IG, IO, S, K, NK, NP, NPE, DTI, HPROGRAM, KI)
+!#############################################################
+!
+!!**** *INIT_ISBA_LANDUSE* - routine to initialize land use for ISBA field
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! B. Decharme *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/2011
+!! Completelly reframed 08/2016 R. Séférian
+!! R. Séférian 10/2016 correct error in landuse computation fields
+!! R. Séférian 11/2016 : add cmip6 diagnostics
+!! J. Colin 12/2017 : add computations in case the water or snow is
+!! nudged seperately on each patch
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NK_t, &
+ ISBA_NP_t, ISBA_NPE_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+TYPE(GRID_t), INTENT(INOUT) :: IG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+INTEGER, INTENT(IN) :: KI
+!
+END SUBROUTINE INIT_ISBA_LANDUSE
+
+END INTERFACE
+
+END MODULE MODI_INIT_ISBA_LANDUSE
!#############################################################
SUBROUTINE INIT_ISBA_LANDUSE (IG, IO, S, K, NK, NP, NPE, DTI, HPROGRAM, KI)
!#############################################################
diff --git a/src/SURFEX/init_teb_soil_grid.F90 b/src/SURFEX/init_teb_soil_grid.F90
index f7bb60294797e0960c6d00ff629e8c7e67ecdbb3..e16f8fb86471b7426aaaca39c1e0de6a0432079f 100644
--- a/src/SURFEX/init_teb_soil_grid.F90
+++ b/src/SURFEX/init_teb_soil_grid.F90
@@ -40,6 +40,8 @@ USE MODI_AV_PGD
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/isba_meb.F90 b/src/SURFEX/isba_meb.F90
index f1d0d5dc1bd7456949b157ccd0ad234e1de338a4..e88d190931362961cb1e45f5281ece1ad227e3c7 100644
--- a/src/SURFEX/isba_meb.F90
+++ b/src/SURFEX/isba_meb.F90
@@ -114,6 +114,7 @@ USE MODN_IO_OFFLINE , ONLY : XTSTEP_SURF ! time step of the surface
!
USE MODD_AGRI, ONLY : LIRRIGMODE
!
+USE MODI_ABOR1_SFX
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
diff --git a/src/SURFEX/lt_date.F90 b/src/SURFEX/lt_date.F90
index c2420bae28ec8074465015a673f89cbce45dfeaa..6ed308b67d0bea10b0ff4c685f481e0ca209e5a7 100644
--- a/src/SURFEX/lt_date.F90
+++ b/src/SURFEX/lt_date.F90
@@ -2,6 +2,19 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
+MODULE MODI_LT_DATE
+INTERFACE
+FUNCTION LT_DATE(DATE1, DATE2)
+USE MODD_TYPE_DATE_SURF
+!
+IMPLICIT NONE
+!
+TYPE(DATE_TIME), INTENT(IN) :: DATE1, DATE2
+LOGICAL :: LT_DATE !Boolean flush to true if date1 is lower than date2
+END FUNCTION LT_DATE
+END INTERFACE
+END MODULE MODI_LT_DATE
+!
FUNCTION LT_DATE(DATE1, DATE2)
!!
!!*** *LT_DATE* -
@@ -30,6 +43,8 @@ FUNCTION LT_DATE(DATE1, DATE2)
!! ------------------
!
USE MODD_TYPE_DATE_SURF
+!
+IMPLICIT NONE
!
TYPE(DATE_TIME), INTENT(IN) :: DATE1, DATE2
LOGICAL :: LT_DATE !Boolean flush to true if date1 is lower than date2
diff --git a/src/SURFEX/mass_layer_e_budget.F90 b/src/SURFEX/mass_layer_e_budget.F90
index febb0b57102830cf6d490c5b02ffb3ea92245059..32d1dfcc1e53da43bfb9d9c051bb8c1dbe29e541 100644
--- a/src/SURFEX/mass_layer_e_budget.F90
+++ b/src/SURFEX/mass_layer_e_budget.F90
@@ -79,6 +79,7 @@ USE MODI_GET_LUOUT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/modd_coupling_topd.F90 b/src/SURFEX/modd_coupling_topd.F90
deleted file mode 100644
index aea8813e80efb5523ec2d37a73d55b66b19a45ac..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_coupling_topd.F90
+++ /dev/null
@@ -1,144 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###########################
- MODULE MODD_COUPLING_TOPD
-! ###########################
-!
-!!**** *MODD_COUPLING_TOPD - declaration of exchanged variables from Topodyn to ISBA
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! F. Habets and K. Chancibault
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 29/09/03
-!! 03/2014 (B. Vincendon) new variable to create a mask for N patches
-!! 07/2017 (B. Vincendon) changing name of variable to ditinguish between
-!! packed and full grid variables + new variables
-!! for runoff management
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_TOPD_PAR, ONLY : JPCAT
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-LOGICAL :: LCOUPL_TOPD !if T, performs coupling with Topmodel
-LOGICAL :: LBUDGET_TOPD !if T, computes budget
-LOGICAL :: LTOPD_STEP
-LOGICAL :: LPERT_PARAM
-LOGICAL :: LPERT_INIT
-!
-INTEGER :: NTOPD_STEP
-INTEGER :: NFREQ_MAPS_WG !frequency of output WG maps
-INTEGER :: NFREQ_MAPS_ASAT !frequency of output ASAT maps
-INTEGER :: NFREQ_MAPS_RUNOFF !frequency of output RUNOFF maps
-!
-INTEGER :: NNB_TOPD ! Ratio between Time steps of Topmodel and ISBA
-!
-INTEGER :: NIMAX ! number of ISBA grid points on
- ! abscissa axis
-INTEGER :: NJMAX ! number of ISBA grid points on ordinate
- ! axis
-REAL, ALLOCATABLE, DIMENSION(:) :: XXI ! Extended Lambert II coordinates of Isba
-REAL, ALLOCATABLE, DIMENSION(:) :: XYI ! nodes
-!
-INTEGER, ALLOCATABLE, DIMENSION(:) :: NNPIX ! Number of Topmodel pixels in an ISBA mesh
-INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: NMASKI ! pixel number of each catchment in each isba mesh
-INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NMASKT ! mask
-INTEGER, ALLOCATABLE, DIMENSION(:) :: NMASKT_PATCH ! mask
-!
-REAL, ALLOCATABLE, DIMENSION(:) :: XAS_NATURE ! Packed contributive area fraction on Nature grid
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XAS_IBV_P ! Packed contributive area fraction on Nature grid by catchment
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XAIBV_F ! Unpacked area fraction of each catchment on Full grid
-REAL, ALLOCATABLE, DIMENSION(:) :: XATOP ! Unpacked area fraction of all cacthments on Full grid
-REAL, ALLOCATABLE, DIMENSION(:) :: XATOP_NATURE ! Packed area fraction of all cacthments on Nature grid
-!
-INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NNBV_IN_MESH ! Number of pixel of a partical cathment in an ISBA mesh
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XBV_IN_MESH ! Area of the ISBA meshes covered by a partical cathment
-REAL, ALLOCATABLE, DIMENSION(:) :: XTOTBV_IN_MESH ! Area of the ISBA meshes covered by all cathments
-!
-REAL, ALLOCATABLE, DIMENSION(:) :: XDTOPI ! depth of the soil for lateral
- ! distribution on ISBA grid (m)
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XDTOPT ! depth of the Isba soil on TOP-LAT
- ! grid (m)
-!
-REAL, ALLOCATABLE, DIMENSION(:) :: XWG_FULL ! Water content from Isba on the full domain
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XWGT ! ISBA water content
-!
-REAL, ALLOCATABLE, DIMENSION(:) :: XWSTOPI ! total water content at saturation (m3/m3)
- ! on XDTOPI on ISBA grid
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XWSTOPT ! total water content at saturation (m3/m3)
- ! on XDTOPT on TOP-LAT grid
-REAL, ALLOCATABLE, DIMENSION(:) :: XWFCTOPI ! total field capacity on XDTOPI (m3/m3)
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XWFCTOPT ! total field capacity on XDTOPT (m3/m3)
-REAL, ALLOCATABLE, DIMENSION(:) :: XWWTOPI ! hydraulic conductivity at saturation on
- ! Isba grid, on XDTOPI
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XWWTOPT
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XWTOPT ! water storage on TOP-LAT grid, after
- ! lateral distribution
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XRUNOFF_IBV_P! Runoff by mesh and catchment on isba grid
-REAL, ALLOCATABLE, DIMENSION(:) :: XWOVSATI_P ! Volume of water above saturation buy mesh on isba grid
-!
-! * pour bilans
-REAL, ALLOCATABLE, DIMENSION(:) :: XAVG_RUNOFFCM !cumulated runoff (kg/m2) at t-dt
-REAL, ALLOCATABLE, DIMENSION(:) :: XAVG_DRAINCM ! cumulated drainage calculated from Isba (kg/m2) at t-dt
-REAL, ALLOCATABLE, DIMENSION(:) :: XRAINFALLCM ! cumulated rainfall calculated from Isba (kg/m2) at t-dt
-REAL, ALLOCATABLE, DIMENSION(:) :: XAVG_HORTCM ! cumulated Horton calculated from Isba (kg/m2) at t-dt
-!
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XKA_PRE ! Hydrological indexes at the previous time step
-REAL, ALLOCATABLE, DIMENSION(:) :: XKAC_PRE ! Hydrological index at saturation at the previous time step
-!
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XDMAXFC ! Deficit at the field capacity level
-!
-REAL, ALLOCATABLE, DIMENSION(:) :: XDRAIN_TOP ! Value of drainage on TOPMODEL grid
-!
-REAL, ALLOCATABLE, DIMENSION(:) :: XFRAC_D2 ! fraction of the second layer concerned with lateral transferts
-REAL, ALLOCATABLE, DIMENSION(:) :: XFRAC_D3 ! fraction of the third layer concerned with lateral transferts
-!
-REAL, ALLOCATABLE, DIMENSION(:) :: XWGI_FULL ! soil ice content
-!
-REAL, ALLOCATABLE, DIMENSION(:,:) :: XRUN_TOROUT,XDR_TOROUT
-!
-LOGICAL :: LSTOCK_TOPD ! true to stock runoff and drainage values (for another simulation)
-!
-INTEGER :: NNB_STP_RESTART ! number of time step to restart from a previous simulation
-INTEGER :: NNB_STP_STOCK ! number of time step to write for the next simulation
-!
-INTEGER, DIMENSION(:), ALLOCATABLE :: NYEAR ! Year of the beginning of the simulation.
-INTEGER, DIMENSION(:), ALLOCATABLE :: NMONTH ! Month of the beginning of the simulation.
-INTEGER, DIMENSION(:), ALLOCATABLE :: NDAY ! Date of the beginning of the simulation.
-INTEGER, DIMENSION(:), ALLOCATABLE :: NH ! Hour of the bFginning of the simulation.
-INTEGER, DIMENSION(:), ALLOCATABLE :: NM ! Minutes of the beginning of the simulation.
-!
-! **** For special f, dc exponential profile
-REAL, DIMENSION(:), ALLOCATABLE :: XF_PARAM
-REAL, DIMENSION(:), ALLOCATABLE :: XC_DEPTH_RATIO
-!
-! **** For sub-catchments
-LOGICAL :: LDUMMY_SUBCAT !if T, dummy sub-catchments defined
-LOGICAL :: LSUBCAT !if T, sub-catchments will be computed
-INTEGER, DIMENSION(JPCAT) :: NSUBCAT
-REAL, DIMENSION(JPCAT,JPCAT) :: XLX,XLY
-REAL, DIMENSION(JPCAT,JPCAT) :: XQ2,XQ10,XQ50
-CHARACTER(LEN=15), DIMENSION(JPCAT,JPCAT):: CSUBCAT ! Names of catchments
-CHARACTER(LEN=15), DIMENSION(JPCAT):: CFILE_SUBCAT ! File containing Sub cat information
-LOGICAL :: LWRITE_SEVERITY_MAPS !if T, severity maps will be computed
-!
-END MODULE MODD_COUPLING_TOPD
diff --git a/src/SURFEX/mode_coherence_frac.F90 b/src/SURFEX/mode_coherence_frac.F90
index 9599d81b85f3bcdef5bb29875033d417b6c25955..d68bb4a99a61161133b59aaaa4b5493ca9042d16 100644
--- a/src/SURFEX/mode_coherence_frac.F90
+++ b/src/SURFEX/mode_coherence_frac.F90
@@ -53,6 +53,8 @@ SUBROUTINE COHERENCE_FRAC(HPROGRAM,PFRAC_VALUE, CD_NAME, L_SUM_CHECK)
USE MODD_CSTS ,ONLY : XSURF_EPSILON
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
@@ -147,6 +149,7 @@ USE MODD_DATA_BEM_n, ONLY : DATA_BEM_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/mode_psychro.F90 b/src/SURFEX/mode_psychro.F90
index 1d85dd332a80903f827e2a94005300745b1f08b2..42d795ff1952e15720600f649f8e224ff5f474d3 100644
--- a/src/SURFEX/mode_psychro.F90
+++ b/src/SURFEX/mode_psychro.F90
@@ -262,6 +262,7 @@ function TWB_FROM_TPQ_1D(PT, PP, PQ) RESULT(PTWB)
!
USE MODE_THERMOS
USE MODD_CSTS, ONLY : XTT
+USE MODI_ABOR1_SFX
!
! Robert:
! The original version of this calculation based on an iteration
diff --git a/src/SURFEX/pgd_surf_atm.F90 b/src/SURFEX/pgd_surf_atm.F90
index 2d09c380bc00b13a9397a86e285f7ec05e83ba28..27ad27f3510e88ed29f95aa940ffb65ec2d90da1 100644
--- a/src/SURFEX/pgd_surf_atm.F90
+++ b/src/SURFEX/pgd_surf_atm.F90
@@ -81,6 +81,7 @@ USE MODI_PGD_DMS
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/prep_teb.F90 b/src/SURFEX/prep_teb.F90
index b4057032cba591b18b8d5cea0a9d11b170da45b4..b8a2c1f9c23be91877c133b1dc07632eaf09e923 100644
--- a/src/SURFEX/prep_teb.F90
+++ b/src/SURFEX/prep_teb.F90
@@ -73,6 +73,7 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_CLEAN_PREP_OUTPUT_GRID
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/read_csvdata_archi_teb.F90 b/src/SURFEX/read_csvdata_archi_teb.F90
index 5240a31885d6aefdfa620287e6f61496905381ea..c6d94b9d311afb1bfb4abe1a87e30023fb9de40e 100644
--- a/src/SURFEX/read_csvdata_archi_teb.F90
+++ b/src/SURFEX/read_csvdata_archi_teb.F90
@@ -47,6 +47,7 @@ SUBROUTINE READ_CSVDATA_ARCHI_TEB(BDD, HPROGRAM, HFILE)
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+ USE MODI_BLDCODE
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/read_pgd_teb_parn.F90 b/src/SURFEX/read_pgd_teb_parn.F90
index 0dbf024ec259cc434ff4ae3303ec22363a356541..cf84d552874a632782d99ca42d8fa5ee570b5389 100644
--- a/src/SURFEX/read_pgd_teb_parn.F90
+++ b/src/SURFEX/read_pgd_teb_parn.F90
@@ -1525,6 +1525,8 @@ END SUBROUTINE READ_FIELD
!_______________________________
SUBROUTINE READ_FIELD_2D(HRECFM,PFIELD,YDIR)
!
+USE MODI_HOR_INTERPOL
+!
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: HRECFM ! name of record in the file
diff --git a/src/SURFEX/roof_layer_e_budget.F90 b/src/SURFEX/roof_layer_e_budget.F90
index 4743ec132f8ec92e6ce9537d91f150105120fa80..b338e4698f5ad058189c434f1dc427d8e1241459 100644
--- a/src/SURFEX/roof_layer_e_budget.F90
+++ b/src/SURFEX/roof_layer_e_budget.F90
@@ -108,6 +108,8 @@ USE MODE_CONV_DOE
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/snow_cover_1layer.F90 b/src/SURFEX/snow_cover_1layer.F90
index 7de03b9cc27f8d5a6472cdb1e803b0c6b8eb14ee..afd5d23111ee2f786f833b2695c8dd48953fc064 100644
--- a/src/SURFEX/snow_cover_1layer.F90
+++ b/src/SURFEX/snow_cover_1layer.F90
@@ -74,6 +74,8 @@ USE MODI_SURFACE_AERO_COND
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/solar_panel.F90 b/src/SURFEX/solar_panel.F90
index 5eb503fc4eba78fbc63e125247599ebd0745810e..24d4ab77536b07e9d18da9fada9d396e969a122a 100644
--- a/src/SURFEX/solar_panel.F90
+++ b/src/SURFEX/solar_panel.F90
@@ -50,6 +50,9 @@ USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XSTEFAN
!
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
diff --git a/src/SURFEX/switch_time.F90 b/src/SURFEX/switch_time.F90
index 16f80829a6d2e4b15754d576646b45531dbdaa3d..4ebcdd2269e236f95c325803c6844e7c96a8dfa3 100644
--- a/src/SURFEX/switch_time.F90
+++ b/src/SURFEX/switch_time.F90
@@ -43,6 +43,8 @@ USE MODD_CSTS, ONLY: XDAY
!
USE MODI_ADD_FORECAST_TO_DATE_SURF
USE MODI_SUBSTRACT_TO_DATE_SURF
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/SURFEX/teb_bld_road.F90 b/src/SURFEX/teb_bld_road.F90
index 308cb79cbbe669341b3549a31dc1470e6e1dc16b..85660b400694c8c60e3fa74ba46431b54bd8e3e3 100644
--- a/src/SURFEX/teb_bld_road.F90
+++ b/src/SURFEX/teb_bld_road.F90
@@ -224,6 +224,8 @@ USE MODI_BLDSOIL_LAYER_E_BUDGET
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/town_energy_balance.F90 b/src/SURFEX/town_energy_balance.F90
index 522c5774e21d16a9da984e3ea4daea7e51b9a279..aba42e3f5f5a38781c39d68bd1ab18de07e7b748 100644
--- a/src/SURFEX/town_energy_balance.F90
+++ b/src/SURFEX/town_energy_balance.F90
@@ -129,6 +129,7 @@ USE MODI_ALLOC_LW_COEF
USE MODI_DEALLOC_LW_COEF
USE MODI_TEB_SPARTACUS
USE MODI_EXPLICIT_LONGWAVE
+USE MODI_ABOR1_SFX
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
diff --git a/src/SURFEX/trad_body_isba.F90 b/src/SURFEX/trad_body_isba.F90
index 32a1280351c501b6de4af6f4ccf92080bdf91c73..8aa308432d17677a7670d38bced7e97d4b2659da 100644
--- a/src/SURFEX/trad_body_isba.F90
+++ b/src/SURFEX/trad_body_isba.F90
@@ -61,6 +61,8 @@ FUNCTION TRAD_BODY_ISBA(HPROGRAM, PSCA_SW, PREF_SW, PEMIT_LW, PLW_RAD,&
! ------------
!
USE MODD_CSTS, ONLY : XSTEFAN, XPI, XSURF_EPSILON, XI0
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
diff --git a/src/SURFEX/trad_body_teb.F90 b/src/SURFEX/trad_body_teb.F90
index 30cf78e4317ab9334483c4555ddb2545c19a4853..1157cdc69ea837c2ebe4bf07ee75a92f2e951f3b 100644
--- a/src/SURFEX/trad_body_teb.F90
+++ b/src/SURFEX/trad_body_teb.F90
@@ -91,6 +91,8 @@ FUNCTION TRAD_BODY_TEB(HPROGRAM, PSCA_SW, PREF_SW_FAC, PREF_SW_GRND, &
! ------------
!
USE MODD_CSTS, ONLY : XSTEFAN, XPI, XSURF_EPSILON, XI0
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
diff --git a/src/SURFEX/urban_solar_abs.F90 b/src/SURFEX/urban_solar_abs.F90
index 1f2e48a58820aff041ed64f68ac2a2b6f51a8dad..5169098678455dc59b95cb799a2c9b01015aef5a 100644
--- a/src/SURFEX/urban_solar_abs.F90
+++ b/src/SURFEX/urban_solar_abs.F90
@@ -196,6 +196,7 @@ USE MODI_WINDOW_SHADING
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/utci_teb.F90 b/src/SURFEX/utci_teb.F90
index 137fbb6c2f3f5ccbfdc44ffbd5e63b9bcb650f0f..80b877d9f78868eea6ccfc9c4d7422b2f9d5db03 100644
--- a/src/SURFEX/utci_teb.F90
+++ b/src/SURFEX/utci_teb.F90
@@ -54,6 +54,7 @@ USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
USE MODD_CSTS, ONLY : XTT
USE MODI_UTCI_APPROX
USE MODI_TRAD_BODY_TEB
+USE MODI_ABOR1_SFX
!
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
USE PARKIND1, ONLY : JPRB
diff --git a/src/SURFEX/wall_layer_e_budget.F90 b/src/SURFEX/wall_layer_e_budget.F90
index 8f4801b911a64d3e77512210ba172c73c09e767e..b06cddbe62b5fc167ecc6ed12a5c15c8f50bf9da 100644
--- a/src/SURFEX/wall_layer_e_budget.F90
+++ b/src/SURFEX/wall_layer_e_budget.F90
@@ -117,6 +117,8 @@ USE MODE_CONV_DOE
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/write_diag_pgd_grdnn.F90 b/src/SURFEX/write_diag_pgd_grdnn.F90
index fc1cc0805de4e92047151bdc51db3b425c6002f8..c2d5b6f517abe1b84a61ff9166cc6dc5f9fbdf41 100644
--- a/src/SURFEX/write_diag_pgd_grdnn.F90
+++ b/src/SURFEX/write_diag_pgd_grdnn.F90
@@ -58,6 +58,7 @@ USE MODI_END_IO_SURF_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/write_ecoclimap2_data.F90 b/src/SURFEX/write_ecoclimap2_data.F90
index 4304a43b57b3ef5088838e0b86a011bd9b33c644..7bd221f8e3c57e3822685510f4a840941eb19935 100644
--- a/src/SURFEX/write_ecoclimap2_data.F90
+++ b/src/SURFEX/write_ecoclimap2_data.F90
@@ -18,6 +18,7 @@ USE MODD_SURF_PAR, ONLY: LEN_HREC
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/SURFEX/writesurf_tebn.F90 b/src/SURFEX/writesurf_tebn.F90
index 94a986dd658d741ac3d4f41f3d7d1cba8934ffa2..a519acd7bf111e3080fc569a15420d9fbdb5ae5d 100644
--- a/src/SURFEX/writesurf_tebn.F90
+++ b/src/SURFEX/writesurf_tebn.F90
@@ -63,6 +63,7 @@ USE MODI_WRITESURF_TEB_HYDRO_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
diff --git a/src/configure b/src/configure
index d784dab9326032195e3726f7fb32f2d27f6e8aed..b2f270dabc1b5ce614e498a6e7cbe83ab047a00b 100755
--- a/src/configure
+++ b/src/configure
@@ -8,10 +8,10 @@
if [ "x$XYZ" = "x" ]
then
#
-export VERSION_MASTER=${VERSION_MASTER:-MNH-V5-6}
-export VERSION_BUG=${VERSION_BUG:-2}
+export VERSION_MASTER=${VERSION_MASTER:-MNH-V5-7}
+export VERSION_BUG=${VERSION_BUG:-0}
export VERSION_XYZ=${VERSION_XYZ:-${VERSION_MASTER}-${VERSION_BUG}${VER_OASIS:+-${VER_OASIS}}}
-export VERSION_DATE=${VERSION_DATE:-"28/11/2023"}
+export VERSION_DATE=${VERSION_DATE:-"08/01/2024"}
export VERSION_LIBAEC=${VERSION_LIBAEC:-"1.1.2"}
export VERSION_HDF=${VERSION_HDF:-"1.14.2"}
export VERSION_CDFC=${VERSION_CDFC:-"4.9.2"}
@@ -66,10 +66,10 @@ module purge
#module load craype-x86-trento
module load craype-x86-genoa
module load craype-network-ofi
-module load PrgEnv-cray/8.3.3
-module load cce/15.0.1
-module load craype/2.7.19
-module load cray-mpich/8.1.24
+module load PrgEnv-cray/8.4.0
+module load cce/16.0.0
+module load craype/2.7.21
+module load cray-mpich/8.1.26
module load libfabric/1.15.2.0
#module load craype-accel-amd-gfx90a
module load rocm/5.3.0
@@ -140,8 +140,8 @@ ulimit -s unlimited
export MNHENV=${MNHENV:-"
module purge
module load cmake/3.18.0
-module load intel-compilers/19.1.3
-module load intel-mpi/2019.9
+module load intel-oneapi-compilers/2023.1.0
+module load intel-mpi/2021.9
ulimit -s unlimited
export SLURM_CPU_BIND=none
export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
@@ -220,8 +220,8 @@ export MPI_DSM_CPULIST=0-7:allhosts
export MNHENV=${MNHENV:-"
module purge
module load cmake/3.26.4
-module load inteloneapi/23.1.0
-module load mpi/openmpi/4.1.4
+module load inteloneapi/24.0.0
+module load mpi/openmpi/4.1.5.3
export SLURM_CPU_BIND=none
export DIR_ECCODES_INSTALL=\${CCCWORKDIR}/ECCODES-2.25.0\${XYZM}
@@ -239,8 +239,8 @@ export DIR_ECCODES_INSTALL=\${CCCWORKDIR}/ECCODES-2.25.0\${XYZM}
export MNHENV=${MNHENV:-"
module purge
module load cmake/3.26.4
-module load inteloneapi/23.1.0
-module load mpi/openmpi/4.1.4
+module load inteloneapi/24.0.0
+module load mpi/openmpi/4.1.5.3
export SLURM_CPU_BIND=none
export DIR_ECCODES_INSTALL=\${CCCWORKDIR}/ECCODES-2.25.0\${XYZM}
@@ -484,11 +484,23 @@ export SPLL=spll_new
export VER_MPI=${VER_MPI:-MPIAUTO}
export OPTLEVEL=${OPTLEVEL:-DEBUG}
export MVWORK=${MVWORK:-NO}
- export VER_CDF=${VER_CDF:-CDFCTI}
export NEED_TOOLS=NO
+ # Ubuntu version
+ case "$(lsb_release -sr)" in
+ 20.04)
+ export VER_CDF=${VER_CDF:-CDFCTI}
export MNHENV=${MNHENV:-"
export SPLL=spll_new
"}
+ ;;
+ 22.04)
+ export VER_CDF=${VER_CDF:-CDFAUTO}
+ export MNHENV=${MNHENV:-"
+export PATH=/opt/gcc-9.4.0/bin:\$PATH
+export SPLL=spll_new
+"}
+ ;;
+ esac
;;
'Linux nuwa'*)
export ARCH=${ARCH:-LXifort}
diff --git a/src/job_make_examples_Atos_HPCF b/src/job_make_examples_Atos_HPCF
index ae66d0d1a980e1b334a84cf3cd053dba33941af0..046caeb86188e49b6ba19a49c0d63521325a19ab 100755
--- a/src/job_make_examples_Atos_HPCF
+++ b/src/job_make_examples_Atos_HPCF
@@ -21,7 +21,7 @@ hostname
unset MAKEFLAGS
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-MPIAUTO-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIAUTO-O2
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
export POSTRUN="echo "
diff --git a/src/job_make_examples_BG b/src/job_make_examples_BG
index 049c496096b8c5cb22da726fd5cd04fedcf1dfbd..97ee6e4da9cf694bbfa89fb78cfb7854960a36aa 100755
--- a/src/job_make_examples_BG
+++ b/src/job_make_examples_BG
@@ -20,7 +20,7 @@ cd $LOADL_STEP_INITDIR
unset MAKEFLAGS
-. ../conf/profile_mesonh-BG-R8I4-MNH-V5-6-2-MPIAUTO-O2
+. ../conf/profile_mesonh-BG-R8I4-MNH-V5-7-0-MPIAUTO-O2
#001_2Drelief 002_3Drelief 003_KW78 004_Reunion 007_16janvier
diff --git a/src/job_make_examples_BGQ b/src/job_make_examples_BGQ
index 89fd486027972143994f87b08d0e1b74b09569d4..91d5065a300a0f73016af95dd273835af052be4a 100755
--- a/src/job_make_examples_BGQ
+++ b/src/job_make_examples_BGQ
@@ -20,7 +20,7 @@ cd $LOADL_STEP_INITDIR
unset MAKEFLAGS
-. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-6-2-MPIAUTO-O2NAN
+. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-7-0-MPIAUTO-O2NAN
set -x
diff --git a/src/job_make_examples_BullX b/src/job_make_examples_BullX
index 1296ec63c27f63f1ca7376039c7fe178fda88af2..5ac5e6d3dbdf38fd246fcc66dfa61361cadcf5ee 100755
--- a/src/job_make_examples_BullX
+++ b/src/job_make_examples_BullX
@@ -21,7 +21,7 @@ hostname
unset MAKEFLAGS
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIINTEL-O3
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
export POSTRUN="time "
diff --git a/src/job_make_examples_BullX_belenos b/src/job_make_examples_BullX_belenos
index 2086f3017e168dc4809281a5bb25d9d47e0086eb..e7858d9ded6189fa56e0a806d5ac95f64d86b523 100755
--- a/src/job_make_examples_BullX_belenos
+++ b/src/job_make_examples_BullX_belenos
@@ -20,7 +20,7 @@ hostname
unset MAKEFLAGS
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIAUTO-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIAUTO-O2
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
export POSTRUN="echo "
diff --git a/src/job_make_examples_BullX_irene b/src/job_make_examples_BullX_irene
index 1b93983b9eb0105fa8e1d5ad4ba0c63bb1d50e99..0a6885406ac9b02a03d91e84104a7d154f2cf852 100755
--- a/src/job_make_examples_BullX_irene
+++ b/src/job_make_examples_BullX_irene
@@ -23,7 +23,7 @@ hostname
unset MAKEFLAGS
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-MPIAUTO-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIAUTO-O2
set -x
diff --git a/src/job_make_examples_BullX_irene_AMD b/src/job_make_examples_BullX_irene_AMD
index 8951653c51c93ac4dfefc2fcb12f58c7a2a048b2..14d7d2f4d75f2fbbb0a1fd766c9c86dde9f1a97d 100755
--- a/src/job_make_examples_BullX_irene_AMD
+++ b/src/job_make_examples_BullX_irene_AMD
@@ -22,7 +22,7 @@ hostname
unset MAKEFLAGS
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-AMD-MPIAUTO-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-AMD-MPIAUTO-O2
set -x
diff --git a/src/job_make_examples_BullX_occigen b/src/job_make_examples_BullX_occigen
index ed5c476d24efe1e0a3b6d41d85edcbef6c6168db..81aa099147577d24721e22f892356db7ac8cbd97 100755
--- a/src/job_make_examples_BullX_occigen
+++ b/src/job_make_examples_BullX_occigen
@@ -20,7 +20,7 @@ hostname
unset MAKEFLAGS
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIINTEL-O2
export MONORUN="Mpirun -prepend-rank -np 1 "
export MPIRUN="Mpirun -prepend-rank -np 4 "
export POSTRUN="echo "
diff --git a/src/job_make_examples_BullX_olympe b/src/job_make_examples_BullX_olympe
index 72f1be33044e505b65b27b077857edf3dff85c9d..9f9c3d68f575e44a7fbe43e824031a6c292ec808 100755
--- a/src/job_make_examples_BullX_olympe
+++ b/src/job_make_examples_BullX_olympe
@@ -19,7 +19,7 @@ hostname
unset MAKEFLAGS
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIINTEL-O2
export MONORUN="mpirun -prepend-rank -np 1 "
export MPIRUN="mpirun -prepend-rank -np 4 "
export POSTRUN="echo "
diff --git a/src/job_make_examples_CRAY_cca b/src/job_make_examples_CRAY_cca
index 0a5a77910103986878fce1c47af7db7ab8ad3ad2..54ec9adda38de7e0f332ef626f0f23100e69ef49 100755
--- a/src/job_make_examples_CRAY_cca
+++ b/src/job_make_examples_CRAY_cca
@@ -30,7 +30,7 @@ cd ${PBS_O_WORKDIR}
ARCH=LXifort
#ARCH=LXcray
-. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-6-2-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-7-0-MPICRAY-O2
export MONORUN="aprun -n 1 "
diff --git a/src/job_make_examples_HPE_adastra_genoa b/src/job_make_examples_HPE_adastra_genoa
index 86a9e5dc6b8fb7114008a75b57af7af6077dd141..0dee7e946b34a30bb6f4e3874b4ea285cf1e5472 100755
--- a/src/job_make_examples_HPE_adastra_genoa
+++ b/src/job_make_examples_HPE_adastra_genoa
@@ -1,7 +1,8 @@
#!/bin/bash
#SBATCH -J Examples
-#SBATCH -N 1 # nodes number
-#SBATCH -n 4 # CPUs number (on all nodes)
+#SBATCH --nodes=1
+#SBATCH --ntasks-per-node=4 --cpus-per-task=1
+#SBATCH --threads-per-core=1 # --hint=nomultithread
#SBATCH -C GENOA
##SBATCH --exclusive
#SBATCH -o Examples.eo%j #
@@ -21,7 +22,7 @@ hostname
unset MAKEFLAGS
-. ../conf/profile_mesonh-LXcray-R8I4-MNH-V5-6-2-MPICRAY-O2
+. ../conf/profile_mesonh-LXcray-R8I4-MNH-V5-7-0-MPICRAY-O2
export MONORUN="Exec srun -l -n 1 --export=ALL"
export MPIRUN="Exec srun -l -n 4 --export=ALL"
export POSTRUN="echo "
diff --git a/src/job_make_examples_HPE_jeanzay b/src/job_make_examples_HPE_jeanzay
index 8c37f922dc8e969fa6a3d6b13428ed14abf390a2..54e26e6591126b56cc366bfaf9f582e72b443989 100755
--- a/src/job_make_examples_HPE_jeanzay
+++ b/src/job_make_examples_HPE_jeanzay
@@ -21,7 +21,7 @@ hostname
unset MAKEFLAGS
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIINTEL-O2
export MONORUN="Exec srun -l -n 1 --export=ALL numabind_core_slurm"
export MPIRUN="Exec srun -l -n 4 --export=ALL numabind_core_slurm"
export POSTRUN="echo "
diff --git a/src/job_make_examples_IBM_ada b/src/job_make_examples_IBM_ada
index 5269e3ed36849acc701f1321139fd999df7c22ca..3db69c8a0a1731e82ec7bb78b68bb74200de20c8 100755
--- a/src/job_make_examples_IBM_ada
+++ b/src/job_make_examples_IBM_ada
@@ -21,7 +21,7 @@ cd $LOADL_STEP_INITDIR
unset MAKEFLAGS
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIINTEL-O2
# Pour avoir l'echo des commandes
set -x
diff --git a/src/job_make_examples_IBM_sp6_vargas b/src/job_make_examples_IBM_sp6_vargas
index 98e322800d74b5cb9a762d80b90349a1999ea581..49067f0d75d09d3fefa672dab408d2b6da8e1bc9 100755
--- a/src/job_make_examples_IBM_sp6_vargas
+++ b/src/job_make_examples_IBM_sp6_vargas
@@ -26,7 +26,7 @@ cd $LOADL_STEP_INITDIR
unset MAKEFLAGS
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-2-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-7-0-MPIAUTO-O2
#001_2Drelief 002_3Drelief 003_KW78 004_Reunion 007_16janvier
diff --git a/src/job_make_examples_NEC_SX8 b/src/job_make_examples_NEC_SX8
index 26589cc95aa3a1590a68d1ba558b009abd0e800a..3952e0d7d4cbccdf9b5bd42ca3f9b050e004cfcd 100755
--- a/src/job_make_examples_NEC_SX8
+++ b/src/job_make_examples_NEC_SX8
@@ -20,7 +20,7 @@ unset MAKEFLAGS
[ -d $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
#
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-2-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-7-0-MPIAUTO-O4
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
diff --git a/src/job_make_examples_SGI_datarmor b/src/job_make_examples_SGI_datarmor
new file mode 100755
index 0000000000000000000000000000000000000000..ef27e86bfdc6e9e501fcdb88155b045e8c7de61a
--- /dev/null
+++ b/src/job_make_examples_SGI_datarmor
@@ -0,0 +1,66 @@
+#!/bin/bash
+#MNH_LIC Copyright 1994-2024 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.
+#PBS -S /bin/bash
+#PBS -N Examples
+##PBS -e Examples_errors.txt
+##PBS -o Examples_output.txt
+##PBS -m e
+#PBS -q mpi_1
+#PBS -l walltime=00:30:00
+
+ulimit -c 0
+ulimit -s unlimited
+# Arret du job des la premiere erreur
+set -e
+# Nom de la machine
+hostname
+# Echo des commandes
+
+unset MAKEFLAGS
+
+cd $PBS_O_WORKDIR
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIINTEL-O2
+export MONORUN="Mpirun -np 1 "
+export MPIRUN="Mpirun -np 4 "
+export POSTRUN="time "
+export MNH_PYTHON="NO"
+
+cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/001_2Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/002_3Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+
+cd $SRC_MESONH/MY_RUN/KTEST/004_Reunion
+make -k << EOF
+
+
+EOF
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/007_16janvier
+make -k << EOF
+
+
+EOF
+#
+
diff --git a/src/job_make_examples_SX8 b/src/job_make_examples_SX8
index f001453c6e3ca50d16103991f7b8b3a3f3317558..b7b87f7367c1654146d48db033b0ef421867738b 100755
--- a/src/job_make_examples_SX8
+++ b/src/job_make_examples_SX8
@@ -21,7 +21,7 @@ unset MAKEFLAGS
[ -d $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
#
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-2-MPIAUTO-O2
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-7-0-MPIAUTO-O2
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
diff --git a/src/job_make_examples_cxa b/src/job_make_examples_cxa
index 492c07550bee2022a46a6ce41ba3e8130fb16ceb..28a849508899931561fc251cc57e8b583c73f78d 100755
--- a/src/job_make_examples_cxa
+++ b/src/job_make_examples_cxa
@@ -36,7 +36,7 @@ cd $LOADL_STEP_INITDIR
unset MAKEFLAGS
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-2-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-7-0-MPIAUTO-O2
ulimit -c 0 # pas de core
diff --git a/src/job_make_mesonh_BG b/src/job_make_mesonh_BG
index 0e08b650dc3a7e2aff8572a8e08a1c37f0e25a61..a32ecc21a68ed599c42ef9313bb11763eea10b24 100755
--- a/src/job_make_mesonh_BG
+++ b/src/job_make_mesonh_BG
@@ -18,7 +18,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BG-R8I4-MNH-V5-6-2-MPIAUTO-O2
+. ../conf/profile_mesonh-BG-R8I4-MNH-V5-7-0-MPIAUTO-O2
#time gmake
time gmake -r -j8
diff --git a/src/job_make_mesonh_BGQ b/src/job_make_mesonh_BGQ
index dae7ba1ec9fdce5744c122b23d06f521a5e38a43..c983bbea92085cd871fbc253b9627713adb73663 100755
--- a/src/job_make_mesonh_BGQ
+++ b/src/job_make_mesonh_BGQ
@@ -20,7 +20,7 @@ set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-6-2-MPIAUTO-O2NAN
+. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-7-0-MPIAUTO-O2NAN
time gmake -j8
time gmake -j8
diff --git a/src/job_make_mesonh_BullX b/src/job_make_mesonh_BullX
index 43a95cff8ce714bbd0b629e25bcd905e6ac9e94c..a304b72a566f664cb1923cc621c34b141acce631 100755
--- a/src/job_make_mesonh_BullX
+++ b/src/job_make_mesonh_BullX
@@ -19,7 +19,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
pwd
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIINTEL-O3
time gmake -j 4
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_BullX_belenos b/src/job_make_mesonh_BullX_belenos
index 5f8e7793096f59144740540b03825978c5ed9142..94ce033471423c15b2ec1d8659d70aaf7346ff93 100755
--- a/src/job_make_mesonh_BullX_belenos
+++ b/src/job_make_mesonh_BullX_belenos
@@ -16,7 +16,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
pwd
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIAUTO-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIAUTO-O2
time make -j 16
time make -j 1 installmaster
diff --git a/src/job_make_mesonh_CRAY_cca b/src/job_make_mesonh_CRAY_cca
index e930aaf5ccea3a5c332d9f401f1f04d29a6964f5..207f674e5ae084e1f507e9319961b51f1762dd51 100755
--- a/src/job_make_mesonh_CRAY_cca
+++ b/src/job_make_mesonh_CRAY_cca
@@ -21,7 +21,7 @@ pwd
ARCH=LXifort
#ARCH=LXcray
-. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-6-2-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-7-0-MPICRAY-O2
time gmake -j 4 2>&1 | tee sortie_compile_${ARCH}.$$
time gmake -j 4 2>&1 | tee sortie_compile_${ARCH}2.$$
diff --git a/src/job_make_mesonh_HPE_adastra_genoa b/src/job_make_mesonh_HPE_adastra_genoa
index 3610778312ff94c6ca1a047c5eeeceebe8e84ae4..c61d9e973630b537cd9c85a9b2a99ca54a240ecd 100755
--- a/src/job_make_mesonh_HPE_adastra_genoa
+++ b/src/job_make_mesonh_HPE_adastra_genoa
@@ -15,7 +15,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
pwd
-. ../conf/profile_mesonh-LXcray-R8I4-MNH-V5-6-2-MPICRAY-O2
+. ../conf/profile_mesonh-LXcray-R8I4-MNH-V5-7-0-MPICRAY-O2
time make -j 32
time make -j 1 installmaster
diff --git a/src/job_make_mesonh_HPE_jeanzay b/src/job_make_mesonh_HPE_jeanzay
index 344266251eb510b472ccd2f0ddbdd11d60132bbe..8126b8d490f590f1b5ce9921967e103fea8baf40 100755
--- a/src/job_make_mesonh_HPE_jeanzay
+++ b/src/job_make_mesonh_HPE_jeanzay
@@ -14,7 +14,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
pwd
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIINTEL-O2
time gmake -j 16
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_IBM_ada b/src/job_make_mesonh_IBM_ada
index 928c3d4bdb1d8e5460dc546b35d54fc04fc92d25..3a9fb2ec880e72520cfcb9dbb4a32bc5165c572b 100755
--- a/src/job_make_mesonh_IBM_ada
+++ b/src/job_make_mesonh_IBM_ada
@@ -16,7 +16,7 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIINTEL-O2
# Pour avoir l'echo des commandes
set -x
diff --git a/src/job_make_mesonh_IBM_sp6_vargas b/src/job_make_mesonh_IBM_sp6_vargas
index 9d046b1abcde17a5ed3745142285d6ca6f884370..05070aa8c2d35cd69be29cab32f66d6340de3aba 100755
--- a/src/job_make_mesonh_IBM_sp6_vargas
+++ b/src/job_make_mesonh_IBM_sp6_vargas
@@ -24,7 +24,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-2-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-7-0-MPIAUTO-O2
time gmake -r -j8
time gmake installmaster
diff --git a/src/job_make_mesonh_MFSX8 b/src/job_make_mesonh_MFSX8
index 18af1071971ce0352b4bd5ba03c8847da5bff2be..47b0a5f71d6d28e40cc7e7d710b9156a8ac107bb 100644
--- a/src/job_make_mesonh_MFSX8
+++ b/src/job_make_mesonh_MFSX8
@@ -12,7 +12,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
[ ${PBS_O_WORKDIR} ] && cd ${PBS_O_WORKDIR}
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-2-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-7-0-MPIAUTO-O4
time gmake -j 4 ########## compile on four processors to speedup the compilation
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_NEC_SX8 b/src/job_make_mesonh_NEC_SX8
index ce15a0ee577c401801552b0973c3aa38d305a20f..ed9f289203de7e7573436c947cdf14ac93c9be1f 100755
--- a/src/job_make_mesonh_NEC_SX8
+++ b/src/job_make_mesonh_NEC_SX8
@@ -11,7 +11,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
[ $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-2-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-7-0-MPIAUTO-O4
time gmake -j 4
time gmake -j 4 # some time problem with first pass in parallel compilation
diff --git a/src/job_make_mesonh_cxa b/src/job_make_mesonh_cxa
index f7b78647f7f405a520b766623484477900fa8110..fea9dbbf9476483da297e216b14aef19a00fc4d3 100755
--- a/src/job_make_mesonh_cxa
+++ b/src/job_make_mesonh_cxa
@@ -27,7 +27,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-2-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-7-0-MPIAUTO-O2
time gmake -r -j1
time gmake installmaster
diff --git a/src/job_make_mesonh_dev_pc_ifpen b/src/job_make_mesonh_dev_pc_ifpen
index d735db715dd27d80153515264580b0432e309900..3a3331be8d63ffaf701393056b09e924ef112e8d 100755
--- a/src/job_make_mesonh_dev_pc_ifpen
+++ b/src/job_make_mesonh_dev_pc_ifpen
@@ -9,7 +9,7 @@ pwd
set -x
export ARCH=LXgfortran
-export VERSION_XYZ=MNH-V5-6-1
+export VERSION_XYZ=MNH-V5-7-0
export VER_MPI=MPIAUTO
export OPTLEVEL=DEBUG
diff --git a/src/job_make_mesonh_ener440 b/src/job_make_mesonh_ener440
index 1b2675aecaafe054fdd769bf86ad3681dcb7f9ad..a8153e61664dbc23b8f5e3f739d7ced0cf86a068 100755
--- a/src/job_make_mesonh_ener440
+++ b/src/job_make_mesonh_ener440
@@ -17,7 +17,7 @@
cd ${SLURM_SUBMIT_DIR}
# Chargement du profil (qui contient le source vers l'env ifpen-mesonh)
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIAUTO-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-MPIAUTO-O2
time gmake -j 10
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_pc_ifpen b/src/job_make_mesonh_pc_ifpen
index 559c64dd8550e7fb40e6054635c7ae1cea02d90d..fd5e0cdda78e70eb89e1bc07bb80b4d2cda44e66 100755
--- a/src/job_make_mesonh_pc_ifpen
+++ b/src/job_make_mesonh_pc_ifpen
@@ -8,7 +8,7 @@
pwd
# Chargement du profil (qui contient le source vers l'env ifpen-mesonh)
-. ../conf/profile_mesonh-LXgfortran-R8I4-MNH-V5-6-1-MPIAUTO-O2
+. ../conf/profile_mesonh-LXgfortran-R8I4-MNH-V5-7-0-MPIAUTO-O2
time gmake -j 10
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_user_BullX b/src/job_make_mesonh_user_BullX
index ecd10ec5de217c71184db91a04d400d765cf3aeb..83302771c4d166084b324e569af8d2d82a0ce69c 100755
--- a/src/job_make_mesonh_user_BullX
+++ b/src/job_make_mesonh_user_BullX
@@ -19,7 +19,7 @@ export VER_USER= ########## Your own USER Directory
set -x
# On va lancer la compilation dans le répertoire de lancement du job
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-${VER_USER}-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-${VER_USER}-MPIINTEL-O3
time gmake user
time gmake -j 1 installuser
diff --git a/src/job_make_mesonh_user_BullX_belenos b/src/job_make_mesonh_user_BullX_belenos
index 97961346767835a7d59f67bbf814b2258c8c3adf..7ffdf8f74c26bf08ef0ae75c5c0f607743e60b91 100755
--- a/src/job_make_mesonh_user_BullX_belenos
+++ b/src/job_make_mesonh_user_BullX_belenos
@@ -18,7 +18,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
pwd
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-${VER_USER}-MPIAUTO-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-0-${VER_USER}-MPIAUTO-O2
time make user -j 2
time make -j 1 installuser
diff --git a/src/job_make_mesonh_user_MFSX8 b/src/job_make_mesonh_user_MFSX8
index 256aeb224440d4ac3a4d58f5820d77069a120298..d4f48419ff4c5adc8b20d05f8f8af458b1af014b 100644
--- a/src/job_make_mesonh_user_MFSX8
+++ b/src/job_make_mesonh_user_MFSX8
@@ -14,7 +14,7 @@ set -x
[ ${PBS_O_WORKDIR} ] && cd ${PBS_O_WORKDIR}
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-2-${VER_USER}-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-7-0-${VER_USER}-MPIAUTO-O4
time gmake user
time gmake -j 1 installuser