diff --git a/A-INSTALL b/A-INSTALL
index 115e93430f92c39c7a1cacfff684c8dafb931556..48bfd15055764e8996a04602e2cc8fe36511a96b 100644
--- a/A-INSTALL
+++ b/A-INSTALL
@@ -1,8 +1,8 @@
#
# Version of PACKAGE MESONH "Open distribution"
-# PACK-MNH-V5-3-0
-# DATE : 12/12/2016
-# VERSION : MESONH MASDEV5_3 + BUG-0
+# PACK-MNH-V5-3-1
+# DATE : 25/09/2017
+# VERSION : MESONH MASDEV5_3 + BUG-1
#
# MAP
#
@@ -78,14 +78,14 @@
#
# or directly
#
-# http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-3-0.tar.gz
+# http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-3-1.tar.gz
#
-# Then untar the file "PACK-MNH-V5-3-0.tar.gz" where you want to.
+# Then untar the file "PACK-MNH-V5-3-1.tar.gz" where you want to.
# For example, in your home directory:
#
cd ~
-tar xvfz PACK-MNH-V5-3-0.tar.gz
+tar xvfz PACK-MNH-V5-3-1.tar.gz
#
# Process now to the chapter to configure the MesoNH package.
@@ -165,10 +165,10 @@ git config --global http.sslverify false
# Finally you can clone the Meso-NH Git repository with the following command:
#
-git lfs clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MNH-53-branch MNH-V5-3-0
+git lfs clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MNH-53-branch MNH-V5-3-1
#
-# that will create the MNH-V5-3-0 directory containing a clone (copy) of the
+# that will create the MNH-V5-3-1 directory containing a clone (copy) of the
# Meso-NH package on the remote developpement branch MNH-53-branch
#
#
@@ -178,16 +178,16 @@ git lfs clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MN
# Once the repository is cloned, it's better for you to checkout your own branch
# (by default, you are on HEAD of the MNH-53-branch development branch ).
#
-# To create your local branch corresponding to the V5-3-0 version, type:
+# To create your local branch corresponding to the V5-3-1 version, type:
#
-cd MNH-V5-3-0
-git checkout -b MYB-MNH-V5-3-0 PACK-MNH-V5-3-0
+cd MNH-V5-3-1
+git checkout -b MYB-MNH-V5-3-1 PACK-MNH-V5-3-1
#
-# MYB-MNH-V5-3-0 is the name of the local branch you created
+# MYB-MNH-V5-3-1 is the name of the local branch you created
# and
-# PACK-MNH-V5-3-0 is the remote/origin tag on which it is based.
+# PACK-MNH-V5-3-1 is the remote/origin tag on which it is based.
#
# The advantage of this way of downloading the package is that in the future
# you could check/update quickly differences with the new version of the
@@ -251,7 +251,7 @@ git clone anongit@anongit_mesonh:/gitrepos/MNH-DOC.git
# use the "./configure" script like this
#
-cd ~/MNH-V5-3-0/src
+cd ~/MNH-V5-3-1/src
./configure
. ../conf/profile_mesonh
@@ -296,7 +296,7 @@ export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less
# and then source/load the new generate file
-. ../conf/profile_mesonh.LXifort.MNH-V5-3-0.MPIAUTO.O2
+. ../conf/profile_mesonh.LXifort.MNH-V5-3-1.MPIAUTO.O2
#
# REM:
@@ -321,7 +321,7 @@ export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less
# go to the directory "src"
#
-cd ~/MNH-V5-3-0/src
+cd ~/MNH-V5-3-1/src
#
# if you have not already configured your MESONH environment
@@ -548,7 +548,7 @@ make examples
#
cd $WORKDIR
-cd MNH-V5-3-0/src
+cd MNH-V5-3-1/src
./configure
@@ -609,7 +609,7 @@ export ARCH=LXifort
...
-création du fichier --> ../conf/profile_mesonh-LXifortI4-MNH-V5-3-0-MPICRAY-O2
+création du fichier --> ../conf/profile_mesonh-LXifortI4-MNH-V5-3-1-MPICRAY-O2
# And for the compilation & example job , switch the ARCH variable to LXiort :
@@ -617,7 +617,7 @@ vi job_make_mesonh_CRAY_cca(job_make_examples_CRAY_cca)
ARCH=LXifort
#ARCH=LXcray # this is the default one
-. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-3-0-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-3-1-MPICRAY-O2
@@ -708,7 +708,7 @@ scandollar
## OUTPUT ::
-># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-3-0/conf/post/confdollar_aeropc_default
+># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-3-1/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
@@ -730,7 +730,7 @@ scandollar 0*
## OUTPUT ::
>#
-># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-3-0/conf/post/confdollar_aeropc_default
+># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-3-1/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
@@ -804,22 +804,22 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use this "profile_mesonh" :
-. /home/rech/mnh/rmnh007/DEV/MNH-V5-3-0/conf/profile_mesonh-SX8-MNH-V5-3-0-MPIAUTO-O4
+. /home/rech/mnh/rmnh007/DEV/MNH-V5-3-1/conf/profile_mesonh-SX8-MNH-V5-3-1-MPIAUTO-O4
# And the examples are here ( link to my $WORKDIR in actually )
-/home/rech/mnh/rmnh007/DEV/MNH-V5-3-0/MY_RUN/KTEST/007_16janvier_scandollar
+/home/rech/mnh/rmnh007/DEV/MNH-V5-3-1/MY_RUN/KTEST/007_16janvier_scandollar
#
# On vargas
# ---------
# use this "profile_mesonh" :
-. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-3-0/conf/profile_mesonh-AIX64-MNH-V5-3-0-MPIAUTO-O2
+. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-3-1/conf/profile_mesonh-AIX64-MNH-V5-3-1-MPIAUTO-O2
# and examples here :
-/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-3-0/MY_RUN/KTEST/007_16janvier_scandollar
+/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-3-1/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At CINES on JADE :
@@ -827,11 +827,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
-. /work/escobar/DEV/MNH-V5-3-0/conf/profile_mesonh-LXifort-MNH-V5-3-0-MPIICE-O2
+. /work/escobar/DEV/MNH-V5-3-1/conf/profile_mesonh-LXifort-MNH-V5-3-1-MPIICE-O2
# and the exemples
-/work/escobar/DEV/MNH-V5-3-0/MY_RUN/KTEST/007_16janvier_scandollar
+/work/escobar/DEV/MNH-V5-3-1/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At ECMWF on cxa :
@@ -839,11 +839,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
-. /c1a/ms_perm/au5/MNH-V5-3-0/conf/profile_mesonh-AIX64-MNH-V5-3-0-MPIAUTO-O2
+. /c1a/ms_perm/au5/MNH-V5-3-1/conf/profile_mesonh-AIX64-MNH-V5-3-1-MPIAUTO-O2
# and the examples
-/c1a/ms_perm/au5/MNH-V5-3-0/MY_RUN/KTEST/007_16janvier_scandollar
+/c1a/ms_perm/au5/MNH-V5-3-1/MY_RUN/KTEST/007_16janvier_scandollar
#
diff --git a/MY_RUN/KTEST/003_KW78/002_mesonh/EXSEG1.nam b/MY_RUN/KTEST/003_KW78/002_mesonh/EXSEG1.nam
index 5f08f00ca0b52a094b3dea177984a551dd6672bd..b47524606478c3068dc748a212d79eaf18b0aca4 100644
--- a/MY_RUN/KTEST/003_KW78/002_mesonh/EXSEG1.nam
+++ b/MY_RUN/KTEST/003_KW78/002_mesonh/EXSEG1.nam
@@ -4,7 +4,7 @@
/
&NAM_LUNITn CINIFILE = "KWRAIN" /
&NAM_CONFn LUSERV=T LUSERC=T LUSERR=T /
-&NAM_DYNn XTSTEP =10.,
+&NAM_DYNn XTSTEP =9.,
! CPRESOPT = "ZRESI",
NITR = 4, XRELAX = 1., LITRADJ=F,
LHORELAX_UVWTH = T, LHORELAX_RV = T, LVE_RELAX = F,
diff --git a/MY_RUN/KTEST/003_KW78/002_mesonh/EXSEG1.nam_CEN4TH b/MY_RUN/KTEST/003_KW78/002_mesonh/EXSEG1.nam_CEN4TH
index 6e937b30ea9b3e134137d6353e3acc1981a4bb79..75bc52259a34d50cd6b7257e49a0d97ac99f8e6b 100644
--- a/MY_RUN/KTEST/003_KW78/002_mesonh/EXSEG1.nam_CEN4TH
+++ b/MY_RUN/KTEST/003_KW78/002_mesonh/EXSEG1.nam_CEN4TH
@@ -4,7 +4,7 @@
/
&NAM_LUNITn CINIFILE = "KWRAIN" /
&NAM_CONFn LUSERV=T LUSERC=T LUSERR=T /
-&NAM_DYNn XTSTEP =10.,
+&NAM_DYNn XTSTEP =9.,
! CPRESOPT = "ZRESI",
NITR = 4, XRELAX = 1., LITRADJ=F,
LHORELAX_UVWTH = T, LHORELAX_RV = T, LVE_RELAX = F,
diff --git a/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam1 b/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam1
index 0d4afe94af1debd5cf620d6e3eec0a753694cf1c..910e3354493cb77d56ba6ce24158766906ab936a 100644
--- a/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam1
+++ b/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam1
@@ -12,7 +12,7 @@ LHU_FLX=T,LTRAJ=T,
LVAR_MRSV=T,
LTRAJ=F,
LTPZH=T,
- LBLTOP=T,
+ CBLTOP="RICHA",
LMSLP=T,
LAGEO=T,
LTHW=T,
diff --git a/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam2 b/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam2
index ec8dccd9d6663b938f953b6ca8cbc5766f273d90..a621eff49d2c59ce2aab1fc0a4cd673b42b9e351 100644
--- a/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam2
+++ b/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam2
@@ -12,7 +12,7 @@ LHU_FLX=T,LTRAJ=T,
LVAR_MRSV=F,
LTRAJ=F,
LTPZH=T,
- LBLTOP=T,
+ CBLTOP="RICHA",
LMSLP=T,
LAGEO=T,
LTHW=T,
diff --git a/conf/profile_mesonh.ihm b/conf/profile_mesonh.ihm
index 2042c6e41bb057ac2ba7fa6ca8cacd04b8df0ab6..9f046181bb9bc3798655507d68131ae3da86727c 100755
--- a/conf/profile_mesonh.ihm
+++ b/conf/profile_mesonh.ihm
@@ -98,6 +98,7 @@ export MNH_FOREFIRE=${MNH_FOREFIRE}
# RTTOV
#
export MNH_RTTOV=${MNH_RTTOV}
+export VER_RTTOV=${VER_RTTOV}
#
# OASIS
#
diff --git a/src/ARCH_SRC/CPL_WAVE/MNH/ini_modeln.f90 b/src/ARCH_SRC/CPL_WAVE/MNH/ini_modeln.f90
index 97237ff59a9e42a6937ec6cd347452fa9bc4a38a..50ae95c4cdbbf9356011f7bcd444cbf62ccc2ee3 100644
--- a/src/ARCH_SRC/CPL_WAVE/MNH/ini_modeln.f90
+++ b/src/ARCH_SRC/CPL_WAVE/MNH/ini_modeln.f90
@@ -271,7 +271,11 @@ END MODULE MODI_INI_MODEL_n
!! M.Leriche 2016 Chemistry
!! 10/2016 M.Mazoyer New KHKO output fields
!! 10/2016 (C.Lac) Add max values
-!! F. Brosse Oct. 2016 add prod/loss terms computation for chemistry
+!! F. Brosse Oct. 2016 add prod/loss terms computation for chemistry
+!! M.Leriche 2016 Chemistry
+!! M.Leriche 10/02/17 prevent negative values in LBX(Y)SVS
+!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -332,6 +336,7 @@ USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHAQ, LUSECHIC, LCH_INIT_FIELD, &
USE MODD_CH_PH_n
USE MODD_CH_AEROSOL, ONLY : LORILAM
USE MODD_CH_AERO_n, ONLY : XSOLORG,XMI
+USE MODD_CH_FLX_n, ONLY : XCHFLX
USE MODD_PARAM_KAFR_n
USE MODD_PARAM_MFSHALL_n
USE MODD_DEEP_CONVECTION_n
@@ -454,7 +459,7 @@ CHARACTER(LEN=2) :: YDIR ! Type of the data field in LFIFM file
INTEGER :: IGRID ! C-grid indicator in LFIFM file
INTEGER :: ILENCH ! Length of comment string in LFIFM file
CHARACTER (LEN=100) :: YCOMMENT!comment string in LFIFM file
-CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
+CHARACTER (LEN=LEN_HREC) :: YRECFM ! Name of the desired field in LFIFM file
INTEGER :: IIU ! Upper dimension in x direction (local)
INTEGER :: IJU ! Upper dimension in y direction (local)
INTEGER :: IIU_ll ! Upper dimension in x direction (global)
@@ -708,6 +713,16 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XTEMP2_MEAN(IIU,IJU,IKU)) ; XTEMP2_MEAN = 0.0
ALLOCATE(XPABS2_MEAN(IIU,IJU,IKU)) ; XPABS2_MEAN = 0.0
!
+ ALLOCATE(XUM_MAX(IIU,IJU,IKU)) ; XUM_MAX = -1.E20
+ ALLOCATE(XVM_MAX(IIU,IJU,IKU)) ; XVM_MAX = -1.E20
+ ALLOCATE(XWM_MAX(IIU,IJU,IKU)) ; XWM_MAX = -1.E20
+ ALLOCATE(XTHM_MAX(IIU,IJU,IKU)) ; XTHM_MAX = 0.0
+ ALLOCATE(XTEMPM_MAX(IIU,IJU,IKU)) ; XTEMPM_MAX = 0.0
+ IF (CTURB/='NONE') THEN
+ ALLOCATE(XTKEM_MAX(IIU,IJU,IKU))
+ XTKEM_MAX = 0.0
+ END IF
+ ALLOCATE(XPABSM_MAX(IIU,IJU,IKU)) ; XPABSM_MAX = 0.0
END IF
!
IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
@@ -1386,6 +1401,8 @@ IF (KMI == 1) THEN
ALLOCATE(XGXTHFRC(IKU,NFRC))
ALLOCATE(XGYTHFRC(IKU,NFRC))
ALLOCATE(XPGROUNDFRC(NFRC))
+ ALLOCATE(XTENDUFRC(IKU,NFRC))
+ ALLOCATE(XTENDVFRC(IKU,NFRC))
ELSE
ALLOCATE(TDTFRC(0))
ALLOCATE(XUFRC(0,0))
@@ -1398,6 +1415,8 @@ IF (KMI == 1) THEN
ALLOCATE(XGXTHFRC(0,0))
ALLOCATE(XGYTHFRC(0,0))
ALLOCATE(XPGROUNDFRC(0))
+ ALLOCATE(XTENDUFRC(0,0))
+ ALLOCATE(XTENDVFRC(0,0))
END IF
IF ( LFORCING ) THEN
ALLOCATE(XWTFRC(IIU,IJU,IKU))
@@ -1499,6 +1518,10 @@ IF (LUSECHAQ.AND.(CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN
XACPRAQ(:,:,:) = 0.
ENDIF
ENDIF
+IF ((LUSECHEM).AND.(CPROGRAM == 'DIAG ')) THEN
+ ALLOCATE(XCHFLX(IIU,IJU,NSV_CHEM))
+ XCHFLX(:,:,:) = 0.
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -1604,6 +1627,7 @@ CALL READ_FIELD(HINIFILE,HLUOUT,IMASDEV, IIU,IJU,IKU,XTSTEP, &
NFRC,TDTFRC,XUFRC,XVFRC,XWFRC,XTHFRC,XRVFRC, &
XTENDTHFRC,XTENDRVFRC,XGXTHFRC,XGYTHFRC, &
XPGROUNDFRC, XATC, &
+ XTENDUFRC, XTENDVFRC, &
NADVFRC,TDTADVFRC,XDTHFRC,XDRVFRC, &
NRELFRC,TDTRELFRC,XTHREL,XRVREL, &
XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, &
@@ -1705,6 +1729,59 @@ IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_cpl::XUT",PRECISION)
+!
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_LNOXBEG,NSV_LNOXEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#ifdef MNH_FOREFIRE
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#endif
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+!
END IF
!
IF ( KMI > 1) THEN
@@ -2192,7 +2269,7 @@ END IF
!
!* 30. Total production/Loss for chemical species
!
-IF (LUSECHEM.OR.LCHEMDIAG) THEN
+IF (LCHEMDIAG) THEN
CALL CH_INIT_PRODLOSSTOT_n(ILUOUT)
IF (NEQ_PLT>0) THEN
ALLOCATE(XPROD(IIU,IJU,IKU,NEQ_PLT))
@@ -2212,7 +2289,7 @@ END IF
!
!* 31. Extended production/loss terms for chemical species
!
-IF (LUSECHEM.OR.LCHEMDIAG) THEN
+IF (LCHEMDIAG) THEN
CALL CH_INIT_BUDGET_n(ILUOUT)
IF (NEQ_BUDGET>0) THEN
ALLOCATE(IINDEX(2,NNONZEROTERMS))
diff --git a/src/LIB/MPIvide/mpivide.c b/src/LIB/MPIvide/mpivide.c
index 5372f4afcdc6722574090111ec64f0895014eb4f..24ec98b163b209393fd76ba0f38ad229798c55ca 100644
--- a/src/LIB/MPIvide/mpivide.c
+++ b/src/LIB/MPIvide/mpivide.c
@@ -9,8 +9,13 @@ MNH_LIC for details. version 1.
/* Variables defined in meso-nh code */
#ifdef FUJI
+#if MNH_REALS == 4
+ #define MPI_PRECISION MPI_REAL
+ #define MPI_2PRECISION MPI_2REAL
+#else
#define MPI_PRECISION MPI_DOUBLE_PRECISION
#define MPI_2PRECISION MPI_2DOUBLE_PRECISION
+#endif
#else
#define MPI_PRECISION MPI_REAL
#define MPI_2PRECISION MPI_2REAL
@@ -27,8 +32,13 @@ MNH_LIC for details. version 1.
#define SIZEINTEGER 4
#define SIZELOGICAL 4
#endif
+#if MNH_REALS == 4
+#define SIZEPRECISION 4
+#define SIZE2PRECISION 8
+#else
#define SIZEPRECISION 8
#define SIZE2PRECISION 16
+#endif
#else
#define SIZEINTEGER 8
#define SIZEPRECISION 8
diff --git a/src/LIB/RAD/ECMWF_RAD/sw1s.f90 b/src/LIB/RAD/ECMWF_RAD/sw1s.f90
index 07480c95ba8c4ea0c281e7e0f3562be9889f8a70..77e1e50b58f07133c19d96c660b7b24bab1b390c 100644
--- a/src/LIB/RAD/ECMWF_RAD/sw1s.f90
+++ b/src/LIB/RAD/ECMWF_RAD/sw1s.f90
@@ -84,7 +84,7 @@ INTEGER_M :: KFDIA
INTEGER_M :: KIDIA
INTEGER_M :: KLEV
INTEGER_M :: KLON
-INTEGER_M :: KNU
+INTEGER_M :: KNU ! index of wl
@@ -102,9 +102,9 @@ REAL_B :: PAER(KLON,6,KLEV)&
&, PRMU(KLON) , PSEC(KLON)&
&, PTAU(KLON,NSW,KLEV) , PUD(KLON,5,KLEV+1)
-REAL_B :: PFD(KLON,KLEV+1) , PFU(KLON,KLEV+1)&
- &, PCD(KLON,KLEV+1) , PCU(KLON,KLEV+1)&
- &, PSUDU1(KLON) , PDIFF(KLON,KLEV)&
+REAL_B :: PFD(KLON,KLEV+1) , PFU(KLON,KLEV+1)& ! Fluxes down and up
+ &, PCD(KLON,KLEV+1) , PCU(KLON,KLEV+1)& ! Fluxes clear down and up
+ &, PSUDU1(KLON) , PDIFF(KLON,KLEV)&
&, PDIRF(KLON,KLEV)
!++MODIF_MESONH
@@ -136,6 +136,11 @@ REAL_B :: ZCGAZ(KLON,KLEV)&
&, ZTRA1(KLON,KLEV+1), ZTRA2(KLON,KLEV+1)&
&, ZTRCLD(KLON) , ZTRCLR(KLON)&
&, ZW6(KLON,6) , ZW4(KLON,4), ZO(KLON,2) ,ZT(KLON,2)
+
+REAL_B :: ZTA1(KLON), ZTO1(KLON)
+REAL_B :: ZCLDIR
+
+
! LOCAL INTEGER SCALARS
INTEGER_M :: IKL, IKM1, JAJ, JK, JL
@@ -152,13 +157,18 @@ INTEGER_M :: IKL, IKM1, JAJ, JK, JL
!* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
! -----------------------------------------
+! PRINT *,"PCLEAR ",PCLEAR
+! PAUSE
+! Rayleigh optical depth (Deschamps 1983)
DO JL = KIDIA,KFDIA
ZRAYL(JL) = RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL)&
&* (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL)&
&* (RRAY(KNU,5) + PRMU(JL) * RRAY(KNU,6) ))))
ENDDO
+! PRINT *,"SW1S.F90 ZRAYL ", ZRAYL(1)
+! PRINT *,"YEAH"
! ------------------------------------------------------------------
@@ -178,17 +188,28 @@ ENDDO
&, ODUST , PPIZA_DST,PCGA_DST &
&, PTAUREL_DST )
!--MODIF_MESONH
+! ZRJ0 and ZRK0 are downard and upward fluxes
+
+! PRINT *,"SW1S.F90 ZTAUAZ ",ZTAUAZ(1,1),ZTAUAZ(1,2)
!* 2.2 CLOUDY FRACTION OF THE COLUMN
! -----------------------------
-
+! PTAU is cloud optical depth
+! PAER is aerosol optical depth
+! ZRAYL is rayleigh optical depth
+! NB : cloudy columns are further splitted into cloudy and clear portions
CALL SWR &
&( KIDIA ,KFDIA ,KLON ,KLEV , KNU &
&, PALBD ,PCG ,PCLD ,POMEGA, PSEC , PTAU &
&, ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 , ZREFZ, ZRJ ,ZRK , ZRMUE &
&, ZTAUAZ,ZTRA1 ,ZTRA2 ,ZTRCLD &
&)
+! PRINT *,"SW1S.F90 ZTAUAZ ",ZTAUAZ(1,1)
+! PRINT *,"ZRJ ",ZRJ(1,3,5),ZRK(1,3,5)
+! PRINT *,"ZRMU0 ",ZRMU0(1,1)
+!
+! PRINT*,"ZTRCLD ZTRCLR ",ZTRCLD(:5),ZTRCLR(:5)
! ------------------------------------------------------------------
@@ -251,13 +272,16 @@ IF (NSW <= 4) THEN
PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU)
ENDDO
ENDDO
-
+
+
DO JL=KIDIA,KFDIA
- ZDIFT(JL) = ZR6(JL,1)*ZR6(JL,2)*ZR6(JL,3)*ZTRCLD(JL)
- ZDIRT(JL) = ZR6(JL,4)*ZR6(JL,5)*ZR6(JL,6)*ZTRCLR(JL)
- PSUDU1(JL) = ((_ONE_-PCLEAR(JL)) * ZDIFT(JL)&
+ ZDIFT(JL) = ZR6(JL,1)*ZR6(JL,2)*ZR6(JL,3)*ZTRCLD(JL) ! t for true ?
+ ZDIRT(JL) = ZR6(JL,4)*ZR6(JL,5)*ZR6(JL,6)*ZTRCLR(JL)
+ PSUDU1(JL) = ((_ONE_-PCLEAR(JL)) * ZDIFT(JL)& ! quantity not used by ECMWF_VERSION_2
&+PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU)
ENDDO
+
+
!* 3.1.2 UPWARD FLUXES
@@ -313,7 +337,6 @@ ELSE IF (NSW == 6) THEN
!* 3.2,1 DOWNWARD FLUXES
! ---------------
-
JAJ = 2
DO JL = KIDIA,KFDIA
@@ -324,10 +347,18 @@ ELSE IF (NSW == 6) THEN
ZO(JL,1)=_ZERO_
ZO(JL,2)=_ZERO_
- PFD(JL,KLEV+1)=((_ONE_-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)&
+ PFD(JL,KLEV+1)=((_ONE_-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)& ! TOA flux
&+ PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU)
- PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU)
+ PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU) ! TOA flux CS
+ ENDDO
+
+ ! Quentin
+ DO JL = KIDIA,KFDIA
+ ZTA1(JL)=_ZERO_
+ ZTO1(JL)=_ZERO_
ENDDO
+ ! Quentin
+
DO JK = 1 , KLEV
IKL = KLEV+1-JK
DO JL = KIDIA,KFDIA
@@ -340,31 +371,58 @@ ELSE IF (NSW == 6) THEN
ZO(JL,2)=ZO(JL,2)+POZ(JL, IKL)/ZRMU0(JL,IKL)
ENDDO
+ ! transmission fucntion for all absorbers
CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 4 &
&, IIND4 &
&, ZW4 &
&, ZR4 &
& )
+ ! ZR4 transmission fucntion
CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, 2 &
&, ZO &
&, ZT &
& )
+ ! ZT transmission function
DO JL = KIDIA,KFDIA
- ZDIFF(JL) = ZR4(JL,1)*ZR4(JL,2)*ZT(JL,1)*ZRJ(JL,JAJ,IKL)
- ZDIRF(JL) = ZR4(JL,3)*ZR4(JL,4)*ZT(JL,2)*ZRJ0(JL,JAJ,IKL)
- PDIFF(JL,IKL) = ZDIFF(JL) * RSUN(KNU)*(_ONE_-PCLEAR(JL))
- PDIRF(JL,IKL) = ZDIRF(JL) * RSUN(KNU)*PCLEAR(JL)
- PFD(JL,IKL) = ((_ONE_-PCLEAR(JL)) * ZDIFF(JL)&
+ ZDIFF(JL) = ZR4(JL,1)*ZR4(JL,2)*ZT(JL,1)*ZRJ(JL,JAJ,IKL) ! multiplication of absorber contributions for clouds
+ ZDIRF(JL) = ZR4(JL,3)*ZR4(JL,4)*ZT(JL,2)*ZRJ0(JL,JAJ,IKL) ! flux in clear sky part
+ ! PDIFF(JL,IKL) = ZDIFF(JL) * RSUN(KNU)*(_ONE_-PCLEAR(JL))
+ ! PDIRF(JL,IKL) = ZDIRF(JL) * RSUN(KNU)*PCLEAR(JL)
+ PFD(JL,IKL) = ((_ONE_-PCLEAR(JL)) * ZDIFF(JL)& ! total downward flux
&+PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU)
- PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU)
+ PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU) ! total downward clear-sky
+
+ ! Quentin
+ ZTA1(JL) = ZTA1(JL) + ZTAUAZ(JL,IKL) ! aerosol + rayleigh OD
+ ZTO1(JL) = PTAU(JL,KNU,IKL)*(1.-(POMEGA(JL,KNU,IKL)* & ! cloud OD
+ & PCG(JL,KNU,IKL)*PCG(JL,KNU,IKL))) + ZTO1(JL)
+ ZCLDIR = ZDIRF(JL)/ZRJ0(JL,JAJ,1)*EXP(-ZTA1(JL)/PRMU(JL)) ! remaining direct in clear-sky (otherwise diffuse)
+ PDIRF(JL,IKL) = ((_ONE_-PCLEAR(JL))*ZCLDIR*EXP(-ZTO1(JL)/PRMU(JL))+& ! some direct through cloud
+ & PCLEAR(JL)*ZCLDIR) * RSUN(KNU)
+ PDIRF(JL,IKL) = MIN(PFD(JL,IKL),PDIRF(JL,IKL))
+ PDIFF(JL,IKL) = PFD(JL,IKL) - PDIRF(JL,IKL)
+ ! Quentin
+
+! PRINT *,"IKL",IKL
+! PRINT *,"SW1.f90 PDIFF ",PDIFF(:5,1)
+! PRINT *,"SW1.f90 PDIRF ",PDIRF(:5,1)
ENDDO
+
ENDDO
+! PRINT *,"SW1.f90 PDIFF ",PDIFF(:5,1)
+! PRINT *,"SW1.f90 PDIRF ",PDIRF(:5,1)
+! PRINT *,"SW1.f90 ZDIFF ",ZDIFF(1)
+! PRINT *,"SW1.f90 ZDIRF ",ZDIRF(1)
+! PRINT *,"SW1.f90 RSUN ",RSUN(KNU)
+! PRINT *,"SW1.f90 PCLEAR ",PCLEAR(1)
+! PRINT *,"SW1.f90 SIZE(PDIFF,1) ",SIZE(PDIFF,1),SIZE(PDIFF,2)
+
DO JL=KIDIA,KFDIA
- ZDIFT(JL) = ZR4(JL,1)*ZR4(JL,2)*ZT(JL,1)*ZTRCLD(JL)
+ ZDIFT(JL) = ZR4(JL,1)*ZR4(JL,2)*ZT(JL,1)*ZTRCLD(JL) ! true components with corrected cloudiness
ZDIRT(JL) = ZR4(JL,3)*ZR4(JL,4)*ZT(JL,2)*ZTRCLR(JL)
- PSUDU1(JL) = ((_ONE_-PCLEAR(JL)) * ZDIFT(JL)&
+ PSUDU1(JL) = ((_ONE_-PCLEAR(JL)) * ZDIFT(JL)& ! not used by ECMWF_VERSION_2
&+PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU)
ENDDO
diff --git a/src/LIB/RAD/ECMWF_RAD/swni.f90 b/src/LIB/RAD/ECMWF_RAD/swni.f90
index 7cef307232f3a7f174ef0efe085402103723f8e0..e91319144adb6f9496e5751fa43513eae61d66ab 100644
--- a/src/LIB/RAD/ECMWF_RAD/swni.f90
+++ b/src/LIB/RAD/ECMWF_RAD/swni.f90
@@ -113,6 +113,10 @@ REAL_B :: PFDOWN(KLON,KLEV+1) , PFUP(KLON,KLEV+1)&
&, PCDOWN(KLON,KLEV+1) , PCUP(KLON,KLEV+1)&
&, PSUDU2(KLON) , PDIFF(KLON,KLEV)&
&, PDIRF(KLON,KLEV)
+
+!Quentin
+REAL_B :: ZCLDIR
+REAL_B :: ZTA1(KLON)
!++MODIF_MESONH
LOGICAL :: ODUST ! flag for DUST
@@ -537,6 +541,13 @@ DO JL = KIDIA,KFDIA
PCDOWN(JL,KLEV+1) = ZFD(JL,KLEV+1) * RSUN(KNU)
ENDDO
+! Quentin
+DO JL = KIDIA,KFDIA
+ ZTA1(JL)=_ZERO_
+ ZTO1(JL)=_ZERO_
+ENDDO
+! Quentin
+
DO JK = 1 , KLEV
IKL=KLEV+1-JK
DO JL = KIDIA,KFDIA
@@ -547,15 +558,25 @@ DO JK = 1 , KLEV
ENDDO
CALL SWTT ( KIDIA,KFDIA,KLON, KNU, IABS, ZW1, ZR1 )
-
+
+! Quentin
DO JL = KIDIA,KFDIA
- PDIFF(JL,IKL)=ZR1(JL)*ZR4(JL)*PFDOWN(JL,IKL)*RSUN(KNU)*&
- & (_ONE_-PCLEAR(JL))
- PDIRF(JL,IKL)=ZFD(JL,IKL)*RSUN(KNU)* PCLEAR(JL)
PFDOWN(JL,IKL) = ((_ONE_-PCLEAR(JL))*ZR1(JL)*ZR4(JL)*PFDOWN(JL,&
&IKL)&
&+PCLEAR(JL)*ZFD(JL,IKL)) * RSUN(KNU)
- PCDOWN(JL,IKL) = ZFD(JL,IKL) * RSUN(KNU)
+ PCDOWN(JL,IKL) = ZFD(JL,IKL) * RSUN(KNU)
+ ZTA1(JL)=ZTA1(JL)+ZTAUAZ(JL,IKL)
+ ZTO1(JL) = PTAU(JL,KNU,IKL)*(1.-(POMEGA(JL,KNU,IKL)* &
+ & PCG(JL,KNU,IKL)*PCG(JL,KNU,IKL))) + ZTO1(JL)
+ ZCLDIR = ZFD(JL,IKL)/ZRJ0(JL,JAJ,IKL)*EXP(-ZTA1(JL)/PRMU(JL))
+
+ PDIRF(JL,IKL) = ((_ONE_-PCLEAR(JL))*ZCLDIR*EXP(-ZTO1(JL)/PRMU(JL)) + &
+ & PCLEAR(JL)*ZCLDIR) * RSUN(KNU)
+ PDIRF(JL,IKL) = MIN(PFDOWN(JL,IKL),PDIRF(JL,IKL))
+ PDIFF(JL,IKL) = PFDOWN(JL,IKL) - PDIRF(JL,IKL)
+ ! PDIFF(JL,IKL)=ZR1(JL)*ZR4(JL)*PFDOWN(JL,IKL)*RSUN(KNU)*&
+ ! & (_ONE_-PCLEAR(JL))
+ ! PDIRF(JL,IKL)=ZFD(JL,IKL)*RSUN(KNU)* PCLEAR(JL)
ENDDO
ENDDO
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index 9f237205f5e74ad0471222fa4797c0a472e3358f..f039d2212fa6b025b41defa2213240159afc26c3 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -2589,7 +2589,7 @@ TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'MesoNH: INPRC'
TFIELDLIST(IDX)%CUNITS = 'm s-1'
TFIELDLIST(IDX)%CDIR = 'XY'
-TFIELDLIST(IDX)%CCOMMENT = 'X_Y_INstantaneous Cloud Precipitation Rain Rate'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_INstantaneous Cloud Precipitation Rate'
TFIELDLIST(IDX)%NGRID = 1
TFIELDLIST(IDX)%NTYPE = TYPEREAL
TFIELDLIST(IDX)%NDIMS = 2
@@ -2602,7 +2602,7 @@ TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'MesoNH: ACPRC'
TFIELDLIST(IDX)%CUNITS = 'm'
TFIELDLIST(IDX)%CDIR = 'XY'
-TFIELDLIST(IDX)%CCOMMENT = 'X_Y_ACcumulated Cloud Precipitation Rain Rate'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_ACcumulated Cloud Precipitation Rate'
TFIELDLIST(IDX)%NGRID = 1
TFIELDLIST(IDX)%NTYPE = TYPEREAL
TFIELDLIST(IDX)%NDIMS = 2
diff --git a/src/LIB/SURCOUCHE/src/mode_mppdb.f90 b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
index 27a67e641bf7050e565b1af00337cbf86c938071..a77a88a8379866f3da017e5af7d233f83a841030 100644
--- a/src/LIB/SURCOUCHE/src/mode_mppdb.f90
+++ b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
@@ -229,6 +229,8 @@ CONTAINS
END IF
END IF ! IF (MPPDB_INTER_COMM == MPI_COMM_NULL)
+ CALL MPI_BARRIER ( MPPDB_INTRA_COMM , ierr )
+
#endif
END SUBROUTINE MPPDB_INIT
@@ -832,8 +834,8 @@ CONTAINS
IJU = KYEND-KYOR+1+2*JPHEXT
KSIZE_FULL = (KXEND-KXOR+1)*(KYEND-KYOR+1)
IF ( PRESENT(HTYPE) .AND. KSIZE_FULL /= SIZE(YSURF_CUR%U%XCOVER,1) .AND. NHALO /= JPHEXT ) THEN
- IIU = KXEND-KXOR+1+2*JPHEXT+2*NHALO
- IJU = KYEND-KYOR+1+2*JPHEXT+2*NHALO
+ !IIU = KXEND-KXOR+1+2*JPHEXT+2*NHALO
+ !IJU = KYEND-KYOR+1+2*JPHEXT+2*NHALO
KSIZE_FULL = (KXEND-KXOR+1+2*NHALO) * (KYEND-KYOR+1+2*NHALO)
ENDIF
ENDIF
@@ -858,7 +860,11 @@ CONTAINS
ZFIELD2D = 0.
DO IJ=1+JPHEXT,IJU-JPHEXT
DO II=1+JPHEXT,IIU-JPHEXT
- ZFIELD2D(II,IJ) = PTAB_UNPACKED((IJ-JPHEXT-1)*(KXEND-KXOR+1)+II-JPHEXT)
+ IF(PRESENT(HTYPE)) THEN
+ ZFIELD2D(II,IJ) = PTAB_UNPACKED((IJ-JPHEXT-1+NHALO)*(KXEND-KXOR+1+2*NHALO)+II-JPHEXT+NHALO)
+ ELSE
+ ZFIELD2D(II,IJ) = PTAB_UNPACKED((IJ-JPHEXT-1)*(KXEND-KXOR+1)+II-JPHEXT)
+ END IF
ENDDO
ENDDO
!
@@ -959,7 +965,8 @@ CONTAINS
ZFIELD3D = 0.
DO IJ=1+JPHEXT,IJU-JPHEXT
DO II=1+JPHEXT,IIU-JPHEXT
- ZFIELD3D(II,IJ,:) = PTAB_UNPACKED((IJ-JPHEXT-1)*(KXEND-KXOR+1)+II-JPHEXT,:)
+ !ZFIELD3D(II,IJ,:) = PTAB_UNPACKED((IJ-JPHEXT-1)*(KXEND-KXOR+1)+II-JPHEXT,:)
+ ZFIELD3D(II,IJ,:) = PTAB_UNPACKED((IJ-JPHEXT-1+NHALO)*(KXEND-KXOR+1+2*NHALO)+II-JPHEXT+NHALO,:)
ENDDO
ENDDO
ENDIF
diff --git a/src/MNH/boundaries.f90 b/src/MNH/boundaries.f90
index e40949d5e7a522683d6df30670dd4a28c6a8703d..46fa4bc36998240959a92fdc7de2c4bf6018c38c 100644
--- a/src/MNH/boundaries.f90
+++ b/src/MNH/boundaries.f90
@@ -880,14 +880,14 @@ IF (CCLOUD == 'LIMA' .AND. IMI == 1) THEN
DO JSV=NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 ! LBC for CCN from MACC
IF (GLIMABOUNDARY(JSV-NSV_LIMA_CCN_FREE+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
ENDIF
ENDIF
ENDDO
DO JSV=NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 ! LBC for IFN from MACC
IF (GLIMABOUNDARY(JSV-NSV_LIMA_IFN_FREE+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
ENDIF
ENDIF
ENDDO
@@ -910,7 +910,7 @@ IF (LUSECHEM .AND. IMI == 1) THEN
DO JSV=NSV_CHEMBEG,NSV_CHEMEND
IF (GCHBOUNDARY(JSV-NSV_CHEMBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
ENDIF
ENDIF
ENDDO
@@ -933,7 +933,7 @@ IF (LUSECHIC .AND. IMI == 1) THEN
DO JSV=NSV_CHICBEG,NSV_CHICEND
IF (GICBOUNDARY(JSV-NSV_CHICBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
ENDIF
ENDIF
ENDDO
@@ -955,7 +955,7 @@ IF (LORILAM .AND. IMI == 1) THEN
DO JSV=NSV_AERBEG,NSV_AEREND
IF (GAERBOUNDARY(JSV-NSV_AERBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
ENDIF
ENDIF
ENDDO
@@ -978,7 +978,7 @@ IF (LDUST .AND. IMI == 1) THEN
DO JSV=NSV_DSTBEG,NSV_DSTEND
IF (GDSTBOUNDARY(JSV-NSV_DSTBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
ENDIF
ENDIF
ENDDO
@@ -1001,7 +1001,7 @@ IF (LSALT .AND. IMI == 1) THEN
DO JSV=NSV_SLTBEG,NSV_SLTEND
IF (GSLTBOUNDARY(JSV-NSV_SLTBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
ENDIF
ENDIF
ENDDO
@@ -1024,7 +1024,7 @@ IF ( LPASPOL .AND. IMI == 1) THEN
DO JSV=NSV_PPBEG,NSV_PPEND
IF (GPPBOUNDARY(JSV-NSV_PPBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
ENDIF
ENDIF
ENDDO
@@ -1047,7 +1047,7 @@ IF ( LCONDSAMP .AND. IMI == 1) THEN
DO JSV=NSV_CSBEG,NSV_CSEND
IF (GCSBOUNDARY(JSV-NSV_CSBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
ENDIF
ENDIF
ENDDO
@@ -1071,9 +1071,7 @@ IF ( LFOREFIRE .AND. IMI == 1) THEN
DO JSV=NSV_FFBEG,NSV_FFEND
IF (GFFBOUNDARY(JSV-NSV_FFBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
- ELSE
-!!$ CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVM(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
ENDIF
ENDIF
ENDDO
diff --git a/src/MNH/call_rttov11.f90 b/src/MNH/call_rttov11.f90
index f50ba1f01edadfe27af258e87ba7ae64689f63e8..efaaa3a039b051d937ee3dd787798db1fa0d5a82 100644
--- a/src/MNH/call_rttov11.f90
+++ b/src/MNH/call_rttov11.f90
@@ -80,6 +80,7 @@ SUBROUTINE CALL_RTTOV11(KDLON, KFLEV, PEMIS, PTSRAD, &
!! 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
!!----------------------------------------------------------------------------
!!
!!* 0. DECLARATIONS
@@ -316,6 +317,9 @@ DO JSAT=1,IJSAT ! loop over sensors
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
! -----------------------------------------------------------------------------
@@ -455,7 +459,7 @@ DO JSAT=1,IJSAT ! loop over sensors
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,IKE-1 ! nlayers
+ 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
@@ -572,7 +576,7 @@ DO JSAT=1,IJSAT ! loop over sensors
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
- PRINT *,'YRECFM='//TRIM(TZFIELD%CMNHNAME)
+! PRINT *,'YRECFM='//TRIM(TZFIELD%CMNHNAME)
CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZBT(:,:,JCH))
END DO
DEALLOCATE(chanprof,frequencies,emissivity,calcemis,profiles,cld_profiles)
diff --git a/src/MNH/ch_boundaries.f90 b/src/MNH/ch_boundaries.f90
index 0f34c9577a154d8c645b31782fa2abb49da48d1f..33fdb27af5a9fa3e23dee73a1fce12e6261b4573 100644
--- a/src/MNH/ch_boundaries.f90
+++ b/src/MNH/ch_boundaries.f90
@@ -15,11 +15,12 @@ MODULE MODI_CH_BOUNDARIES
INTERFACE
!
SUBROUTINE CH_BOUNDARIES (HLBCX,HLBCY, &
- PUT,PVT,PSVBT )
+ PUT,PVT,PSVBT,PSVMIN )
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVBT
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT
+REAL :: PSVMIN
!
END SUBROUTINE CH_BOUNDARIES
!
@@ -30,7 +31,7 @@ END MODULE MODI_CH_BOUNDARIES
!
! ####################################################################
SUBROUTINE CH_BOUNDARIES (HLBCX,HLBCY, &
- PUT,PVT,PSVBT )
+ PUT,PVT,PSVBT,PSVMIN )
! ####################################################################
!
!!**** *CH_BOUNDARIES* - routine to prepare the Lateral Boundary Conditions for
@@ -69,6 +70,7 @@ SUBROUTINE CH_BOUNDARIES (HLBCX,HLBCY, &
!! Original 06/06/00
!! 06/06/00 (C. Mari) embedded into mesonh routines
!! 15/02/01 (P. Tulet) update for MOCAGE lateral boundary conditions
+!! 10/02/17 (M. Leriche) prevent negative values
!!
!-------------------------------------------------------------------------------
!
@@ -90,6 +92,7 @@ IMPLICIT NONE
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVBT
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT
+REAL :: PSVMIN
!
!
!
@@ -170,12 +173,12 @@ IF (LWEST_ll( ) .AND. HLBCX(1)=='OPEN') THEN
DO IK= 1,IKU
IF ( PUT(IIB,IJ,IK) <= 0. ) THEN ! OUTFLOW condition
PSVBT(IIB-1,IJ,IK) = &
- 2.*PSVBT (IIB,IJ,IK) -PSVBT (IIB+1,IJ,IK)
+ MAX(PSVMIN,2.*PSVBT (IIB,IJ,IK) -PSVBT (IIB+1,IJ,IK))
ELSE ! INFLOW condition
IF (ZZZW(1,IJ,IK) > -999.) THEN
- PSVBT(IIB-1,IJ,IK) = PSVBT(IIB+1,IJ,IZZW(1,IJ,IK))+&
+ PSVBT(IIB-1,IJ,IK) = MAX(PSVMIN,PSVBT(IIB+1,IJ,IZZW(1,IJ,IK))+&
(PSVBT(IIB+1,IJ,IZZW(1,IJ,IK)+1)-&
- PSVBT(IIB+1,IJ,IZZW(1,IJ,IK))) * ZZZW(1,IJ,IK)
+ PSVBT(IIB+1,IJ,IZZW(1,IJ,IK))) * ZZZW(1,IJ,IK))
!
ELSE
PSVBT(IIB-1,IJ,IK) = PSVBT(IIB+1,IJ,IK)
@@ -218,13 +221,13 @@ IF (LEAST_ll( ) .AND. HLBCX(1)=='OPEN') THEN
DO IK=1,IKU
IF ( PUT(IIE+1,IJ,IK) >= 0. ) THEN ! OUTFLOW condition
PSVBT(IIE+1,IJ,IK) = &
- 2.*PSVBT (IIE,IJ,IK) -PSVBT (IIE-1,IJ,IK)
+ MAX(PSVMIN,2.*PSVBT (IIE,IJ,IK) -PSVBT (IIE-1,IJ,IK))
ELSE ! INFLOW condition
IF (ZZZE(1,IJ,IK) > -999.) THEN
PSVBT(IIE+1,IJ,IK) = &
- PSVBT(IIE-1,IJ,IZZE(1,IJ,IK))+&
+ MAX(PSVMIN,PSVBT(IIE-1,IJ,IZZE(1,IJ,IK))+&
(PSVBT(IIE-1,IJ,IZZE(1,IJ,IK)+1)-&
- PSVBT(IIE-1,IJ,IZZE(1,IJ,IK))) * ZZZE(1,IJ,IK)
+ PSVBT(IIE-1,IJ,IZZE(1,IJ,IK))) * ZZZE(1,IJ,IK))
!
ELSE
PSVBT(IIE+1,IJ,IK) = PSVBT(IIE-1,IJ,IK)
@@ -268,13 +271,13 @@ IF (LSOUTH_ll( ) .AND. HLBCY(1)=='OPEN') THEN
DO IK=1,IKU
IF ( PVT(II,IJB,IK) <= 0. ) THEN ! OUTFLOW condition
PSVBT(II,IJB-1,IK) = &
- 2.*PSVBT (II,IJB,IK) -PSVBT (II,IJB+1,IK)
+ MAX(PSVMIN,2.*PSVBT (II,IJB,IK) -PSVBT (II,IJB+1,IK))
ELSE ! INFLOW condition
IF (ZZZS(II,1,IK) > -999.) THEN
PSVBT(II,IJB-1,IK) = &
- PSVBT(II,IJB+1,IZZS(II,1,IK))+&
+ MAX(PSVMIN,PSVBT(II,IJB+1,IZZS(II,1,IK))+&
(PSVBT(II,IJB+1,IZZS(II,1,IK)+1)-&
- PSVBT(II,IJB+1,IZZS(II,1,IK))) * ZZZS(II,1,IK)
+ PSVBT(II,IJB+1,IZZS(II,1,IK))) * ZZZS(II,1,IK))
!
ELSE
PSVBT(II,IJB-1,IK) = PSVBT(II,IJB+1,IK)
@@ -319,13 +322,13 @@ IF (LNORTH_ll( ) .AND. HLBCY(2)=='OPEN') THEN
DO IK=1,IKU
IF ( PVT(II,IJE+1,IK) >= 0. ) THEN ! OUTFLOW condition
PSVBT(II,IJE+1,IK) = &
- 2.*PSVBT (II,IJE,IK) -PSVBT (II,IJE-1,IK)
+ MAX(PSVMIN,2.*PSVBT (II,IJE,IK) -PSVBT (II,IJE-1,IK))
ELSE ! INFLOW condition
IF (ZZZN(II,1,IK) > -999.) THEN
PSVBT(II,IJE+1,IK) = &
- PSVBT(II,IJE-1,IZZN(II,1,IK))+&
+ MAX(PSVMIN,PSVBT(II,IJE-1,IZZN(II,1,IK))+&
(PSVBT(II,IJE-1,IZZN(II,1,IK)+1)-&
- PSVBT(II,IJE-1,IZZN(II,1,IK))) * ZZZN(II,1,IK)
+ PSVBT(II,IJE-1,IZZN(II,1,IK))) * ZZZN(II,1,IK))
!
ELSE
PSVBT(II,IJE+1,IK) = PSVBT(II,IJE-1,IK)
diff --git a/src/MNH/ch_convect_scavenging.f90 b/src/MNH/ch_convect_scavenging.f90
index 7cc44c218a9c167988b33e5511177b801ce0bb16..a0bfccfd63a1dac9b3f8404c9819fd294e5d777c 100644
--- a/src/MNH/ch_convect_scavenging.f90
+++ b/src/MNH/ch_convect_scavenging.f90
@@ -103,8 +103,9 @@ END MODULE MODI_CH_CONVECT_SCAVENGING
!! MODIFICATIONS
!! -------------
!!
-!! Original 10/04/00
-!! P. Tulet 25/04/05 Aerosols/ Dust scavenging
+!! Original 10/04/2000
+!! P. Tulet 25/04/2005 Aerosols/ Dust scavenging
+!! J. Pianezze 23/06/2017 Add effic_salt
!!
!!
!-------------------------------------------------------------------------------
@@ -132,6 +133,7 @@ USE MODE_SALT_PSD
USE MODE_AERO_PSD
USE MODE_MODELN_HANDLER
USE MODI_EFFIC_DUST
+USE MODI_EFFIC_SALT
USE MODI_EFFIC_AERO
!
IMPLICIT NONE
@@ -211,6 +213,7 @@ REAL, DIMENSION(KLON,KLEV) :: ZPARTAERO
REAL :: ZHP
REAL, DIMENSION(KLON,1,KLEV,JPMODE) :: ZRGAER,ZSIGAER, ZNAER, ZBCMIN
REAL, DIMENSION(KLON,1,KLEV,NMODE_DST) :: ZEFFIC_DST
+REAL, DIMENSION(KLON,1,KLEV,NMODE_SLT) :: ZEFFIC_SLT
REAL, DIMENSION(KLON,1,KLEV,JPMODE) :: ZEFFIC_AER
REAL, DIMENSION(KLON,1,KLEV,NMODE_DST) :: ZRGDST,ZSIGDST,ZNDST, ZMINMASS_DST,ZRGDSTMIN
REAL, DIMENSION(KLON,1,KLEV,NMODE_SLT) :: ZRGSLT,ZSIGSLT,ZNSLT, ZMINMASS_SLT,ZRGSLTMIN
@@ -480,17 +483,17 @@ IF (LSALT) THEN
ZPABST(:,1,:) = PPABST(:,:)
ZURR(:,1,:) = PURR(:,:)
ZCH1(:,1,:,:) = PCH1(:,:,:)
- ZEFFIC_DST(:,:,:,:) = 0.
- CALL EFFIC_DUST(ZTHT,ZRHODREF,ZPABST,&
- ZURR,ZCH1(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZEFFIC_DST)
- ZEFFIC_DST(:,:,:,:) = MAX(MIN(ZEFFIC_DST(:,:,:,:), 1.),0.)
+ ZEFFIC_SLT(:,:,:,:) = 0.
+ CALL EFFIC_SALT(ZTHT,ZRHODREF,ZPABST,&
+ ZURR,ZCH1(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZEFFIC_SLT)
+ ZEFFIC_SLT(:,:,:,:) = MAX(MIN(ZEFFIC_SLT(:,:,:,:), 1.),0.)
DO JN=1,NMODE_SLT
IF (LVARSIG_SLT) THEN
- ZPARTSCAV(:,:,NSV_SLTBEG-1+2+(JN-1)*3) = (ZPROR(:,:) * ZEFFIC_DST(:,1,:,JN))
+ ZPARTSCAV(:,:,NSV_SLTBEG-1+2+(JN-1)*3) = (ZPROR(:,:) * ZEFFIC_SLT(:,1,:,JN))
ELSE IF (LRGFIX_SLT) THEN
- ZPARTSCAV(:,:,NSV_SLTBEG+JN-1) = (ZPROR(:,:) * ZEFFIC_DST(:,1,:,JN))
+ ZPARTSCAV(:,:,NSV_SLTBEG+JN-1) = (ZPROR(:,:) * ZEFFIC_SLT(:,1,:,JN))
ELSE
- ZPARTSCAV(:,:,NSV_SLTBEG-1+2+(JN-1)*2) = (ZPROR(:,:) * ZEFFIC_DST(:,1,:,JN))
+ ZPARTSCAV(:,:,NSV_SLTBEG-1+2+(JN-1)*2) = (ZPROR(:,:) * ZEFFIC_SLT(:,1,:,JN))
END IF
ENDDO
END IF
diff --git a/src/MNH/ch_monitorn.f90 b/src/MNH/ch_monitorn.f90
index b8674ccf1675eab61c823574475f51aaab193b80..fc4230457c505b68b4e899655257fe36d1c1b753 100644
--- a/src/MNH/ch_monitorn.f90
+++ b/src/MNH/ch_monitorn.f90
@@ -111,6 +111,7 @@ END MODULE MODI_CH_MONITOR_n
!! 18/01/16 (M Leriche) for sedimentation fusion C2R2 and khko
!! 15/02/16 (M Leriche) call ch_init_rosenbrock only one time
!! 20/01/17 (G.Delautier) bug if CPROGRAM/=DIAG
+!! 01/10/17 (C.Lac) add correction of negativity
!!
!! EXTERNAL
!! --------
@@ -155,7 +156,8 @@ USE MODD_NSV, ONLY : NSV_CHEMBEG,NSV_CHEMEND,NSV_CHEM,& ! index for chemical SV
NSV_CHGSBEG,NSV_CHGSEND, & ! index for gas phase SV
NSV_CHICBEG,NSV_CHICEND, & ! index for ice phase SV
NSV_C2R2BEG, & ! index for number concentration
- NSV_AERBEG, NSV_AEREND, NSV_AER ! index for aerosols SV
+ NSV_AERBEG, NSV_AEREND, NSV_AER, & ! index for aerosols SV
+ XSVMIN
!
USE MODD_CH_M9_n, ONLY: NEQ, &! number of prognostic chem. species
NEQAQ, &! number of aqueous chem. species
@@ -409,6 +411,12 @@ IKU = SIZE(XRSVS,3)
IKB = 1 + JPVEXT
IKE = IKU - JPVEXT
!
+! Correction of negativity
+!
+DO JSV = 1, SIZE(XSVT,4)
+ XRSVS(:,:,:,JSV) = MAX((XRSVS(:,:,:,JSV)),XSVMIN(JSV))
+END DO
+!
!
IF (KTCOUNT == 1) THEN
!
@@ -1257,6 +1265,11 @@ IF (CCLOUD /= 'REVE' ) THEN
END IF
END IF
+! Correction of negativity
+!
+DO JSV = 1, SIZE(XSVT,4)
+ XRSVS(:,:,:,JSV) = MAX((XRSVS(:,:,:,JSV)),XSVMIN(JSV))
+END DO
!
IF (LBUDGET_SV) THEN
DO JSV=NSV_CHEMBEG,NSV_CHEMEND
diff --git a/src/MNH/compute_bl89_ml.f90 b/src/MNH/compute_bl89_ml.f90
index 4baf16acd0fc5aa92e371ddcb1672149252923d3..4c5124602b87fefe4ceddf7175abe469eeef5647 100644
--- a/src/MNH/compute_bl89_ml.f90
+++ b/src/MNH/compute_bl89_ml.f90
@@ -10,7 +10,7 @@ INTERFACE
! ###################################################################
SUBROUTINE COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ2D, &
- PTKEM2D,PG_O_THVREF2D,PVPT,KK,OUPORDN,PLWORK)
+ PTKEM_DEP,PG_O_THVREF,PVPT,KK,OUPORDN,OFLUX,PLWORK)
! ###################################################################
!* 1.1 Declaration of Arguments
@@ -20,25 +20,25 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde
INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ2D
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM2D
-REAL, DIMENSION(:,:), INTENT(IN) :: PG_O_THVREF2D
-REAL, DIMENSION(:,:), INTENT(IN) :: PVPT
-INTEGER, INTENT(IN) :: KK
-LOGICAL, INTENT(IN) :: OUPORDN
-REAL, DIMENSION(:), INTENT(OUT) :: PLWORK
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ2D ! height difference between two mass levels
+REAL, DIMENSION(:), INTENT(IN) :: PTKEM_DEP ! TKE to consume
+REAL, DIMENSION(:), INTENT(IN) :: PG_O_THVREF ! g/ThetaVRef at the departure point
+REAL, DIMENSION(:,:), INTENT(IN) :: PVPT ! ThetaV on mass levels
+INTEGER, INTENT(IN) :: KK ! index of departure level
+LOGICAL, INTENT(IN) :: OUPORDN ! switch to compute upward (true) or
+ ! downward (false) mixing length
+LOGICAL, INTENT(IN) :: OFLUX ! Computation must be done from flux level
+REAL, DIMENSION(:), INTENT(OUT) :: PLWORK ! Resulting mixing length
END SUBROUTINE COMPUTE_BL89_ML
END INTERFACE
!
END MODULE MODI_COMPUTE_BL89_ML
-
-
-
-! ###################################################################
+! ######spl
SUBROUTINE COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ2D, &
- PTKEM2D,PG_O_THVREF2D,PVPT,KK,OUPORDN,PLWORK)
+ PTKEM_DEP,PG_O_THVREF,PVPT,KK,OUPORDN,OFLUX,PLWORK)
+
! ###################################################################
!!
!! COMPUTE_BL89_ML routine to:
@@ -52,6 +52,7 @@ END MODULE MODI_COMPUTE_BL89_ML
!! -------------
!! Original 19/01/06
!! S. Riette Jan 2012: support for both order of vertical levels and cleaning
+!! R.Honnert Oct 2016 : Update with AROME
!!
!-------------------------------------------------------------------------------
!
@@ -82,35 +83,36 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde
INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ2D
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM2D
-REAL, DIMENSION(:,:), INTENT(IN) :: PG_O_THVREF2D
-REAL, DIMENSION(:,:), INTENT(IN) :: PVPT
-INTEGER, INTENT(IN) :: KK
-LOGICAL, INTENT(IN) :: OUPORDN
-REAL, DIMENSION(:), INTENT(OUT) :: PLWORK
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ2D ! height difference between two mass levels
+REAL, DIMENSION(:), INTENT(IN) :: PTKEM_DEP ! TKE to consume
+REAL, DIMENSION(:), INTENT(IN) :: PG_O_THVREF ! g/ThetaVRef at the departure point
+REAL, DIMENSION(:,:), INTENT(IN) :: PVPT ! ThetaV on mass levels
+INTEGER, INTENT(IN) :: KK ! index of departure level
+LOGICAL, INTENT(IN) :: OUPORDN ! switch to compute upward (true) or
+ ! downward (false) mixing length
+LOGICAL, INTENT(IN) :: OFLUX ! Computation must be done from flux level
+REAL, DIMENSION(:), INTENT(OUT) :: PLWORK ! Resulting mixing length
! 0.2 Local variable
!
-REAL, DIMENSION(SIZE(PTKEM2D,1)) :: ZLWORK1,ZLWORK2 ! Temporary mixing length
-REAL, DIMENSION(SIZE(PTKEM2D,1)) :: ZINTE,ZPOTE ! TKE and potential energy
- ! between 2 levels
+REAL, DIMENSION(SIZE(PVPT,1)) :: ZLWORK1,ZLWORK2 ! Temporary mixing length
+REAL, DIMENSION(SIZE(PVPT,1)) :: ZINTE,ZPOTE ! TKE and potential energy
+ ! between 2 levels
+REAL, DIMENSION(SIZE(PVPT,1)) :: ZVPT_DEP ! Thetav on departure point
!
-REAL, DIMENSION(SIZE(PTKEM2D,1),SIZE(PTKEM2D,2)) :: ZDELTVPT,ZHLVPT
+REAL, DIMENSION(SIZE(PVPT,1),SIZE(PVPT,2)) :: ZDELTVPT,ZHLVPT
!Virtual Potential Temp at Half level and DeltaThv between
- !2 levels
+ !2 mass levels
INTEGER :: IIJU !Internal Domain
INTEGER :: J1D !horizontal loop counter
INTEGER :: JKK !loop counters
-INTEGER :: JRR !moist loop counter
-INTEGER :: JIJK !loop counters
REAL :: ZTEST,ZTEST0,ZTESTM !test for vectorization
!-------------------------------------------------------------------------------------
!
!* 1. INITIALISATION
! --------------
-IIJU=SIZE(PTKEM2D,1)
+IIJU=SIZE(PVPT,1)
!
ZDELTVPT(:,:)=DZM_MF(KKA,KKU,KKL,PVPT(:,:))
ZDELTVPT(:,KKA)=0.
@@ -120,6 +122,11 @@ END WHERE
!
ZHLVPT(:,:)=MZM_MF(KKA,KKU,KKL,PVPT(:,:))
!
+!We consider that gradient between mass levels KKB and KKB+KKL is the same as
+!the gradient between flux level KKB and mass level KKB
+ZDELTVPT(:,KKB)=PDZZ2D(:,KKB)*ZDELTVPT(:,KKB+KKL)/PDZZ2D(:,KKB+KKL)
+ZHLVPT(:,KKB)=PVPT(:,KKB)-ZDELTVPT(:,KKB)*0.5
+!
!
!
!* 2. CALCULATION OF THE UPWARD MIXING LENGTH
@@ -127,27 +134,58 @@ ZHLVPT(:,:)=MZM_MF(KKA,KKU,KKL,PVPT(:,:))
!
IF (OUPORDN.EQV..TRUE.) THEN
- ZINTE(:)=PTKEM2D(:,KK)
+ ZINTE(:)=PTKEM_DEP(:)
PLWORK=0.
ZTESTM=1.
+ IF(OFLUX)THEN
+ ZVPT_DEP(:)=ZHLVPT(:,KK) ! departure point is on flux level
+ !We must compute what happens between flux level KK and mass level KK
+ DO J1D=1,IIJU
+ ZTEST0=0.5+SIGN(0.5,ZINTE(J1D)) ! 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))) * &
+ PDZZ2D(J1D,KK)*0.5
+ ! Test if it rests some energy to consume
+ ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
+ ! Length travelled by parcel if it rests energy to consume
+ ZLWORK1(J1D)=PDZZ2D(J1D,KK)*0.5
+ ! Lenght travelled by parcel to nullify energy
+ ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
+ ( ZHLVPT(J1D,KK) - ZVPT_DEP(J1D) ) &
+ + SQRT (ABS( &
+ ( 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) )
+ ! Effective length travelled by parcel
+ PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
+ (1-ZTEST)*ZLWORK2(J1D))
+ ! Rest of energy to consume
+ ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
+ ENDDO
+ ELSE
+ ZVPT_DEP(:)=PVPT(:,KK) ! departure point is on mass level
+ ENDIF
+
DO JKK=KK+KKL,KKE,KKL
IF(ZTESTM > 0.) THEN
ZTESTM=0
DO J1D=1,IIJU
ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
- ZPOTE(J1D) = ZTEST0*(PG_O_THVREF2D(J1D,KK) * &
- (ZHLVPT(J1D,JKK) - PVPT(J1D,KK))) * PDZZ2D(J1D,JKK) !particle keeps its temperature
+ ZPOTE(J1D) = ZTEST0*(PG_O_THVREF(J1D) * &
+ (ZHLVPT(J1D,JKK) - ZVPT_DEP(J1D))) * PDZZ2D(J1D,JKK) !particle keeps its temperature
ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
ZTESTM=ZTESTM+ZTEST0
ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
!ZLWORK2 jump of the last reached level
- ZLWORK2(J1D)= ( - PG_O_THVREF2D(J1D,KK) * &
- ( PVPT(J1D,JKK-KKL) - PVPT(J1D,KK) ) &
+ ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
+ ( PVPT(J1D,JKK-KKL) - ZVPT_DEP(J1D) ) &
+ SQRT (ABS( &
- ( PG_O_THVREF2D(J1D,KK) * (PVPT(J1D,JKK-KKL) - PVPT(J1D,KK)) )**2 &
- + 2. * ZINTE(J1D) * PG_O_THVREF2D(J1D,KK) &
+ ( PG_O_THVREF(J1D) * (PVPT(J1D,JKK-KKL) - ZVPT_DEP(J1D)) )**2 &
+ + 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
* ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )) ) / &
- ( PG_O_THVREF2D(J1D,KK) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
+ ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
!
PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
(1-ZTEST)*ZLWORK2(J1D))
@@ -162,7 +200,13 @@ ENDIF
!
IF (OUPORDN.EQV..FALSE.) THEN
- ZINTE(:)=PTKEM2D(:,KK)
+ IF(OFLUX) THEN
+ WRITE(*,*) ' STOP'
+ WRITE(*,*) ' OFLUX OPTION NOT CODED FOR DOWNWARD MIXING LENGTH'
+ CALL ABORT
+ STOP
+ ENDIF
+ ZINTE(:)=PTKEM_DEP(:)
PLWORK=0.
ZTESTM=1.
DO JKK=KK,KKB,-KKL
@@ -170,18 +214,18 @@ IF (OUPORDN.EQV..FALSE.) THEN
ZTESTM=0
DO J1D=1,IIJU
ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
- ZPOTE(J1D) = -ZTEST0*(PG_O_THVREF2D(J1D,KK) * &
+ ZPOTE(J1D) = -ZTEST0*(PG_O_THVREF(J1D) * &
(ZHLVPT(J1D,JKK) - PVPT(J1D,KK))) * PDZZ2D(J1D,JKK) !particle keeps its temperature
ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
ZTESTM=ZTESTM+ZTEST0
ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
- ZLWORK2(J1D)= ( + PG_O_THVREF2D(J1D,KK) * &
+ ZLWORK2(J1D)= ( + PG_O_THVREF(J1D) * &
( PVPT(J1D,JKK) - PVPT(J1D,KK) ) &
+ SQRT (ABS( &
- ( PG_O_THVREF2D(J1D,KK) * (PVPT(J1D,JKK) - PVPT(J1D,KK)) )**2 &
- + 2. * ZINTE(J1D) * PG_O_THVREF2D(J1D,KK) &
+ ( 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_THVREF2D(J1D,KK) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
+ ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
!
PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
(1-ZTEST)*ZLWORK2(J1D))
diff --git a/src/MNH/compute_entr_detr.f90 b/src/MNH/compute_entr_detr.f90
index fda4d89f4694b30728848f9938a630439220d07c..b7346fad93d7d261b08b2ec40e89ad1ed6ce95d1 100644
--- a/src/MNH/compute_entr_detr.f90
+++ b/src/MNH/compute_entr_detr.f90
@@ -8,45 +8,56 @@
!
INTERFACE
!
- SUBROUTINE COMPUTE_ENTR_DETR(KK,KKB,KKE,KKL,OTEST,OTESTLCL,HFRAC_ICE, &
- PFRAC_ICE,PPABSM,PZZ,PDZZ,&
- PTHVM,PTHLM,PRTM,PW_UP2,&
- PTHL_UP,PRT_UP,PLUP,&
- PRC_UP,PRI_UP,PRC_MIX,PRI_MIX, &
- PENTR,PDETR,PBUO_INTEG)
+ SUBROUTINE COMPUTE_ENTR_DETR(KK,KKB,KKE,KKL,OTEST,OTESTLCL,&
+ HFRAC_ICE,PFRAC_ICE,PRHODREF,&
+ PPRE_MINUS_HALF,&
+ PPRE_PLUS_HALF,PZZ,PDZZ,&
+ PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,&
+ PTHL_UP,PRT_UP,PLUP,&
+ PRC_UP,PRI_UP,PTHV_UP,&
+ PRSAT_UP,PRC_MIX,PRI_MIX, &
+ PENTR,PDETR,PENTR_CLD,PDETR_CLD,&
+ PBUO_INTEG_DRY,PBUO_INTEG_CLD,&
+ PPART_DRY)
-!
-!
-!
-INTEGER, INTENT(IN) :: KK ! near ground physical index
+!INTEGER, INTENT(IN) :: KK
INTEGER, INTENT(IN) :: KKB ! near ground physical index
INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-LOGICAL,DIMENSION(:),INTENT(INOUT) :: OTEST
-LOGICAL,DIMENSION(:),INTENT(INOUT) :: OTESTLCL !test of condensation
-CHARACTER*1,INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:) ,INTENT(IN) :: PFRAC_ICE
-
+LOGICAL,DIMENSION(:), INTENT(IN) :: OTEST ! test to see if updraft is running
+LOGICAL,DIMENSION(:), INTENT(IN) :: OTESTLCL !test of condensation
+CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using
+ ! Temperature (T) or prescribed
+ ! (Y)
+REAL, DIMENSION(:), INTENT(IN) :: PFRAC_ICE ! fraction of ice
!
! prognostic variables at t- deltat
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metrics coefficient
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM ! ThetaV environment
-
!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !rhodref
+REAL, DIMENSION(:), INTENT(IN) :: PPRE_MINUS_HALF ! Pressure at flux level KK
+REAL, DIMENSION(:), INTENT(IN) :: PPRE_PLUS_HALF ! Pressure at flux level KK+KKL
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metrics coefficient
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM ! ThetaV environment
+
!
! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:), INTENT(IN) :: PTHLM ! Thetal
-REAL, DIMENSION(:), INTENT(IN) :: PRTM ! total mixing ratio
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PW_UP2 ! Vertical velocity^2
-REAL, DIMENSION(:), INTENT(IN) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:), INTENT(IN) :: PLUP ! LUP compute from the ground
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! Thetal
+REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! total mixing ratio
+REAL, DIMENSION(:,:), INTENT(IN) :: PW_UP2 ! Vertical velocity^2
+REAL, DIMENSION(:), INTENT(IN) :: PTH_UP,PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:), INTENT(IN) :: PLUP ! LUP compute from the ground
REAL, DIMENSION(:), INTENT(IN) :: PRC_UP,PRI_UP ! Updraft cloud content
+REAL, DIMENSION(:), INTENT(IN) :: PTHV_UP ! Thetav of updraft
+REAL, DIMENSION(:), INTENT(IN) :: PRSAT_UP ! Mixing ratio at saturation in updraft
REAL, DIMENSION(:), INTENT(INOUT) :: PRC_MIX, PRI_MIX ! Mixture cloud content
-REAL, DIMENSION(:), INTENT(INOUT) :: PENTR ! Mass flux entrainment of the updraft
-REAL, DIMENSION(:), INTENT(INOUT) :: PDETR ! Mass flux detrainment of the updraft
-REAL, DIMENSION(:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+REAL, DIMENSION(:), INTENT(OUT) :: PENTR ! Mass flux entrainment of the updraft
+REAL, DIMENSION(:), INTENT(OUT) :: PDETR ! Mass flux detrainment of the updraft
+REAL, DIMENSION(:), INTENT(OUT) :: PENTR_CLD ! Mass flux entrainment of the updraft in cloudy part
+REAL, DIMENSION(:), INTENT(OUT) :: PDETR_CLD ! Mass flux detrainment of the updraft in cloudy part
+REAL, DIMENSION(:), INTENT(OUT) :: PBUO_INTEG_DRY, PBUO_INTEG_CLD! Integral Buoyancy
+REAL, DIMENSION(:), INTENT(OUT) :: PPART_DRY ! ratio of dry part at the transition level
!
!
END SUBROUTINE COMPUTE_ENTR_DETR
@@ -56,11 +67,16 @@ END INTERFACE
END MODULE MODI_COMPUTE_ENTR_DETR
! ######spl
SUBROUTINE COMPUTE_ENTR_DETR(KK,KKB,KKE,KKL,OTEST,OTESTLCL,&
- HFRAC_ICE,PFRAC_ICE,PPABSM,PZZ,PDZZ,&
- PTHVM,PTHLM,PRTM,PW_UP2,&
+ HFRAC_ICE,PFRAC_ICE,PRHODREF,&
+ PPRE_MINUS_HALF,&
+ PPRE_PLUS_HALF,PZZ,PDZZ,&
+ PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,&
PTHL_UP,PRT_UP,PLUP,&
- PRC_UP,PRI_UP,PRC_MIX,PRI_MIX, &
- PENTR,PDETR,PBUO_INTEG)
+ PRC_UP,PRI_UP,PTHV_UP,&
+ PRSAT_UP,PRC_MIX,PRI_MIX, &
+ PENTR,PDETR,PENTR_CLD,PDETR_CLD,&
+ PBUO_INTEG_DRY,PBUO_INTEG_CLD,&
+ PPART_DRY)
! #############################################################
!!
@@ -98,6 +114,12 @@ END MODULE MODI_COMPUTE_ENTR_DETR
!! protection against too big ZPART_DRY, interface modified
!! S. Riette Jan 2012: support for both order of vertical levels
!! S. Riette & J. Escobar (11/2013) : remove div by 0 on real*4 case
+!! P.Marguinaud Jun 2012: fix uninitialized variable
+!! P.Marguinaud Nov 2012: fix gfortran bug
+!! S. Riette Apr 2013: bugs correction, rewriting (for optimisation) and
+!! improvement of continuity at the condensation level
+!! S. Riette Nov 2013: protection against zero divide for min value of dry PDETR
+!! R.Honnert Oct 2016 : Update with AROME
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -121,16 +143,18 @@ INTEGER, INTENT(IN) :: KK
INTEGER, INTENT(IN) :: KKB ! near ground physical index
INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-LOGICAL,DIMENSION(:),INTENT(INOUT) :: OTEST ! test to see if updraft is running
-LOGICAL,DIMENSION(:),INTENT(INOUT) :: OTESTLCL !test of condensation
-CHARACTER*1,INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using
+LOGICAL,DIMENSION(:), INTENT(IN) :: OTEST ! test to see if updraft is running
+LOGICAL,DIMENSION(:), INTENT(IN) :: OTESTLCL !test of condensation
+CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using
! Temperature (T) or prescribed
! (Y)
REAL, DIMENSION(:), INTENT(IN) :: PFRAC_ICE ! fraction of ice
!
! prognostic variables at t- deltat
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !rhodref
+REAL, DIMENSION(:), INTENT(IN) :: PPRE_MINUS_HALF ! Pressure at flux level KK
+REAL, DIMENSION(:), INTENT(IN) :: PPRE_PLUS_HALF ! Pressure at flux level KK+KKL
REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metrics coefficient
REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM ! ThetaV environment
@@ -138,16 +162,21 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM ! ThetaV environment
!
! thermodynamical variables which are transformed in conservative var.
!
-REAL, DIMENSION(:), INTENT(IN) :: PTHLM ! Thetal
-REAL, DIMENSION(:), INTENT(IN) :: PRTM ! total mixing ratio
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PW_UP2 ! Vertical velocity^2
-REAL, DIMENSION(:), INTENT(IN) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! Thetal
+REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! total mixing ratio
+REAL, DIMENSION(:,:), INTENT(IN) :: PW_UP2 ! Vertical velocity^2
+REAL, DIMENSION(:), INTENT(IN) :: PTH_UP,PTHL_UP,PRT_UP ! updraft properties
REAL, DIMENSION(:), INTENT(IN) :: PLUP ! LUP compute from the ground
REAL, DIMENSION(:), INTENT(IN) :: PRC_UP,PRI_UP ! Updraft cloud content
+REAL, DIMENSION(:), INTENT(IN) :: PTHV_UP ! Thetav of updraft
+REAL, DIMENSION(:), INTENT(IN) :: PRSAT_UP ! Mixing ratio at saturation in updraft
REAL, DIMENSION(:), INTENT(INOUT) :: PRC_MIX, PRI_MIX ! Mixture cloud content
-REAL, DIMENSION(:), INTENT(INOUT) :: PENTR ! Mass flux entrainment of the updraft
-REAL, DIMENSION(:), INTENT(INOUT) :: PDETR ! Mass flux detrainment of the updraft
-REAL, DIMENSION(:), INTENT(INOUT) :: PBUO_INTEG! Integral Buoyancy
+REAL, DIMENSION(:), INTENT(OUT) :: PENTR ! Mass flux entrainment of the updraft
+REAL, DIMENSION(:), INTENT(OUT) :: PDETR ! Mass flux detrainment of the updraft
+REAL, DIMENSION(:), INTENT(OUT) :: PENTR_CLD ! Mass flux entrainment of the updraft in cloudy part
+REAL, DIMENSION(:), INTENT(OUT) :: PDETR_CLD ! Mass flux detrainment of the updraft in cloudy part
+REAL, DIMENSION(:), INTENT(OUT) :: PBUO_INTEG_DRY, PBUO_INTEG_CLD! Integral Buoyancy
+REAL, DIMENSION(:), INTENT(OUT) :: PPART_DRY ! ratio of dry part at the transition level
!
!
! 1.2 Declaration of local variables
@@ -155,64 +184,38 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PBUO_INTEG! Integral Buoyancy
!
! Variables for cloudy part
-
-REAL, DIMENSION(SIZE(PTHLM)) :: ZKIC ! fraction of env. mass in the muxtures
-REAL, DIMENSION(SIZE(PTHLM)) :: ZEPSI,ZDELTA ! factor entrainment detrainment
-REAL, DIMENSION(SIZE(PTHLM)) :: ZEPSI_CLOUD ! factor entrainment detrainment
-REAL, DIMENSION(SIZE(PTHLM)) :: ZCOEFFMF_CLOUD ! factor for compputing entr. detr.
-
-REAL, DIMENSION(SIZE(PTHLM)) :: ZMIXTHL,ZMIXRT ! Thetal and rt in the mixtures
-!
-REAL, DIMENSION(SIZE(PTHLM)) :: ZTHMIX ! Theta and Thetav of mixtures
-REAL, DIMENSION(SIZE(PTHLM)) :: ZRVMIX,ZRCMIX,ZRIMIX ! mixing ratios in mixtures
-
-REAL, DIMENSION(SIZE(PTHLM)) :: ZTHMIX_F2 ! Theta and Thetav of mixtures
-REAL, DIMENSION(SIZE(PTHLM)) :: ZRVMIX_F2,ZRCMIX_F2,ZRIMIX_F2 ! mixing ratios in mixtures
-
-REAL, DIMENSION(SIZE(PTHLM)) :: ZTHMIX_M2
-REAL, DIMENSION(SIZE(PTHLM)) :: ZRVMIX_M2, ZRCMIX_M2, ZRIMIX_M2
-
-REAL, DIMENSION(SIZE(PTHLM)) :: ZTHV_UP ! thvup at mass point kk
-
-
-REAL, DIMENSION(SIZE(PTHLM)) :: ZTHVMIX_1,ZTHVMIX_2 ! Theta and Thetav of mixtures
-
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZKIC, ZKIC_F2 ! fraction of env. mass in the muxtures
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZEPSI,ZDELTA ! factor entrainment detrainment
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZEPSI_CLOUD ! factor entrainment detrainment
+REAL :: ZCOEFFMF_CLOUD ! factor for compputing entr. detr.
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZMIXTHL,ZMIXRT ! Thetal and rt in the mixtures
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHMIX ! Theta and Thetav of mixtures
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZRVMIX,ZRCMIX,ZRIMIX ! mixing ratios in mixtures
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHVMIX, ZTHVMIX_F2 ! Theta and Thetav of mixtures
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHV_UP_F2 ! thv_up at flux point kk+kkl
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZRSATW, ZRSATI ! working arrays (mixing ratio at saturation)
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZTHV ! theta V of environment at the bottom of cloudy part
+REAL :: ZKIC_INIT !Initial value of ZKIC
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZCOTHVU ! Variation of Thvup between bottom and top of cloudy part
! Variables for dry part
-
-REAL, DIMENSION(SIZE(PTHLM)) :: ZBUO_INTEG,& ! Temporary integral Buoyancy
- ZDZ_HALF,& ! half-DeltaZ between 2 flux points
- ZDZ_STOP,& ! Exact Height of the LCL
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZFOESW, ZFOESI ! saturating vapor pressure
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZDRSATODP ! d.Rsat/dP
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZT ! Temperature
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZWK ! Work array
+
+! Variables for dry and cloudy parts
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZCOEFF_MINUS_HALF,& ! Variation of Thv between mass points kk-kkl and kk
+ ZCOEFF_PLUS_HALF ! Variation of Thv between mass points kk and kk+kkl
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZPRE ! pressure at the bottom of the cloudy part
+REAL, DIMENSION(SIZE(PTHVM,1)) :: ZG_O_THVREF
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZFRAC_ICE ! fraction of ice
+REAL :: ZRVORD ! RV/RD
+REAL, DIMENSION(SIZE(PTHLM,1)) :: ZDZ_STOP,& ! Exact Height of the LCL above flux level KK
ZTHV_MINUS_HALF,& ! Thv at flux point(kk)
ZTHV_PLUS_HALF,& ! Thv at flux point(kk+kkl)
- ZCOEFF_MINUS_HALF,& ! Variation of Thv between mass points kk-kkl and kk
- ZCOEFF_PLUS_HALF,& ! Variation of Thv between mass points kk and kk+kkl
- ZCOTHVU_MINUS_HALF,& ! Variation of Thvup between flux point kk and mass point kk
- ZCOTHVU_PLUS_HALF,& ! Variation of Thvup between mass point kk and flux point kk+kkl
- ZW2_HALF,& ! w**2 at mass point KK
- ZWK ! temp correction for Lup - z
-
-REAL, DIMENSION(SIZE(PTHLM)) :: ZCOPRE_MINUS_HALF,& ! Variation of pressure between mass points kk-kkl and kk
- ZCOPRE_PLUS_HALF,& ! Variation of pressure between mass points kk and kk+kkl
- ZPRE_MINUS_HALF,& ! pressure at flux point kk
- ZPRE_PLUS_HALF,& ! pressure at flux point kk+kkl
- ZTHV_UP_F1,& ! thv_up at flux point kk
- ZTHV_UP_F2 ! thv_up at flux point kk+kkl
-REAL, DIMENSION(SIZE(PTHLM)) :: ZCOEFF_QSAT,& ! variation of Qsat at the transition between dry part and cloudy part
- ZRC_ORD,& !
- ZPART_DRY ! part of dry part at the transition level
-!
-REAL, DIMENSION(SIZE(PTHVM,1),SIZE(PTHVM,2)) ::ZG_O_THVREF
-!
-REAL, DIMENSION(SIZE(PTHLM)) :: ZFRAC_ICE ! fraction of ice
-REAL, DIMENSION(SIZE(PTHLM)) :: ZRSATW, ZRSATI
-!
-LOGICAL, DIMENSION(SIZE(OTEST,1)) :: GTEST_LOCAL_LCL,& ! true if LCL found between flux point KK and mass point KK
- GTEST_LOCAL_LCL2 ! true if LCL found between mass point KK and flux point KK+KKL
-!
-REAL :: ZRDORV ! RD/RV
-REAL :: ZRVORD ! RV/RD
-
+ ZDZ ! Delta Z used in computations
+INTEGER :: JI,JLOOP
!----------------------------------------------------------------------------------
@@ -220,269 +223,260 @@ REAL :: ZRVORD ! RV/RD
! ------------------
- ZRDORV = XRD / XRV !=0.622
ZRVORD = XRV / XRD !=1.607
- ZG_O_THVREF=XG/PTHVM
+ ZG_O_THVREF(:)=XG/PTHVM(:,KK)
+ ZCOEFFMF_CLOUD=XENTR_MF * XG / XCRAD_MF
- ZCOEFF_QSAT=0.
- ZRC_ORD=0.
- ZPART_DRY=1.
- GTEST_LOCAL_LCL=.FALSE.
- ZDZ_HALF(:) = (PZZ(:,KK+KKL)-PZZ(:,KK))/2.
- ZDZ_STOP(:) = ZDZ_HALF(:)
-
ZFRAC_ICE(:)=PFRAC_ICE(:) ! to not modify fraction of ice
- ZKIC(:)=0.1 ! starting value for critical mixed fraction for CLoudy Part
-
-
-! Computation of KIC
-! ---------------------
-
-! 2.1 Compute critical mixed fraction by estimating unknown
-! T^mix r_c^mix and r_i^mix from thl^mix and r_t^mix
-! We determine the zero crossing of the linear curve
-! evaluating the derivative using ZMIXF=0.1.
-! -----------------------------------------------------
-
- ZMIXTHL(:) = ZKIC(:) * PTHLM(:)+(1. - ZKIC(:))*PTHL_UP(:)
- ZMIXRT(:) = ZKIC(:) * PRTM(:)+(1. - ZKIC(:))*PRT_UP(:)
-
- ! MIXTURE FOR CLOUDY PART
- ! Compute pressure at flux level KK
- ZCOPRE_PLUS_HALF(:) = ((PPABSM(:,KK+KKL)-PPABSM(:,KK))/PDZZ(:,KK+KKL))
- ZPRE_PLUS_HALF(:) = ZCOPRE_PLUS_HALF*0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))+PPABSM(:,KK)
-
- ! Compute pressure at flux level KK+KKL
+ ZPRE(:)=PPRE_MINUS_HALF(:)
+ ZMIXTHL(:)=0.1
+ ZMIXRT(:)=0.1
+
+! 1.4 Estimation of PPART_DRY
+ DO JLOOP=1,SIZE(OTEST)
+ IF(OTEST(JLOOP) .AND. OTESTLCL(JLOOP)) THEN
+ !No dry part when condensation level is reached
+ PPART_DRY(JLOOP)=0.
+ ZDZ_STOP(JLOOP)=0.
+ ZPRE(JLOOP)=PPRE_MINUS_HALF(JLOOP)
+ ELSE IF (OTEST(JLOOP) .AND. .NOT. OTESTLCL(JLOOP)) THEN
+ !Temperature at flux level KK
+ ZT(JLOOP)=PTH_UP(JLOOP)*(PPRE_MINUS_HALF(JLOOP)/XP00) ** (XRD/XCPD)
+ !Saturating vapor pressure at flux level KK
+ ZFOESW(JLOOP) = MIN(EXP( XALPW - XBETAW/ZT(JLOOP) - XGAMW*LOG(ZT(JLOOP)) ), 0.99*PPRE_MINUS_HALF(JLOOP))
+ ZFOESI(JLOOP) = MIN(EXP( XALPI - XBETAI/ZT(JLOOP) - XGAMI*LOG(ZT(JLOOP)) ), 0.99*PPRE_MINUS_HALF(JLOOP))
+ !Computation of d.Rsat / dP (partial derivations with respect to P and T
+ !and use of T=Theta*(P/P0)**(R/Cp) to transform dT into dP with theta_up
+ !constant at the vertical)
+ ZDRSATODP(JLOOP)=(XBETAW/ZT(JLOOP)-XGAMW)*(1-ZFRAC_ICE(JLOOP))+(XBETAI/ZT(JLOOP)-XGAMI)*ZFRAC_ICE(JLOOP)
+ ZDRSATODP(JLOOP)=((XRD/XCPD)*ZDRSATODP(JLOOP)-1.)*PRSAT_UP(JLOOP)/ &
+ &(PPRE_MINUS_HALF(JLOOP)-(ZFOESW(JLOOP)*(1-ZFRAC_ICE(JLOOP)) + ZFOESI(JLOOP)*ZFRAC_ICE(JLOOP)))
+ !Use of d.Rsat / dP and pressure at flux level KK to find pressure (ZPRE)
+ !where Rsat is equal to PRT_UP
+ ZPRE(JLOOP)=PPRE_MINUS_HALF(JLOOP)+(PRT_UP(JLOOP)-PRSAT_UP(JLOOP))/ZDRSATODP(JLOOP)
+ !Fraction of dry part (computed with pressure and used with heights, no
+ !impact found when using log function here and for pressure on flux levels
+ !computation)
+ PPART_DRY(JLOOP)=MAX(0., MIN(1., (PPRE_MINUS_HALF(JLOOP)-ZPRE(JLOOP))/(PPRE_MINUS_HALF(JLOOP)-PPRE_PLUS_HALF(JLOOP))))
+ !Height above flux level KK of the cloudy part
+ ZDZ_STOP(JLOOP) = (PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*PPART_DRY(JLOOP)
+ END IF
+ END DO
+
+! 1.5 Gradient and flux values of thetav
IF(KK/=KKB)THEN
- ZCOPRE_MINUS_HALF(:) = ((PPABSM(:,KK)-PPABSM(:,KK-KKL))/PDZZ(:,KK))
- ZPRE_MINUS_HALF(:)= ZCOPRE_MINUS_HALF*0.5*(PZZ(:,KK)-PZZ(:,KK-KKL))+PPABSM(:,KK-KKL)
+ ZCOEFF_MINUS_HALF(:)=((PTHVM(:,KK)-PTHVM(:,KK-KKL))/PDZZ(:,KK))
+ ZTHV_MINUS_HALF(:) = PTHVM(:,KK) - ZCOEFF_MINUS_HALF(:)*0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))
ELSE
- ZPRE_MINUS_HALF(:)=PPABSM(:,KK)
+ ZCOEFF_MINUS_HALF(:)=0.
+ ZTHV_MINUS_HALF(:) = PTHVM(:,KK)
ENDIF
+ ZCOEFF_PLUS_HALF(:) = ((PTHVM(:,KK+KKL)-PTHVM(:,KK))/PDZZ(:,KK+KKL))
+ ZTHV_PLUS_HALF(:) = PTHVM(:,KK) + ZCOEFF_PLUS_HALF(:)*0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))
+
+! 2 Dry part computation:
+! Integral buoyancy and computation of PENTR and PDETR for dry part
+! --------------------------------------------------------------------
+
+DO JLOOP=1,SIZE(OTEST)
+ IF (OTEST(JLOOP) .AND. PPART_DRY(JLOOP)>0.) THEN
+ ZDZ(JLOOP)=MIN(ZDZ_STOP(JLOOP),(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*0.5)
+ PBUO_INTEG_DRY(JLOOP) = ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*&
+ (0.5 * ( - ZCOEFF_MINUS_HALF(JLOOP))*ZDZ(JLOOP) &
+ - ZTHV_MINUS_HALF(JLOOP) + PTHV_UP(JLOOP) )
+
+ !Between mass flux KK and bottom of cloudy part (if above mass flux)
+ ZDZ(JLOOP)=MAX(0., ZDZ_STOP(JLOOP)-(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*0.5)
+ PBUO_INTEG_DRY(JLOOP) = PBUO_INTEG_DRY(JLOOP) + ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*&
+ (0.5 * ( - ZCOEFF_PLUS_HALF(JLOOP))*ZDZ(JLOOP) &
+ - PTHVM(JLOOP,KK) + PTHV_UP(JLOOP) )
+ IF (PBUO_INTEG_DRY(JLOOP)>=0.) THEN
+ PENTR(JLOOP) = 0.5/(XABUO-XBENTR*XENTR_DRY)*&
+ LOG(1.+ (2.*(XABUO-XBENTR*XENTR_DRY)/PW_UP2(JLOOP,KK))* &
+ PBUO_INTEG_DRY(JLOOP))
+ PDETR(JLOOP) = 0.
+ ELSE
+ PENTR(JLOOP) = 0.
+ PDETR(JLOOP) = 0.5/(XABUO)*&
+ LOG(1.+ (2.*(XABUO)/PW_UP2(JLOOP,KK))* &
+ (-PBUO_INTEG_DRY(JLOOP)))
+ ENDIF
+ PENTR(JLOOP) = XENTR_DRY*PENTR(JLOOP)/(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))
+ PDETR(JLOOP) = XDETR_DRY*PDETR(JLOOP)/(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))
+ !Minimum value of detrainment
+ ZWK(JLOOP)=PLUP(JLOOP)-0.5*(PZZ(JLOOP,KK)+PZZ(JLOOP,KK+KKL))
+ ZWK(JLOOP)=SIGN(MAX(1., ABS(ZWK(JLOOP))), ZWK(JLOOP)) ! ZWK must not be zero
+ PDETR(JLOOP) = MAX(PPART_DRY(JLOOP)*XDETR_LUP/ZWK(JLOOP), PDETR(JLOOP))
+ ELSE
+ !No dry part, consation reached (OTESTLCL)
+ PBUO_INTEG_DRY(JLOOP) = 0.
+ PENTR(JLOOP)=0.
+ PDETR(JLOOP)=0.
+ END IF
+ENDDO
+
+
+! 3 Wet part computation
+! -----------------------
+
+! 3.1 Integral buoyancy for cloudy part
- ! Compute non cons. var. of mixture at the mass level
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
- PPABSM(:,KK),ZMIXTHL,ZMIXRT,&
- ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
- ZRSATW, ZRSATI)
-
- ! Compute theta_v of mixture at mass level KK for KF90
- ZTHVMIX_1(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
-
- ! Compute non cons. var. of mixture at the flux level KK+KKL
- ZRCMIX=PRC_MIX
- ZRIMIX=PRI_MIX
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
- ZPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,&
- ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,&
- ZRSATW, ZRSATI)
-
-
- ! compute theta_v of mixture at the flux level KK+KKL for KF90
- ZTHVMIX_2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
-
-
-! 2.1 Compute critical mixed fraction by estimating unknown
-! T^mix r_c^mix and r_i^mix from thl^mix and r_t^mix
-! We determine the zero crossing of the linear curve
-! evaluating the derivative using ZMIXF=0.1.
-! -----------------------------------------------------
-
-
-! THV_UP FOR DRY PART
- ! Compute theta_v of updraft at flux level KK
- ZRCMIX=PRC_UP
- ZRIMIX=PRI_UP
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
- ZPRE_MINUS_HALF,PTHL_UP,PRT_UP,&
- ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,&
- ZRSATW, ZRSATI)
- ZTHV_UP_F1(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+PRT_UP(:))
-
- ! Compute theta_v of updraft at mass level KK
- ZRCMIX=PRC_UP
- ZRIMIX=PRI_UP
+ ! Compute theta_v of updraft at flux level KK+KKL
+ !MIX variables are used to avoid declaring new variables
+ !but we are dealing with updraft and not mixture
+ ZRCMIX(:)=PRC_UP(:)
+ ZRIMIX(:)=PRI_UP(:)
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
- PPABSM(:,KK),PTHL_UP,PRT_UP,&
+ PPRE_PLUS_HALF,PTHL_UP,PRT_UP,&
ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,&
ZRSATW, ZRSATI)
- ZTHV_UP(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+PRT_UP(:))
-
- ! Compute theta_v of updraft at flux level KK+KKL
- ZRCMIX_F2=PRC_UP
- ZRIMIX_F2=PRI_UP
+ ZTHV_UP_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+PRT_UP(:))
+
+ ! Integral buoyancy for cloudy part
+ DO JLOOP=1,SIZE(OTEST)
+ IF(OTEST(JLOOP) .AND. PPART_DRY(JLOOP)<1.) THEN
+ !Gradient of Theta V updraft over the cloudy part, assuming that thetaV updraft don't change
+ !between flux level KK and bottom of cloudy part
+ ZCOTHVU(JLOOP)=(ZTHV_UP_F2(JLOOP)-PTHV_UP(JLOOP))/((PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))*(1-PPART_DRY(JLOOP)))
+
+ !Computation in two parts to use change of gradient of theta v of environment
+ !Between bottom of cloudy part (if under mass level) and mass level KK
+ ZDZ(JLOOP)=MAX(0., 0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-ZDZ_STOP(JLOOP))
+ PBUO_INTEG_CLD(JLOOP) = ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*&
+ (0.5*( ZCOTHVU(JLOOP) - ZCOEFF_MINUS_HALF(JLOOP))*ZDZ(JLOOP) &
+ - (PTHVM(JLOOP,KK)-ZDZ(JLOOP)*ZCOEFF_MINUS_HALF(JLOOP)) + PTHV_UP(JLOOP) )
+
+ !Between max(mass level, bottom of cloudy part) and flux level KK+KKL
+ ZDZ(JLOOP)=(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-MAX(ZDZ_STOP(JLOOP),0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)))
+ PBUO_INTEG_CLD(JLOOP) = PBUO_INTEG_CLD(JLOOP)+ZG_O_THVREF(JLOOP)*ZDZ(JLOOP)*&
+ (0.5*( ZCOTHVU(JLOOP) - ZCOEFF_PLUS_HALF(JLOOP))*ZDZ(JLOOP)&
+ - (PTHVM(JLOOP,KK)+(0.5*((PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK)))-ZDZ(JLOOP))*ZCOEFF_PLUS_HALF(JLOOP)) +&
+ PTHV_UP(JLOOP) )
+
+ ELSE
+ !No cloudy part
+ PBUO_INTEG_CLD(JLOOP)=0.
+ END IF
+ END DO
+
+! 3.2 Critical mixed fraction for KK+KKL flux level (ZKIC_F2) and
+! for bottom of cloudy part (ZKIC), then a mean for the cloudy part
+! (put also in ZKIC)
+!
+! computation by estimating unknown
+! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
+! We determine the zero crossing of the linear curve
+! evaluating the derivative using ZMIXF=0.1
+
+ ZKIC_INIT=0.1 ! starting value for critical mixed fraction for CLoudy Part
+
+ ! Compute thetaV of environment at the bottom of cloudy part
+ ! and cons then non cons. var. of mixture at the bottom of cloudy part
+
+ ! JI computed to avoid KKL(KK-KKL) being < KKL*KKB
+ JI=KKL*MAX(KKL*(KK-KKL),KKL*KKB)
+ DO JLOOP=1,SIZE(OTEST)
+ IF(OTEST(JLOOP) .AND. PPART_DRY(JLOOP)>0.5) THEN
+ ZDZ(JLOOP)=ZDZ_STOP(JLOOP)-0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))
+ ZTHV(JLOOP)= PTHVM(JLOOP,KK)+ZCOEFF_PLUS_HALF(JLOOP)*ZDZ(JLOOP)
+ ZMIXTHL(JLOOP) = ZKIC_INIT * &
+ (PTHLM(JLOOP,KK)+ZDZ(JLOOP)*(PTHLM(JLOOP,KK+KKL)-PTHLM(JLOOP,KK))/PDZZ(JLOOP,KK+KKL)) + &
+ (1. - ZKIC_INIT)*PTHL_UP(JLOOP)
+ ZMIXRT(JLOOP) = ZKIC_INIT * &
+ (PRTM(JLOOP,KK)+ZDZ(JLOOP)*(PRTM(JLOOP,KK+KKL)-PRTM(JLOOP,KK))/PDZZ(JLOOP,KK+KKL)) + &
+ (1. - ZKIC_INIT)*PRT_UP(JLOOP)
+ ELSEIF(OTEST(JLOOP)) THEN
+ ZDZ(JLOOP)=0.5*(PZZ(JLOOP,KK+KKL)-PZZ(JLOOP,KK))-ZDZ_STOP(JLOOP)
+ ZTHV(JLOOP)= PTHVM(JLOOP,KK)-ZCOEFF_MINUS_HALF(JLOOP)*ZDZ(JLOOP)
+ ZMIXTHL(JLOOP) = ZKIC_INIT * &
+ (PTHLM(JLOOP,KK)-ZDZ(JLOOP)*(PTHLM(JLOOP,KK)-PTHLM(JLOOP,JI))/PDZZ(JLOOP,KK)) + &
+ (1. - ZKIC_INIT)*PTHL_UP(JLOOP)
+ ZMIXRT(JLOOP) = ZKIC_INIT * &
+ (PRTM(JLOOP,KK)-ZDZ(JLOOP)*(PRTM(JLOOP,KK)-PRTM(JLOOP,JI))/PDZZ(JLOOP,KK)) + &
+ (1. - ZKIC_INIT)*PRT_UP(JLOOP)
+ ENDIF
+ ENDDO
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
- ZPRE_PLUS_HALF,PTHL_UP,PRT_UP,&
- ZTHMIX_F2,ZRVMIX_F2,ZRCMIX_F2,ZRIMIX_F2,&
+ ZPRE,ZMIXTHL,ZMIXRT,&
+ ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
ZRSATW, ZRSATI)
- ZTHV_UP_F2(:) = ZTHMIX_F2(:)*(1.+ZRVORD*ZRVMIX_F2(:))/(1.+PRT_UP(:))
+ ZTHVMIX(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
- ! Computation of RC and RI on mass point KK+KKL
- ZRCMIX_M2=PRC_UP
- ZRIMIX_M2=PRI_UP
+ ! Compute cons then non cons. var. of mixture at the flux level KK+KKL with initial ZKIC
+ ZMIXTHL(:) = ZKIC_INIT * 0.5*(PTHLM(:,KK)+PTHLM(:,KK+KKL))+(1. - ZKIC_INIT)*PTHL_UP(:)
+ ZMIXRT(:) = ZKIC_INIT * 0.5*(PRTM(:,KK)+PRTM(:,KK+KKL))+(1. - ZKIC_INIT)*PRT_UP(:)
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
- PPABSM(:,KK+KKL),PTHL_UP,PRT_UP,&
- ZTHMIX_M2,ZRVMIX_M2,ZRCMIX_M2,ZRIMIX_M2,&
+ PPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,&
+ ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
ZRSATW, ZRSATI)
-
-!
-!* 2.2 Compute final values for entr. and detr.
-! ----------------------------------------
-!
-! Dry PART
-
- ! Computation of integral entrainment and detrainment between flux level KK
- ! and mass level KK
-
- WHERE ((ZRCMIX(:)+ZRIMIX(:)>0.).AND.(.NOT.OTESTLCL))
-! If rc and/or ri is found between flux level KK and mass level KK
-! a part of dry entrainment/detrainment is defined
-! the exact height of LCL is also determined
- ZCOEFF_QSAT(:) = ((ZRCMIX_F2(:)+ZRIMIX_F2(:)) - (ZRCMIX(:)+ZRIMIX(:)))/ ZDZ_HALF(:)
- WHERE ((ZCOEFF_QSAT(:)>0.) .OR. (ZCOEFF_QSAT(:)<0.))
- ZRC_ORD(:) = (ZRCMIX(:)+ZRIMIX(:)) - ZCOEFF_QSAT(:) * ZDZ_HALF(:)
- ZDZ_STOP = (- ZRC_ORD(:)/ZCOEFF_QSAT(:))
- ZPART_DRY(:) = MAX(MIN(ZDZ_STOP / (PZZ(:,KK+KKL)-PZZ(:,KK)),0.5),0.)
- GTEST_LOCAL_LCL(:)=.TRUE.
- ENDWHERE
- ENDWHERE
-
- IF(KK/=KKB)THEN
- ZCOEFF_MINUS_HALF = ((PTHVM(:,KK)-PTHVM(:,KK-KKL))/PDZZ(:,KK))
- ELSE
- ZCOEFF_MINUS_HALF = 0.
- ENDIF
- ZCOEFF_PLUS_HALF = ((PTHVM(:,KK+KKL)-PTHVM(:,KK))/PDZZ(:,KK+KKL))
-
- ZCOTHVU_MINUS_HALF = (ZTHV_UP(:)-ZTHV_UP_F1(:))/ZDZ_HALF(:)
- ZCOTHVU_PLUS_HALF = (ZTHV_UP_F2(:)-ZTHV_UP(:))/ZDZ_HALF(:)
-
- IF(KK/=KKB)THEN
- ZTHV_MINUS_HALF = ZCOEFF_MINUS_HALF*0.5*(PZZ(:,KK)-PZZ(:,KK-KKL))+PTHVM(:,KK-KKL)
- ZTHV_PLUS_HALF = ZCOEFF_PLUS_HALF*0.5*(PZZ(:,KK)-PZZ(:,KK-KKL))+ ZTHV_MINUS_HALF
- ELSE
- ZTHV_MINUS_HALF = PTHVM(:,KK)
- ZTHV_PLUS_HALF = ZCOEFF_PLUS_HALF*0.5*(PZZ(:,KK+KKL)-PZZ(:,KK))+ ZTHV_MINUS_HALF !according to PZZ computation at KKB-KKL
- ENDIF
-
- ! Integral Buoyancy between flux level KK and mass level KK
- PBUO_INTEG = ZG_O_THVREF(:,KK)*ZDZ_HALF(:)*&
- (0.5*( ZCOTHVU_MINUS_HALF - ZCOEFF_MINUS_HALF)*ZDZ_HALF(:) &
- - ZTHV_MINUS_HALF + ZTHV_UP_F1(:) )
-
- WHERE ((OTEST).AND.(.NOT.OTESTLCL))
- PENTR=0.
- PDETR=0.
-
- ZBUO_INTEG = ZG_O_THVREF(:,KK)*ZDZ_STOP(:)*&
- (0.5 * ( - ZCOEFF_MINUS_HALF)* ZDZ_STOP(:) &
- - ZTHV_MINUS_HALF + ZTHV_UP_F1(:) )
- WHERE (ZBUO_INTEG(:)>=0.)
- PENTR = 0.5/(XABUO-XBENTR*XENTR_DRY)*&
- LOG(1.+ (2.*(XABUO-XBENTR*XENTR_DRY)/PW_UP2(:,KK))* &
- ZBUO_INTEG)
- PDETR = 0.
-
- ZW2_HALF = PW_UP2(:,KK) + 2*(XABUO-XBENTR*XENTR_DRY)*(ZBUO_INTEG)
- ELSEWHERE
- PENTR = 0.
- PDETR = 0.5/(XABUO)*&
- LOG(1.+ (2.*(XABUO)/PW_UP2(:,KK))* &
- MAX(0.,-ZBUO_INTEG))
-
- ZW2_HALF = PW_UP2(:,KK) + 2*(XABUO)*(ZBUO_INTEG)
- ENDWHERE
- ENDWHERE
-
-
- ZDZ_STOP(:) = ZDZ_HALF(:)
-
-! total Integral Buoyancy between flux level KK and flux level KK+KKL
- PBUO_INTEG = PBUO_INTEG + ZG_O_THVREF(:,KK)*ZDZ_HALF(:)*&
- (0.5*(ZCOTHVU_PLUS_HALF - ZCOEFF_PLUS_HALF)* ZDZ_HALF(:) - &
- PTHVM(:,KK) + ZTHV_UP(:) )
-
- IF(KK*KKL<(KKE-KKL)*KKL) THEN !Computation only if we are strictly below KKE-KKL
- WHERE ((((ZRCMIX_F2(:)+ZRIMIX_F2(:)>0.).AND.(ZRCMIX(:)+ZRIMIX(:)<=0.)).AND.(.NOT.OTESTLCL)).AND.(.NOT.GTEST_LOCAL_LCL(:)))
- ! If rc and/or ri is found between mass level KK and flux level KK+KKL
- ! a part of dry entrainment is defined
- ! the exact height of LCL is also determined
- ZCOEFF_QSAT(:) = ((ZRCMIX_M2(:)+ZRIMIX_M2(:)) - (ZRCMIX_F2(:)+ZRIMIX_F2(:))) / &
- & (0.5* (PZZ(:,KK+2*KKL)-PZZ(:,KK+KKL)))
- !old formulation without ice (and perhaps with errors)
- !ZCOEFF_QSAT(:) = (PRT_UP(:) - &
- ! QSAT(ZTHMIX_F2(:)*((PPABSM(:,KK+KKL)/XP00)**(XRD/XCPD)),&
- ! PPABSM(:,KK+KKL)) - &
- ! ZRCMIX(:))/ (0.5* (PZZ(:,KK+2*KKL)-PZZ(:,KK+KKL)))
- WHERE ((ZCOEFF_QSAT(:)>0.) .OR. (ZCOEFF_QSAT(:)<0.))
- ZRC_ORD(:) = ZRCMIX_F2(:)+ZRIMIX_F2(:) - ZCOEFF_QSAT(:) * ZDZ_HALF(:)
- ZDZ_STOP = (- ZRC_ORD(:)/ZCOEFF_QSAT(:))
- ZPART_DRY(:) = 0.5+MAX(MIN(ZDZ_STOP / (PZZ(:,KK+KKL)-PZZ(:,KK)),0.5),0.)
- GTEST_LOCAL_LCL2(:)=.TRUE.
- ENDWHERE
- ENDWHERE
- ENDIF
-
- WHERE (((OTEST).AND.(.NOT.OTESTLCL)).AND.(.NOT.GTEST_LOCAL_LCL(:)))
- ZBUO_INTEG = ZG_O_THVREF(:,KK)*ZDZ_STOP(:)*&
- (0.5*( - ZCOEFF_PLUS_HALF)* ZDZ_STOP(:)&
- - PTHVM(:,KK) + ZTHV_UP(:) )
-
- WHERE (ZW2_HALF>0.)
- WHERE (ZBUO_INTEG(:)>=0.)
- PENTR = PENTR + 0.5/(XABUO-XBENTR*XENTR_DRY)* &
- LOG(1.+ (2.*(XABUO-XBENTR*XENTR_DRY)/ZW2_HALF(:)) * ZBUO_INTEG)
-
- PDETR = PDETR
- ELSEWHERE
- PENTR = PENTR
- PDETR = PDETR + 0.5/(XABUO)* &
- LOG(1.+ (2.*(XABUO)/ZW2_HALF(:)) * &
- MAX(-ZBUO_INTEG,0.))
- ENDWHERE
- ELSEWHERE
- ! if w**2<0 the updraft is stopped
- OTEST=.FALSE.
- PENTR = PENTR
- PDETR = PDETR
- ENDWHERE
- ENDWHERE
- PENTR = XENTR_DRY*PENTR/(PZZ(:,KK+KKL)-PZZ(:,KK))
- PDETR = XDETR_DRY*PDETR/(PZZ(:,KK+KKL)-PZZ(:,KK))
-
- ZWK(:)=PLUP(:) - 0.5*(PZZ(:,KK)+PZZ(:,KK+KKL))
- ZWK(:)=SIGN(MAX(1., ABS(ZWK(:))), ZWK(:))
- PDETR(:)=MAX(ZPART_DRY(:)*XDETR_LUP/ZWK(:),PDETR(:))
-
-! compute final value of critical mixed fraction using theta_v
-! of mixture, grid-scale and updraft in cloud
- WHERE ((OTEST).AND.(OTESTLCL))
- ZKIC(:) = MAX(0.,ZTHV_UP(:)-PTHVM(:,KK))*ZKIC(:) / &
- (ZTHV_UP(:)-ZTHVMIX_1(:)+XMNH_EPSILON)
-
- ZKIC(:) = MAX(0., MIN(1., ZKIC(:)))
-
- ZEPSI(:) = ZKIC(:) **2.
- ZDELTA(:) = (1.-ZKIC(:))**2.
- ZEPSI_CLOUD=MIN(ZDELTA,ZEPSI)
- ZCOEFFMF_CLOUD(:)=XENTR_MF * XG / XCRAD_MF
- PENTR(:) = ZCOEFFMF_CLOUD(:)*ZEPSI_CLOUD(:)
- PDETR(:) = ZCOEFFMF_CLOUD(:)*ZDELTA(:)
- ENDWHERE
-
-! compute final value of critical mixed fraction using theta_v
-! of mixture, grid-scale and updraft in cloud
- WHERE (((OTEST).AND.(.NOT.(OTESTLCL))).AND.((GTEST_LOCAL_LCL(:).OR.GTEST_LOCAL_LCL2(:))))
- ZKIC(:) = MAX(0.,ZTHV_UP_F2(:)-ZTHV_PLUS_HALF)*ZKIC(:) / &
- (ZTHV_UP_F2(:)-ZTHVMIX_2(:)+XMNH_EPSILON)
- ZKIC(:) = MAX(0., MIN(1., ZKIC(:)))
- ZEPSI(:) = ZKIC(:) **2.
- ZDELTA(:) = (1.-ZKIC(:))**2.
- ZEPSI_CLOUD=MIN(ZDELTA,ZEPSI)
- ZCOEFFMF_CLOUD(:)=XENTR_MF * XG / XCRAD_MF
- PENTR(:) = PENTR+(1.-ZPART_DRY(:))*ZCOEFFMF_CLOUD(:)*ZEPSI_CLOUD(:)
- PDETR(:) = PDETR+(1.-ZPART_DRY(:))*ZCOEFFMF_CLOUD(:)*ZDELTA(:)
- ENDWHERE
+ ZTHVMIX_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
+
+ !Computation of mean ZKIC over the cloudy part
+ DO JLOOP=1,SIZE(OTEST)
+ IF (OTEST(JLOOP)) THEN
+ ! Compute ZKIC at the bottom of cloudy part
+ ! Thetav_up at bottom is equal to Thetav_up at flux level KK
+ IF (ABS(PTHV_UP(JLOOP)-ZTHVMIX(JLOOP))<1.E-10) THEN
+ ZKIC(JLOOP)=1.
+ ELSE
+ ZKIC(JLOOP) = MAX(0.,PTHV_UP(JLOOP)-ZTHV(JLOOP))*ZKIC_INIT / &
+ (PTHV_UP(JLOOP)-ZTHVMIX(JLOOP))
+ END IF
+ ! Compute ZKIC_F2 at flux level KK+KKL
+ IF (ABS(ZTHV_UP_F2(JLOOP)-ZTHVMIX_F2(JLOOP))<1.E-10) THEN
+ ZKIC_F2(JLOOP)=1.
+ ELSE
+ ZKIC_F2(JLOOP) = MAX(0.,ZTHV_UP_F2(JLOOP)-ZTHV_PLUS_HALF(JLOOP))*ZKIC_INIT / &
+ (ZTHV_UP_F2(JLOOP)-ZTHVMIX_F2(JLOOP))
+ END IF
+ !Mean ZKIC over the cloudy part
+ ZKIC(JLOOP)=MAX(MIN(0.5*(ZKIC(JLOOP)+ZKIC_F2(JLOOP)),1.),0.)
+ END IF
+ END DO
+
+
+! 3.3 Integration of PDF
+! According to Kain and Fritsch (1990), we replace delta Mt
+! in eq. (7) and (8) using eq. (5). Here we compute the ratio
+! of integrals without computing delta Me
+
+ !Constant PDF
+ !For this PDF, eq. (5) is delta Me=0.5*delta Mt
+ DO JLOOP=1,SIZE(OTEST)
+ IF(OTEST(JLOOP)) THEN
+ ZEPSI(JLOOP) = ZKIC(JLOOP)**2. !integration multiplied by 2
+ ZDELTA(JLOOP) = (1.-ZKIC(JLOOP))**2. !idem
+ ENDIF
+ ENDDO
+
+ !Triangular PDF
+ !Calculus must be verified before activating this part, but in this state,
+ !results on ARM case are almost identical
+ !For this PDF, eq. (5) is also delta Me=0.5*delta Mt
+ !WHERE(OTEST)
+ ! !Integration multiplied by 2
+ ! WHERE(ZKIC<0.5)
+ ! ZEPSI(:)=8.*ZKIC(:)**3/3.
+ ! ZDELTA(:)=1.-4.*ZKIC(:)**2+8.*ZKIC(:)**3/3.
+ ! ELSEWHERE
+ ! ZEPSI(:)=5./3.-4*ZKIC(:)**2+8.*ZKIC(:)**3/3.
+ ! ZDELTA(:)=8.*(1.-ZKIC(:))**3/3.
+ ! ENDWHERE
+ !ENDWHERE
+
+! 3.4 Computation of PENTR and PDETR
+ DO JLOOP=1,SIZE(OTEST)
+ IF(OTEST(JLOOP)) THEN
+ ZEPSI_CLOUD=MIN(ZDELTA,ZEPSI)
+ PENTR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZEPSI_CLOUD(JLOOP)
+ PDETR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZDELTA(JLOOP)
+ PENTR(JLOOP) = PENTR(JLOOP)+PENTR_CLD(JLOOP)
+ PDETR(JLOOP) = PDETR(JLOOP)+PDETR_CLD(JLOOP)
+ ELSE
+ PENTR_CLD(JLOOP) = 0.
+ PDETR_CLD(JLOOP) = 0.
+ ENDIF
+ ENDDO
END SUBROUTINE COMPUTE_ENTR_DETR
diff --git a/src/MNH/compute_updraft.f90 b/src/MNH/compute_updraft.f90
index 1d0e2a8212156651b67496f05863266b499b88b6..e4165877555f575709ee19b94dc96dd1e43ee46a 100644
--- a/src/MNH/compute_updraft.f90
+++ b/src/MNH/compute_updraft.f90
@@ -10,6 +10,7 @@ INTERFACE
!
! #################################################################
SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL, HFRAC_ICE, &
+ HMF_UPDRAFT, &
OENTR_DETR,OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
@@ -35,6 +36,7 @@ INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physica
INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme
LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
@@ -83,6 +85,7 @@ END INTERFACE
END MODULE MODI_COMPUTE_UPDRAFT
! ######spl
SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
+ HMF_UPDRAFT, &
OENTR_DETR,OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
@@ -129,6 +132,8 @@ END MODULE MODI_COMPUTE_UPDRAFT
!! S. Riette may 2011: ice added, interface modified
!! S. Riette Jan 2012: support for both order of vertical levels
!! V.Masson, C.Lac : 02/2011 : SV_UP initialized by a non-zero value
+!! S. Riette Apr 2013: improvement of continuity at the condensation level
+!! R.Honnert Oct 2016 : Add ZSURF and Update with AROME
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -142,6 +147,7 @@ USE MODI_TH_R_FROM_THL_RT_1D
USE MODI_SHUMAN_MF
USE MODI_COMPUTE_BL89_ML
+USE MODD_GRID_n, ONLY : XDXHAT, XDYHAT
IMPLICIT NONE
@@ -156,6 +162,7 @@ INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physica
INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme
LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
@@ -207,7 +214,9 @@ REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
ZUM_F,ZVM_F,ZRHO_F, & ! density,momentum
ZPRES_F,ZTHVM_F,ZTHVM, & ! interpolated at the flux point
ZG_O_THVREF, & ! g*ThetaV ref
- ZW_UP2 ! w**2 of the updraft
+ ZW_UP2, & ! w**2 of the updraft
+ ZBUO_INTEG_DRY, ZBUO_INTEG_CLD,&! Integrated Buoyancy
+ ZENTR_CLD,ZDETR_CLD ! wet entrainment and detrainment
REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: &
ZSVM_F ! scalar variables
@@ -225,7 +234,7 @@ REAL :: ZRDORV ! RD/RV
REAL :: ZRVORD ! RV/RD
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3_CLD,ZMIX2_CLD
REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
@@ -239,14 +248,17 @@ LOGICAL :: GLMIX
LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
-INTEGER :: ITEST
+INTEGER :: ITEST,JLOOP
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI,&
+ ZPART_DRY
REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
REAL :: ZTMAX,ZRMAX ! control value
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZSURF
+
! Thresholds for the perturbation of
! theta_l and r_t at the first level of the updraft
ZTMAX=2.0
@@ -263,7 +275,6 @@ ZDEPTH_MAX1=3000. ! clouds with depth inferior to this value are keeped untouche
ZDEPTH_MAX2=4000. ! clouds with depth superior to this value are suppressed
! Local variables, internal domain
-
!number of scalar variables
ISV=SIZE(PSVM,3)
@@ -367,7 +378,7 @@ IF (OENTR_DETR) THEN
GLMIX=.TRUE.
ZTKEM_F(:,KKB)=0.
- CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F,ZG_O_THVREF,ZTHVM_F,KKB,GLMIX,ZLUP)
+ CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB),ZTHVM,KKB,GLMIX,.FALSE.,ZLUP)
ZLUP(:)=MAX(ZLUP(:),1.E-10)
! Compute Buoyancy flux at the ground
@@ -375,8 +386,14 @@ IF (OENTR_DETR) THEN
(0.61*ZTHM_F(:,KKB))*PSFRV(:)
! Mass flux at KKB level (updraft triggered if PSFTH>0.)
+ IF (HMF_UPDRAFT=='SURF') THEN
+ ZSURF(:)=TANH(1.83*SQRT(XDXHAT(1)*XDYHAT(1))/ZLUP)
+ ELSE
+ ZSURF(:)=1.
+ END IF
WHERE (ZWTHVSURF(:)>0.)
- PEMF(:,KKB) = XCMF * ZRHO_F(:,KKB) * ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.)
+ PEMF(:,KKB) = XCMF * ZSURF(:) * ZRHO_F(:,KKB) * &
+ ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.)
PFRAC_UP(:,KKB)=MIN(PEMF(:,KKB)/(SQRT(ZW_UP2(:,KKB))*ZRHO_F(:,KKB)),XFRAC_UP_MAX)
ZW_UP2(:,KKB)=(PEMF(:,KKB)/(PFRAC_UP(:,KKB)*ZRHO_F(:,KKB)))**2
GTEST(:)=.TRUE.
@@ -400,7 +417,6 @@ GTESTLCL(:)=.FALSE.
GTESTETL(:)=.FALSE.
! Loop on vertical level
-
DO JK=KKB,KKE-KKL,KKL
! IF the updraft top is reached for all column, stop the loop on levels
@@ -418,7 +434,6 @@ DO JK=KKB,KKE-KKL,KKL
GTESTLCL(:)=.TRUE.
ENDWHERE
-
! COMPUTE PENTR and PDETR at mass level JK
IF (OENTR_DETR) THEN
IF(JK/=KKB) THEN
@@ -426,14 +441,20 @@ DO JK=KKB,KKE-KKL,KKL
ZRI_MIX(:,JK) = ZRI_MIX(:,JK-KKL) ! guess of Ri of mixture
ENDIF
CALL COMPUTE_ENTR_DETR(JK,KKB,KKE,KKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
- PPABSM(:,:),PZZ(:,:),PDZZ(:,:),ZTHVM(:,:), &
- PTHLM(:,JK),PRTM(:,JK),ZW_UP2(:,:), &
+ PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+KKL),&
+ PZZ(:,:),PDZZ(:,:),ZTHVM(:,:), &
+ PTHLM(:,:),PRTM(:,:),ZW_UP2(:,:),ZTH_UP(:,JK), &
PTHL_UP(:,JK),PRT_UP(:,JK),ZLUP(:), &
- PRC_UP(:,JK),PRI_UP(:,JK),ZRC_MIX(:,JK),ZRI_MIX(:,JK), &
- PENTR(:,JK),PDETR(:,JK),PBUO_INTEG(:,JK) )
+ PRC_UP(:,JK),PRI_UP(:,JK),PTHV_UP(:,JK),&
+ PRSAT_UP(:,JK),ZRC_MIX(:,JK),ZRI_MIX(:,JK), &
+ PENTR(:,JK),PDETR(:,JK),ZENTR_CLD(:,JK),ZDETR_CLD(:,JK),&
+ ZBUO_INTEG_DRY(:,JK), ZBUO_INTEG_CLD(:,JK), &
+ ZPART_DRY(:) )
+ PBUO_INTEG(:,JK)=ZBUO_INTEG_DRY(:,JK)+ZBUO_INTEG_CLD(:,JK)
IF (JK==KKB) THEN
PDETR(:,JK)=0.
+ ZDETR_CLD(:,JK)=0.
ENDIF
! Computation of updraft characteristics at level JK+KKL
@@ -457,15 +478,24 @@ DO JK=KKB,KKE-KKL,KKL
! If the updraft did not stop, compute cons updraft characteritics at jk+KKL
- WHERE(GTEST)
- ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK) !&
- ZMIX3(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PDETR(:,JK) !&
+! WHERE(GTEST)
+ DO JLOOP=1,SIZE(GTEST)
+ IF (GTEST(JLOOP) ) THEN
+ ZMIX2(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*PENTR(JLOOP,JK) !&
+ ZMIX3_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZDETR_CLD(JLOOP,JK) !&
+ ZMIX2_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZENTR_CLD(JLOOP,JK)
- PTHL_UP(:,JK+KKL)=(PTHL_UP(:,JK)*(1.-0.5*ZMIX2(:)) + PTHLM(:,JK)*ZMIX2(:)) &
- /(1.+0.5*ZMIX2(:))
- PRT_UP(:,JK+KKL) =(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) &
- /(1.+0.5*ZMIX2(:))
- ENDWHERE
+ !PTHL_UP(JLOOP,JK+KKL)=(PTHL_UP(JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*ZMIX2(JLOOP)) &
+ ! /(1.+0.5*ZMIX2(JLOOP))
+ !PRT_UP(JLOOP,JK+KKL) =(PRT_UP (JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*ZMIX2(JLOOP)) &
+ ! /(1.+0.5*ZMIX2(JLOOP))
+
+ PTHL_UP(JLOOP,JK+KKL)=PTHL_UP(JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP)))
+ PRT_UP(JLOOP,JK+KKL) =PRT_UP (JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP)))
+
+ END IF
+ END DO
+! ENDWHERE
IF(OMIXUV) THEN
@@ -522,20 +552,15 @@ DO JK=KKB,KKE-KKL,KKL
! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL
WHERE(GTEST)
- PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
- WHERE (.NOT.(GTESTLCL))
- WHERE (PBUO_INTEG(:,JK)>0.)
- ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*(XABUO-XBENTR*XENTR_DRY)* PBUO_INTEG(:,JK)
- ENDWHERE
- WHERE (PBUO_INTEG(:,JK)<=0.)
- ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*XABUO* PBUO_INTEG(:,JK)
- ENDWHERE
- ENDWHERE
- WHERE (GTESTLCL)
- ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK)*(1.-(XBDETR*ZMIX3(:)+XBENTR*ZMIX2(:)))&
- /(1.+(XBDETR*ZMIX3(:)+XBENTR*ZMIX2(:))) &
- +2.*(XABUO)*PBUO_INTEG(:,JK)/(1.+(XBDETR*ZMIX3(:)+XBENTR*ZMIX2(:)))
- ENDWHERE
+ PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
+ WHERE (ZBUO_INTEG_DRY(:,JK)>0.)
+ ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*(XABUO-XBENTR*XENTR_DRY)* ZBUO_INTEG_DRY(:,JK)
+ ELSEWHERE
+ ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*XABUO* ZBUO_INTEG_DRY(:,JK)
+ ENDWHERE
+ ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK+KKL)*(1.-(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:)))&
+ /(1.+(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:))) &
+ +2.*(XABUO)*ZBUO_INTEG_CLD(:,JK)/(1.+(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:)))
ENDWHERE
@@ -602,10 +627,13 @@ IF(OENTR_DETR) THEN
PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
END DO
+ GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
+ GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=MAX(KKU,KKA) )
+ ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=SIZE(ZCOEF,2))
+ ZCOEF=MIN(MAX(ZCOEF,0.),1.)
+ WHERE (GWORK2)
+ PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:)
+ PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
+ ENDWHERE
ENDIF
-
-GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
-GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=MAX(KKU,KKA) )
-ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=SIZE(ZCOEF,2))
-
END SUBROUTINE COMPUTE_UPDRAFT
diff --git a/src/MNH/compute_updraft_hrio.f90 b/src/MNH/compute_updraft_hrio.f90
index 9fa0ad5f039a8ab055823404dabc2fc489446f40..3466441418fdbdd0b983c56abc4b5e807aba9549 100644
--- a/src/MNH/compute_updraft_hrio.f90
+++ b/src/MNH/compute_updraft_hrio.f90
@@ -390,6 +390,9 @@ PSV_DO(:,:,:)=0.
PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+!------------------------
+print*,OENTR_DETR
+!------------------------
IF (OENTR_DETR) THEN
ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:))
ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:))
@@ -444,7 +447,8 @@ IF (OENTR_DETR) THEN
GLMIX=.TRUE.
ZTKEM_F(:,KKB)=0.
- CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F,ZG_O_THVREF,ZTHVM_F,KKB,GLMIX,ZLUP)
+ CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB), &
+ ZTHVM_F,KKB,GLMIX,.TRUE.,ZLUP)
ZLUP(:)=MAX(ZLUP(:),1.E-10)
! Compute Buoyancy flux at the ground
@@ -845,5 +849,6 @@ ENDDO ! boucle JK
GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=MAX(KKU,KKA) )
ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=SIZE(ZCOEF,2))
+print*,"je sors de compute_updraft"
END SUBROUTINE COMPUTE_UPDRAFT_HRIO
diff --git a/src/MNH/compute_updraft_raha.f90 b/src/MNH/compute_updraft_raha.f90
new file mode 100644
index 0000000000000000000000000000000000000000..553a95de070f4bf91ba31074ea9cf92194c643a4
--- /dev/null
+++ b/src/MNH/compute_updraft_raha.f90
@@ -0,0 +1,666 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+! ######spl
+ MODULE MODI_COMPUTE_UPDRAFT_RAHA
+! ###########################
+!
+INTERFACE
+!
+! #################################################################
+ SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
+ OENTR_DETR,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV, &
+ PPABSM,PRHODREF,PUM,PVM, PTKEM, &
+ PEXNM,PTHM,PRVM,PTHLM,PRTM, &
+ PSVM,PTHL_UP,PRT_UP, &
+ PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
+ PW_UP,PU_UP, PV_UP, PSV_UP, &
+ PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
+ PEMF,PDETR,PENTR, &
+ PBUO_INTEG,KKLCL,KKETL,KKCTL, &
+ PDEPTH )
+! #################################################################
+!
+!* 1.1 Declaration of Arguments
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+
+REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+! normal surface fluxes of theta,rv,(u,v) parallel to the orography
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv
+REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
+REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+
+REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+ ! detrainment,entrainment
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+
+
+END SUBROUTINE COMPUTE_UPDRAFT_RAHA
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_UPDRAFT_RAHA
+!
+! ######spl
+ SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
+ OENTR_DETR,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV, &
+ PPABSM,PRHODREF,PUM,PVM, PTKEM, &
+ PEXNM,PTHM,PRVM,PTHLM,PRTM, &
+ PSVM,PTHL_UP,PRT_UP, &
+ PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
+ PW_UP,PU_UP, PV_UP, PSV_UP, &
+ PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
+ PEMF,PDETR,PENTR, &
+ PBUO_INTEG,KKLCL,KKETL,KKCTL, &
+ PDEPTH )
+
+! #################################################################
+!!
+!!**** *COMPUTE_UPDRAF_RAHA* - calculates caracteristics of the updraft
+!!
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to build the updraft following Rio et al (2010)
+!! Same as compute_updraft_rhcj10 exept the use of Hourdin et al closure
+!!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! !! REFERENCE
+!! ---------
+!! Rio et al (2010) (Boundary Layer Meteorol 135:469-483)
+!! Hourdin et al (xxxx)
+!!
+!! AUTHOR
+!! ------
+!! Y. Bouteloup (2012)
+!! R. Honnert Janv 2013 ==> corection of some coding bugs
+!! Y. Bouteloup Janv 2014 ==> Allow the use of loops in the both direction
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+
+USE MODD_CST
+USE MODD_PARAM_MFSHALL_n
+
+USE MODI_TH_R_FROM_THL_RT_1D
+USE MODI_SHUMAN_MF
+
+IMPLICIT NONE
+
+!* 1.1 Declaration of Arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KKA ! near ground array index
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+
+REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+! normal surface fluxes of theta,rv,(u,v) parallel to the orography
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv
+REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
+REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+
+REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+ ! detrainment,entrainment
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+! 1.2 Declaration of local variables
+!
+!
+! Mean environment variables at t-dt at flux point
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F,ZRCM_F ! Theta,rv of
+ ! updraft environnement
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F,ZTHVM ! interpolated at the flux point
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF ! g*ThetaV ref
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP2 ! w**2 of the updraft
+
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: ZSVM_F ! scalar variables
+
+
+
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTH_UP ! updraft THETA
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZT_UP ! updraft T
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZLVOCPEXN ! updraft L
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZCP ! updraft cp
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHS_UP,ZTHSM
+
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
+
+REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav'
+
+REAL :: ZRDORV ! RD/RV
+REAL :: ZRVORD ! RV/RD
+
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH ! Deepness limit for cloud
+
+INTEGER :: ISV ! Number of scalar variables
+INTEGER :: IKU,IIJU ! array size in k
+INTEGER :: JK,JI,JJ,JSV ! loop counters
+
+LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL
+ ! Test if the ascent continue, if LCL or ETL is reached
+LOGICAL :: GLMIX
+ ! To choose upward or downward mixing length
+LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
+LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
+
+
+INTEGER :: ITEST
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZWP2, ZRSATW, ZRSATI
+
+LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST_FER
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZPHI,ZALIM_STAR_TOT
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZDTHETASDZ,ZALIM_STAR,ZZDZ,ZZZ
+INTEGER, DIMENSION(SIZE(PTHM,1)) :: IALIM
+
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZTEST,ZDZ,ZWUP_MEAN !
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft
+REAL, DIMENSION(SIZE(PTHM,1)) :: ZA,ZB,ZQTM,ZQT_UP
+
+REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
+
+REAL :: ZTMAX,ZRMAX, ZEPS ! control value
+
+
+! Thresholds for the perturbation of
+! theta_l and r_t at the first level of the updraft
+
+ZTMAX=2.0
+ZRMAX=1.E-3
+ZEPS=1.E-15
+!------------------------------------------------------------------------
+! INITIALISATION
+
+! Initialisation of the constants
+ZRDORV = XRD / XRV !=0.622
+ZRVORD = (XRV / XRD)
+
+ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouched
+ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed
+
+! Local variables, internal domain
+! Internal Domain
+
+IKU=SIZE(PTHM,2)
+IIJU =SIZE(PTHM,1)
+!number of scalar variables
+ISV=SIZE(PSVM,3)
+
+! Initialisation of intersesting Level :LCL,ETL,CTL
+KKLCL(:)=KKE
+KKETL(:)=KKE
+KKCTL(:)=KKE
+
+!
+! Initialisation
+!* udraft governing variables
+PEMF(:,:)=0.
+PDETR(:,:)=0.
+PENTR(:,:)=0.
+
+! Initialisation
+!* updraft core variables
+PRV_UP(:,:)=0.
+PRC_UP(:,:)=0.
+
+PW_UP(:,:)=0.
+ZTH_UP(:,:)=0.
+PFRAC_UP(:,:)=0.
+PTHV_UP(:,:)=0.
+
+PBUO_INTEG=0.
+ZBUO =0.
+
+!no ice cloud coded yet
+PRI_UP(:,:)=0.
+PFRAC_ICE_UP(:,:)=0.
+PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
+
+! Initialisation of environment variables at t-dt
+
+! variables at flux level
+ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:))
+ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:))
+ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:))
+ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:))
+ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:))
+
+!DO JSV=1,ISV
+! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+! ZSVM_F(:,KKB:IKU,JSV) = 0.5*(PSVM(:,KKB:IKU,JSV)+PSVM(:,1:IKU-1,JSV))
+! ZSVM_F(:,1,JSV) = ZSVM_F(:,KKB,JSV)
+!END DO
+
+! Initialisation of updraft characteristics
+PTHL_UP(:,:)=ZTHLM_F(:,:)
+PRT_UP(:,:)=ZRTM_F(:,:)
+PU_UP(:,:)=ZUM_F(:,:)
+PV_UP(:,:)=ZVM_F(:,:)
+PSV_UP(:,:,:)=0.
+!IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then
+! PSV_UP(:,:,:)=ZSVM_F(:,:,:)
+!ENDIF
+
+! Computation or initialisation of updraft characteristics at the KKB level
+! thetal_up,rt_up,thetaV_up, w�,Buoyancy term and mass flux (PEMF)
+
+PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+
+ZQT_UP(:) = PRT_UP(:,KKB)/(1.+PRT_UP(:,KKB))
+ZTHS_UP(:,KKB)=PTHL_UP(:,KKB)*(1.+XLAMBDA*ZQT_UP(:))
+
+ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:))
+ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:))
+ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:))
+ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:))
+
+! thetav at mass and flux levels
+ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
+ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
+
+PTHV_UP(:,:)= ZTHVM_F(:,:)
+PRV_UP (:,:)= ZRVM_F (:,:)
+
+ZW_UP2(:,:)=ZEPS
+ZW_UP2(:,KKB) = MAX(0.0001,(1./6.)*ZTKEM_F(:,KKB))
+GTEST = (ZW_UP2(:,KKB) > ZEPS)
+
+! Computation of non conservative variable for the KKB level of the updraft
+! (all or nothing ajustement)
+PRC_UP(:,KKB)=0.
+PRI_UP(:,KKB)=0.
+
+CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
+ PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
+ PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
+
+! compute updraft thevav and buoyancy term at KKB level
+PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
+! compute mean rsat in updraft
+PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB)
+
+!Tout est commente pour tester dans un premier temps la s�paration en deux de la
+! boucle verticale, une pour w et une pour PEMF
+
+ZG_O_THVREF=XG/ZTHVM_F
+
+
+! Definition de l'alimentation au sens de la fermeture de Hourdin et al
+
+ZALIM_STAR(:,:) = 0.
+ZALIM_STAR_TOT(:) = 0. ! <== Normalization of ZALIM_STAR
+IALIM(:) = KKB ! <== Top level of the alimentation layer
+
+DO JK=KKB,KKE-KKL,KKL ! Vertical loop
+ ZZDZ(:,JK) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) ! <== Delta Z between two flux level
+ ZZZ(:,JK) = MAX(0.,0.5*(PZZ(:,JK+KKL)+PZZ(:,JK)) ) ! <== Hight of mass levels
+ ZDTHETASDZ(:,JK) = (ZTHVM_F(:,JK)-ZTHVM_F(:,JK+KKL)) ! <== Delta theta_v
+
+ WHERE ((ZTHVM_F(:,JK+KKL)<ZTHVM_F(:,JK)) .AND. (ZTHVM_F(:,KKB)>=ZTHVM_F(:,JK)))
+ ZALIM_STAR(:,JK) = SQRT(ZZZ(:,JK))*ZDTHETASDZ(:,JK)/ZZDZ(:,JK)
+ ZALIM_STAR_TOT(:) = ZALIM_STAR_TOT(:)+ZALIM_STAR(:,JK)*ZZDZ(:,JK)
+ IALIM(:) = JK
+ ENDWHERE
+ENDDO
+
+! Normalization of ZALIM_STAR
+DO JK=KKB,KKE-KKL,KKL ! Vertical loop
+ WHERE (ZALIM_STAR_TOT > ZEPS)
+ ZALIM_STAR(:,JK) = ZALIM_STAR(:,JK)/ZALIM_STAR_TOT(:)
+ ENDWHERE
+ENDDO
+ZALIM_STAR_TOT(:) = 0.
+
+
+! --------- END of alimentation calculation ---------------------------------------
+
+
+!--------------------------------------------------------------------------
+
+! 3. Vertical ascending loop
+! -----------------------
+!
+! If GTEST = T the updraft starts from the KKB level and stops when GTEST becomes F
+!
+!
+GTESTLCL(:)=.FALSE.
+GTESTETL(:)=.FALSE.
+
+! Loop on vertical level to compute W
+
+ZW_MAX(:) = 0.
+ZZTOP(:) = 0.
+ZPHI(:) = 0.
+
+
+DO JK=KKB,KKE-KKL,KKL
+
+! IF the updraft top is reached for all column, stop the loop on levels
+
+! ITEST=COUNT(GTEST)
+! IF (ITEST==0) CYCLE
+
+! Computation of entrainment and detrainment with KF90
+! parameterization in clouds and LR01 in subcloud layer
+
+
+! to find the LCL (check if JK is LCL or not)
+
+ WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
+ KKLCL(:) = JK
+ GTESTLCL(:)=.TRUE.
+ ENDWHERE
+
+
+! COMPUTE PENTR and PDETR at mass level JK
+
+
+! Buoyancy is computed on "flux" levels where updraft variables are known
+
+ ! Compute theta_v of updraft at flux level JK
+
+ ZRC_UP(:) = PRC_UP(:,JK)
+ ZRI_UP(:) = PRI_UP(:,JK) ! guess
+ ZRV_UP(:) = PRV_UP(:,JK)
+ ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) - ZTHVM_F(:,JK))
+ PBUO_INTEG(:,JK) = ZBUO(:,JK)*(PZZ(:,JK+KKL)-PZZ(:,JK))
+
+ ZDZ(:) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK))
+ ZTEST(:) = XA1*ZBUO(:,JK) - XB*ZW_UP2(:,JK)
+
+ ZCOE(:) = ZDZ(:)
+ WHERE (ZTEST(:)>0.)
+ ZCOE(:) = ZDZ(:)/(1.+ XBETA1)
+ ENDWHERE
+
+! Calcul de la vitesse
+
+ ZWCOE(:) = (1.-XB*ZCOE(:))/(1.+XB*ZCOE(:))
+ ZBUCOE(:) = 2.*ZCOE(:)/(1.+XB*ZCOE(:))
+
+ ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + XA1*ZBUO(:,JK)*ZBUCOE(:) )
+ ZW_MAX(:) = MAX(ZW_MAX(:), SQRT(ZW_UP2(:,JK+KKL)))
+ ZWUP_MEAN(:) = MAX(ZEPS,0.5*(ZW_UP2(:,JK+KKL)+ZW_UP2(:,JK)))
+
+! Entrainement et detrainement
+
+ PENTR(:,JK) = MAX(0.,(XBETA1/(1.+XBETA1))*(XA1*ZBUO(:,JK)/ZWUP_MEAN(:)-XB))
+
+ ZDETR_BUO(:) = MAX(0., -(XBETA1/(1.+XBETA1))*XA1*ZBUO(:,JK)/ZWUP_MEAN(:))
+ ZDETR_RT(:) = XC*SQRT(MAX(0.,(PRT_UP(:,JK) - ZRTM_F(:,JK))) / MAX(ZEPS,ZRTM_F(:,JK)) / ZWUP_MEAN(:))
+ PDETR(:,JK) = ZDETR_RT(:)+ZDETR_BUO(:)
+
+
+! If the updraft did not stop, compute cons updraft characteritics at jk+1
+ WHERE(GTEST)
+ ZZTOP(:) = MAX(ZZTOP(:),PZZ(:,JK+KKL))
+ ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK) !&
+ ZMIX3(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PDETR(:,JK) !&
+
+ ZQTM(:) = PRTM(:,JK)/(1.+PRTM(:,JK))
+ ZTHSM(:,JK) = PTHLM(:,JK)*(1.+XLAMBDA*ZQTM(:))
+ ZTHS_UP(:,JK+KKL)=(ZTHS_UP(:,JK)*(1.-0.5*ZMIX2(:)) + ZTHSM(:,JK)*ZMIX2(:)) &
+ /(1.+0.5*ZMIX2(:))
+ PRT_UP(:,JK+KKL)=(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) &
+ /(1.+0.5*ZMIX2(:))
+ ZQT_UP(:) = PRT_UP(:,JK+KKL)/(1.+PRT_UP(:,JK+KKL))
+ PTHL_UP(:,JK+KKL)=ZTHS_UP(:,JK+KKL)/(1.+XLAMBDA*ZQT_UP(:))
+ ENDWHERE
+
+
+ IF(OMIXUV) THEN
+ IF(JK/=KKB) THEN
+ WHERE(GTEST)
+ PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+&
+ (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) &
+ /(1+0.5*ZMIX2(:))
+ PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+&
+ (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) &
+ /(1+0.5*ZMIX2(:))
+ ENDWHERE
+ ELSE
+ WHERE(GTEST)
+ PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)) ) &
+ /(1+0.5*ZMIX2(:))
+ PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
+ 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
+ ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)) ) &
+ /(1+0.5*ZMIX2(:))
+ ENDWHERE
+
+ ENDIF
+ ENDIF
+! DO JSV=1,ISV
+! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+! WHERE(GTEST)
+! PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
+! PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
+! ENDWHERE
+! ENDDO
+
+
+! Compute non cons. var. at level JK+KKL
+ ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
+ ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
+ ZRV_UP(:)=PRV_UP(:,JK)
+ CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
+ PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
+ WHERE(GTEST)
+ ZT_UP(:) = ZTH_UP(:,JK+KKL)*PEXNM(:,JK+KKL)
+ ZCP(:) = XCPD + XCL * ZRC_UP(:)
+ ZLVOCPEXN(:)=(XLVTT + (XCPV-XCL) * (ZT_UP(:)-XTT) ) / ZCP(:) / PEXNM(:,JK+KKL)
+ PRC_UP(:,JK+KKL)=MIN(0.5E-3,ZRC_UP(:)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !)
+ PTHL_UP(:,JK+KKL) = PTHL_UP(:,JK+KKL)+ZLVOCPEXN(:)*(ZRC_UP(:)-PRC_UP(:,JK+KKL))
+ PRV_UP(:,JK+KKL)=ZRV_UP(:)
+ PRI_UP(:,JK+KKL)=ZRI_UP(:)
+ PRT_UP(:,JK+KKL) = PRC_UP(:,JK+KKL) + PRV_UP(:,JK+KKL)
+ PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL)
+ ENDWHERE
+
+
+! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
+ WHERE(GTEST)
+! PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
+ PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*(1.+0.608*PRV_UP(:,JK+KKL) - PRC_UP(:,JK+KKL))
+ ENDWHERE
+
+
+! Test if the updraft has reach the ETL
+ GTESTETL(:)=.FALSE.
+ WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.))
+ KKETL(:) = JK+KKL
+ GTESTETL(:)=.TRUE.
+ ENDWHERE
+
+! Test is we have reached the top of the updraft
+
+ WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=ZEPS)))
+ ZW_UP2(:,JK+KKL)=ZEPS
+ GTEST(:)=.FALSE.
+ PTHL_UP(:,JK+KKL)=ZTHLM_F(:,JK+KKL)
+ PRT_UP(:,JK+KKL)=ZRTM_F(:,JK+KKL)
+ PRC_UP(:,JK+KKL)=0.
+ PRI_UP(:,JK+KKL)=0.
+ PRV_UP(:,JK+KKL)=0.
+ PTHV_UP(:,JK+KKL)=ZTHVM_F(:,JK+KKL)
+ PFRAC_UP(:,JK+KKL)=0.
+ KKCTL(:)=JK+KKL
+ ENDWHERE
+
+ENDDO
+
+! Closure assumption for mass flux at KKB+1 level (Mass flux is supposed to be 0 at KKB level !)
+! Hourdin et al 2002 formulation
+
+
+ZZTOP(:) = MAX(ZZTOP(:),ZEPS)
+
+DO JK=KKB+KKL,KKE-KKL,KKL ! Vertical loop
+ WHERE(JK<=IALIM)
+ ZALIM_STAR_TOT(:) = ZALIM_STAR_TOT(:) + ZALIM_STAR(:,JK)*ZALIM_STAR(:,JK)*ZZDZ(:,JK)/PRHODREF(:,JK)
+ ENDWHERE
+ENDDO
+
+WHERE (ZALIM_STAR_TOT*ZZTOP > ZEPS)
+ ZPHI(:) = ZW_MAX(:)/(XR*ZZTOP(:)*ZALIM_STAR_TOT(:))
+ENDWHERE
+
+GTEST(:) = .TRUE.
+PEMF(:,KKB+KKL) = ZPHI(:)*ZZDZ(:,KKB)*ZALIM_STAR(:,KKB)
+! Updraft fraction must be smaller than XFRAC_UP_MAX
+PFRAC_UP(:,KKB+KKL)=PEMF(:,KKB+KKL)/(SQRT(ZW_UP2(:,KKB+KKL))*ZRHO_F(:,KKB+KKL))
+PFRAC_UP(:,KKB+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,KKB+KKL))
+PEMF(:,KKB+KKL) = ZRHO_F(:,KKB+KKL)*PFRAC_UP(:,KKB+KKL)*SQRT(ZW_UP2(:,KKB+KKL))
+
+DO JK=KKB+KKL,KKE-KKL,KKL ! Vertical loop
+
+ GTEST = (ZW_UP2(:,JK) > ZEPS)
+
+ WHERE (GTEST)
+ WHERE(JK<IALIM)
+ PEMF(:,JK+KKL) = MAX(0.,PEMF(:,JK) + ZPHI(:)*ZZDZ(:,JK)*(PENTR(:,JK) - PDETR(:,JK)))
+ ELSEWHERE
+ ZMIX1(:)=ZZDZ(:,JK)*(PENTR(:,JK)-PDETR(:,JK))
+ PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(ZMIX1(:))
+ ENDWHERE
+
+! Updraft fraction must be smaller than XFRAC_UP_MAX
+ PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL))
+ PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL))
+ PEMF(:,JK+KKL) = ZRHO_F(:,JK+KKL)*PFRAC_UP(:,JK+KKL)*SQRT(ZW_UP2(:,JK+KKL))
+ ENDWHERE
+
+ENDDO
+
+PW_UP(:,:)=SQRT(ZW_UP2(:,:))
+PEMF(:,KKB) =0.
+
+! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
+! To do this, mass flux is multiplied by a coefficient decreasing linearly
+! from 1 (for clouds of 3000m of depth) to 0 (for clouds of 4000m of depth).
+! This way, all MF fluxes are diminished by this amount.
+! Diagnosed cloud fraction is also multiplied by the same coefficient.
+!
+DO JI=1,SIZE(PTHM,1)
+ PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
+END DO
+
+GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
+GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU )
+ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU)
+ZCOEF=MIN(MAX(ZCOEF,0.),1.)
+WHERE (GWORK2)
+ PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:)
+ PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
+ENDWHERE
+
+
+END SUBROUTINE COMPUTE_UPDRAFT_RAHA
diff --git a/src/MNH/compute_updraft_rhcj10.f90 b/src/MNH/compute_updraft_rhcj10.f90
index 8b3f6a5e27d3da10f4fa4e7e65b10173611937a5..f062dcf0ad9d0d6738b16c9fcf1364bb6d2165e1 100644
--- a/src/MNH/compute_updraft_rhcj10.f90
+++ b/src/MNH/compute_updraft_rhcj10.f90
@@ -390,8 +390,8 @@ ENDDO
GLMIX=.TRUE.
ZTKEM_F(:,KKB)=0.
-
-CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F,ZG_O_THVREF,ZTHVM_F,KKB,GLMIX,ZLUP)
+CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB), &
+ ZTHVM_F,KKB,GLMIX,.TRUE.,ZLUP)
ZLUP(:)=MAX(ZLUP(:),1.E-10)
! Compute Buoyancy flux at the ground
diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90
index 2402aaf01ccda4bc877c938d378e4471583271ca..ebae4a9b53232850e7d5a41b0b7bd945a43f14bb 100644
--- a/src/MNH/deallocate_model1.f90
+++ b/src/MNH/deallocate_model1.f90
@@ -106,6 +106,7 @@ USE MODD_RELFRC_n
USE MODD_ADV_n
USE MODD_PAST_FIELD_n
USE MODD_TURB_n
+USE MODD_PARAM_C2R2, ONLY :LSUPSAT
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -198,7 +199,7 @@ IF ( KCALL == 1 ) THEN
DEALLOCATE(XRSVS_CLD)
END IF
!
-IF (CCLOUD == 'KHKO') THEN
+IF ((CCLOUD == 'KHKO') .AND. LSUPSAT) THEN
DEALLOCATE(XSUPSAT)
DEALLOCATE(XNACT)
DEALLOCATE(XNPRO)
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index c0902952d76fa77670a6e2c4dde16d7672ae21de..bf399091068ef01b9ac1d428084450b0192ef91d 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -219,6 +219,7 @@ END MODULE MODI_DEFAULT_DESFM_n
!! 10/2016 (C.Lac) Add droplet deposition
!! 10/2016 (R.Honnert and S.Riette) : Improvement of EDKF and adaptation to the grey zone
!! 10/2016 (F Brosse) add prod/loss terms computation for chemistry
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -274,7 +275,8 @@ USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS,&
CTYPE_CCN=>HTYPE_CCN, YFSOLUB_CCN=>XFSOLUB_CCN, &
YACTEMP_CCN=>XACTEMP_CCN, YAERDIFF=>XAERDIFF, &
YAERHEIGHT=>XAERHEIGHT, &
- LSCAV, LAERO_MASS, NPHILLIPS
+ LSCAV, LAERO_MASS, NPHILLIPS, &
+ ODEPOC=>LDEPOC, OVDEPOC=>XVDEPOC
!
USE MODD_LATZ_EDFLX
USE MODD_2D_FRC
@@ -477,7 +479,7 @@ NLBLY(:) = 1
XCPHASE = 20.
XCPHASE_PBL = 0.
XCARPKMAX = XUNDEF
-XPOND = 1.0
+XPOND = 0.2
!
!-------------------------------------------------------------------------------
!
@@ -974,6 +976,7 @@ IF (KMI == 1) THEN
LGEOST_UV_FRC = .FALSE.
LGEOST_TH_FRC = .FALSE.
LTEND_THRV_FRC = .FALSE.
+ LTEND_UV_FRC = .FALSE.
LVERT_MOTION_FRC = .FALSE.
LRELAX_THRV_FRC = .FALSE.
LRELAX_UV_FRC = .FALSE.
@@ -1052,7 +1055,9 @@ XSIGMA_MF = 20.
XA1 = 2./3.
XB = 0.002
XC = 0.012
-XBETA1 = 0.9
+XBETA1 = 0.9
+XR = 2.
+XLAMBDA= 0.
!
!-------------------------------------------------------------------------------
!
@@ -1107,7 +1112,10 @@ IF (KMI == 1) THEN
ORAIN = .TRUE.
OSEDC = .FALSE.
OACTIT = .FALSE.
+ ODEPOC = .FALSE.
LBOUND = .FALSE.
+!
+ OVDEPOC = 0.02 ! 2 cm/s
!
CINI_CCN = 'AER'
CTYPE_CCN(:) = 'M'
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index ee4d8c32b3b31323c2768208a418135850164380..81ce1104a4e0861c6b079985900ded879c2912e4 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -79,7 +79,7 @@
!! 09/2016 (JP Pinty) Add LIMA
!! 10/2016 (C.LAC) add LVISI
!! 10/2016 (F Brosse) Add prod/loss terms computation for chemistry
-!!
+!! 10/2017 (G.Delautier) New boundary layer height : replace LBLTOP by CBLTOP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -194,10 +194,13 @@ CHARACTER (LEN=9) :: YNAM ! name of the namelist file
INTEGER :: JF =0 ! loop index
LOGICAL :: GFOUND ! Return code when searching namelist
LOGICAL, DIMENSION(:,:),ALLOCATABLE :: GMASKkids ! kids domains mask
+LOGICAL:: GCLOUD_ONLY ! conditionnal radiation computations for
+ ! the only cloudy columns
!
INTEGER :: IIU, IJU, IKU
INTEGER :: IINFO_ll ! return code for _ll routines
REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA,ZTOWN
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE :: ZWETDEPAER
!
TYPE(TFILEDATA),POINTER :: TZDIACFILE
!
@@ -209,7 +212,7 @@ NAMELIST/NAM_DIAG/ CISO, LVAR_RS, LVAR_LS, &
LVORT, LDIV, LMEAN_POVO, XMEAN_POVO, &
LGEO, LAGEO, LWIND_ZM, LMSLP, LTHW, &
LCLD_COV, LVAR_PR, LTOTAL_PR, LMEAN_PR, XMEAN_PR, &
- NCAPE, LBV_FR, LRADAR, LBLTOP, LTRAJ, &
+ NCAPE, LBV_FR, LRADAR, CBLTOP, LTRAJ, &
LDIAG,XDIAG,LCHEMDIAG,LCHAQDIAG,XCHEMLAT,XCHEMLON,&
CSPEC_BU_DIAG,CSPEC_DIAG,LAIRCRAFT_BALLOON,NTIME_AIRCRAFT_BALLOON,&
XSTEP_AIRCRAFT_BALLOON,&
@@ -285,7 +288,7 @@ XMEAN_PR(1:2)=1.
NCAPE=-1
LBV_FR=.FALSE.
LRADAR=.FALSE.
-LBLTOP=.FALSE.
+CBLTOP='NONE'
LVISI=.FALSE.
LVAR_FRC=.FALSE.
LCHEMDIAG=.FALSE.
@@ -467,6 +470,7 @@ IKU=NKMAX+2*JPVEXT
!* allocation of variables used
!
ALLOCATE(GMASKkids (IIU,IJU))
+ALLOCATE(ZWETDEPAER (IIU,IJU,IKU,NSV_AER))
GMASKkids(:,:)=.FALSE.
!
CALL INI_DIAG_IN_RUN(IIU,IJU,IKU,LFLYER,LSTATION,LPROFILER)
@@ -674,8 +678,12 @@ XTIME_LES_BU_PROCESS=0.
XTIME_BU_PROCESS=0.
CALL PHYS_PARAM_n(1,TINIFILE,GCLOSE_OUT, &
ZRAD,ZSHADOWS,ZDCONV,ZGROUND,ZMAFL,ZDRAG, &
- ZTURB,ZTRACER, ZCHEM,ZTIME_BU,GMASKkids)
+ ZTURB,ZTRACER, ZTIME_BU,ZWETDEPAER,GMASKkids,GCLOUD_ONLY)
WRITE(ILUOUT0,*) 'DIAG AFTER PHYS_PARAM1'
+IF (LCHEMDIAG) THEN
+ CALL CH_MONITOR_n(ZWETDEPAER,1,XTSTEP, ILUOUT0, NVERB)
+END IF
+
!
!* restores the initial flags
!
@@ -732,6 +740,7 @@ ZTIME1=ZTIME2
!* 9.0 Closes the FM files
!
DEALLOCATE(GMASKkids)
+DEALLOCATE(ZWETDEPAER)
IF (GCLOSE_OUT) THEN
GCLOSE_OUT=.FALSE.
CALL IO_FILE_CLOSE_ll(TINIFILE)
diff --git a/src/MNH/drag_veg.f90 b/src/MNH/drag_veg.f90
index f6b63b7070fc632b29231af7a5ee7754a5c6684e..d525e5b817ef7aa25a9e8f44ef062fa928a133c0 100644
--- a/src/MNH/drag_veg.f90
+++ b/src/MNH/drag_veg.f90
@@ -72,6 +72,7 @@ SUBROUTINE DRAG_VEG(PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
!! C.Lac 07/2011 : Add budgets
!! S. Donier 06/2015 : bug surface aerosols
!! C.Lac 07/2016 : Add droplet deposition
+!! C.Lac 10/2017 : Correction on deposition
!!---------------------------------------------------------------
!
!
@@ -139,6 +140,7 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: &
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZT,ZEXN,ZLV,ZCPH
LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) &
:: GDEP
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZWDEPR,ZWDEPS
!
!
@@ -239,15 +241,31 @@ IF (ODEPOTREE) THEN
ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+ ZWDEPR(:,:,:)= 0.
+ ZWDEPS(:,:,:)= 0.
WHERE (GDEP)
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - PVDEPOTREE * PRT(:,:,:,2) * PRHODJ(:,:,:)
+ ZWDEPR(:,:,:)= PVDEPOTREE * PRT(:,:,:,2) * PRHODJ(:,:,:)
END WHERE
- IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO')) THEN
+ IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO') .OR. (HCLOUD=='LIMA')) THEN
WHERE (GDEP)
- PSVS(:,:,:,NSV_C2R2BEG+1) = PSVS(:,:,:,NSV_C2R2BEG+1)- PVDEPOTREE * &
- PSVT(:,:,:,NSV_C2R2BEG+1) * PRHODJ(:,:,:)
+ ZWDEPS(:,:,:)= PVDEPOTREE * PSVT(:,:,:,NSV_C2R2BEG+1) * PRHODJ(:,:,:)
END WHERE
END IF
+ DO JJ=2,(IJU-1)
+ DO JI=2,(IIU-1)
+ DO JK=2,(IKU-2)
+ IF (GDEP(JI,JJ,JK)) THEN
+ PRRS(JI,JJ,JK,2) = PRRS(JI,JJ,JK,2) + (ZWDEPR(JI,JJ,JK+1)-ZWDEPR(JI,JJ,JK))/ &
+ (PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO').OR. (HCLOUD=='LIMA')) THEN
+ PSVS(JI,JJ,JK,NSV_C2R2BEG+1) = PSVS(JI,JJ,JK,NSV_C2R2BEG+1) + &
+ (ZWDEPS(JI,JJ,JK+1)-ZWDEPS(JI,JJ,JK))/(PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ END IF
+ END IF
+ END DO
+ END DO
+ END DO
+!
!
END IF
!
diff --git a/src/MNH/ecmwf_radiation_vers2.f90 b/src/MNH/ecmwf_radiation_vers2.f90
index 76c7a122e4da04fc9a1c24aad720c55235a7f4c3..e4e1c409db7828875f296b9cc3ff5d7b14c38686 100644
--- a/src/MNH/ecmwf_radiation_vers2.f90
+++ b/src/MNH/ecmwf_radiation_vers2.f90
@@ -737,9 +737,10 @@ DO JK = 1 , KLEV
IF (ZRADLP(JL)>1) then
ZTOL =ZFLWP(JL)*(XSWSAVIA(JSW)+(XSWSAVIB(JSW)/ZRADLP(JL)))/ZRADLP(JL)
ZGL = RYFWCF(JSW)
+ ZOL = 1. - RASWCC(JSW)-RASWCD(JSW)*ZRADLP(JL)
+! Test for Sc and fog but not to generalize :
! M.Mazoyer, O.Thouron effective radius does not exceed 100 microns
-! ZOL = 1. - RASWCC(JSW)-RASWCD(JSW)*ZRADLP(JL)
- ZOL = 1. - RASWCC(JSW)-RASWCD(JSW)*MIN(ZRADLP(JL),100.0)
+! ZOL = 1. - RASWCC(JSW)-RASWCD(JSW)*MIN(ZRADLP(JL),100.0)
ENDIF
ELSE IF (ZRADLP(JL)>1.) THEN
write(*,*)'PROGRAM ERROR: STOP'
diff --git a/src/MNH/effic_salt.f90 b/src/MNH/effic_salt.f90
new file mode 100644
index 0000000000000000000000000000000000000000..71ee6dfc2ef9b7c6e9d84509b606551e4f30499d
--- /dev/null
+++ b/src/MNH/effic_salt.f90
@@ -0,0 +1,147 @@
+!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$ $Date$
+!-----------------------------------------------------------------
+!! ##############################
+ MODULE MODI_EFFIC_SALT
+!! ##############################
+!!
+INTERFACE
+!
+SUBROUTINE EFFIC_SALT( &
+ PTHT & !I [K] theta
+ ,PRHODREF & !I [kg/m3] air density
+ ,PPABST & !I [Pa] pressure
+ ,PURR & !I
+ ,PSVT & !I [scalar variable, ppp] sea salt concentration
+ ,PEFFIC & !O [scalar variable, ppp] sea salt concentration
+ )
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT,PRHODREF
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PURR
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !scalar variable
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PEFFIC !scavenging efficiency
+
+
+END SUBROUTINE EFFIC_SALT
+!!
+END INTERFACE
+!!
+END MODULE MODI_EFFIC_SALT
+!!
+!! #######################################
+ SUBROUTINE EFFIC_SALT(PTHT,PRHODREF,&
+ PPABST,PURR,PSVT,PEFFIC)
+!! #######################################
+!!
+!! PURPOSE
+!! -------
+!!
+!! REFERENCE
+!! ---------
+!! none
+!!
+!! AUTHOR
+!! ------
+!! Pierre TULET & Joris PIANEZZE (LACy)
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original
+!!
+! Entry variables:
+!
+! PSVTS(INOUT) -Array of moments included in PSVTS
+!
+!*************************************************************
+! Exit variables:
+!
+!*************************************************************
+! Variables used during the deposition velocity calculation
+!
+! ZVGK -Polydisperse settling velocity of the kth moment (m/s)
+!************************************************************
+!!
+!! IMPLICIT ARGUMENTS
+!
+!
+USE MODD_CSTS_SALT
+USE MODD_SALT
+USE MODI_SALT_VELGRAV
+USE MODI_AER_EFFIC3D
+USE MODD_CST, ONLY : XP00, XRD
+USE MODD_PARAMETERS , ONLY : JPVEXT
+USE MODE_SALT_PSD
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT,PRHODREF
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PURR
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !scalar variable
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PEFFIC !scavenging efficiency
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NMODE_SLT) :: ZRG, ZSIG, ZDENSITY_AER
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)):: ZSVT
+
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZMU,ZMUW, ZTEMP
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),3*NMODE_SLT) :: ZVGK, ZDPK
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NMODE_SLT) :: ZVG, ZDPG, ZCOR
+REAL :: ZRHOI
+REAL :: A0, A1, A2, A3 ! Constants for computing viscosity
+!
+!* 0.3 initialize constant
+!
+ZRHOI = XDENSITY_SALT
+ZSVT(:,:,:,:) = PSVT(:,:,:,:)
+
+CALL PPP2SALT(ZSVT, PRHODREF, PSIG3D=ZSIG, PRG3D=ZRG)
+!
+CALL SALT_VELGRAV(ZSIG, ZRG, PTHT, PPABST, PRHODREF, ZRHOI, &
+ ZMU, ZVGK, ZDPK, ZVG, ZDPG, PCOR=ZCOR, PTEMP=ZTEMP)
+!
+!calcul de ZMUW
+
+A0=1.76
+A1=-5.5721e-2
+A2=-1.3943e-3
+A3=-4.3015e-5
+ZMUW(:,:,:)=A0*EXP(A1*(ZTEMP(:,:,:)-273.15) &
+ +A2*(ZTEMP(:,:,:)-273.15) + A3*(ZTEMP(:,:,:)-273.15))*1.e-3
+
+A1=-3.5254e-2
+A2=4.7163e-4
+A3=-6.0667e-6
+
+ WHERE(ZTEMP(:,:,:)>273.15)
+ ZMUW(:,:,:)=A0*EXP(A1*(ZTEMP(:,:,:)-273.15) &
+ +A2*(ZTEMP(:,:,:)-273.15) + A3*(ZTEMP(:,:,:)-273.15))*1.e-3
+
+ END WHERE
+ ZMUW(:,:,:)=MAX(ZMUW(:,:,:),1.e-12)
+
+ZDENSITY_AER(:,:,:,:) = XDENSITY_SALT
+
+CALL AER_EFFIC3D(ZRG,ZVG, &
+ PRHODREF, &
+ ZMUW, ZMU, &
+ ZDPG, &
+ PURR, &
+ NMODE_SLT, &
+ ZTEMP, ZCOR, &
+ ZDENSITY_AER,&
+ PEFFIC )
+
+END SUBROUTINE EFFIC_SALT
diff --git a/src/MNH/forcing.f90 b/src/MNH/forcing.f90
index 38ca0ed7fe6cc44badc5a3f3a14d68705cebd5a2..c7ebd7981b5e820c7a3f321d4c3d422148b6f432 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -19,7 +19,7 @@ INTERFACE
PUFRC_PAST, PVFRC_PAST, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
- KMI)
+ KMI,PJ)
!
USE MODD_TIME, ONLY: DATE_TIME
!
@@ -46,6 +46,8 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! moist variables at time t+1
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS! scalar variables at time t+1
!
INTEGER, INTENT(IN) :: KMI ! Model index
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ
+
!
END SUBROUTINE FORCING
!
@@ -59,7 +61,7 @@ END MODULE MODI_FORCING
PUFRC_PAST, PVFRC_PAST, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
- KMI)
+ KMI,PJ)
! ######################################################################
!
!!*** *FORCING* - routine to compute the forced terms
@@ -145,6 +147,7 @@ END MODULE MODI_FORCING
!! forcing
!! 06/2012 V. Masson Adds tendency of geostrophic wind itself to wind tendency
!! 01/2014 J. escobar correction for // initialisation geostrophic ZUF,ZVF,ZWF
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -161,6 +164,7 @@ USE MODD_LUNIT
USE MODD_PARAMETERS
USE MODD_TIME
USE MODD_BUDGET
+USE MODD_CST
!
USE MODI_SHUMAN
USE MODI_UPSTREAM_Z
@@ -197,6 +201,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! moist variables at time t+1
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS! scalar variables at time t+1
!
INTEGER, INTENT(IN) :: KMI ! Model index
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ
!
!* 0.2 Declarations of local variables
!
@@ -208,6 +213,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWF, ZUF, ZVF ! 3D forcing fields on
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHF, ZRVF ! the model grid mesh
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZGXTHF, ZGYTHF ! at
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTENDTHF, ZTENDRVF ! time t
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTENDVF, ZTENDUF
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDUF, ZDVF ! evolution of geostrophic wind
! ! during the time step
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCOEF ! coefficient to take into
@@ -224,7 +230,9 @@ REAL, DIMENSION(SIZE(PUT,3)) :: ZXWFRC, ZXUFRC, ZXVFRC! 1D forcing fields
REAL, DIMENSION(SIZE(PUT,3)) :: ZXTHFRC, ZXRVFRC ! after
REAL, DIMENSION(SIZE(PUT,3)) :: ZXGXTHFRC, ZXGYTHFRC ! time
REAL, DIMENSION(SIZE(PUT,3)) :: ZXTENDTHFRC, ZXTENDRVFRC ! interpolation
+REAL, DIMENSION(SIZE(PUT,3)) :: ZXTENDUFRC, ZXTENDVFRC
REAL :: ZXPGROUNDFRC ! ground fields interpol.
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZOMEGA ! vertical velocity forcing (Pa/s)
!
LOGICAL, SAVE :: GSFIRSTCALL = .TRUE. ! control switch for the first call
!
@@ -351,6 +359,20 @@ IF (GSFIRSTCALL) THEN
WRITE(UNIT=ILUOUT0,FMT='(I10,99(/8E10.3))') &
JK, (XTENDRVFRC(JK,JL), JL=1, NFRC)
END DO
+!
+ WRITE(UNIT=ILUOUT0,FMT='(A)') &
+ "XTENDUFRC : wind advection tendency in X"
+ DO JK = 1, IKU
+ WRITE(UNIT=ILUOUT0,FMT='(I10,99(/8E10.3))') &
+ JK, (XTENDUFRC(JK,JL), JL=1, NFRC)
+ END DO
+!
+ WRITE(UNIT=ILUOUT0,FMT='(A)') &
+ "XTENDVFRC : wind advection tendency in Y"
+ DO JK = 1, IKU
+ WRITE(UNIT=ILUOUT0,FMT='(I10,99(/8E10.3))') &
+ JK, (XTENDVFRC(JK,JL), JL=1, NFRC)
+ END DO
!
WRITE(UNIT=ILUOUT0,FMT='(A)') &
"XPGROUNDFRC: SURF PRESSURE FORCING"
@@ -374,6 +396,8 @@ IF( TEMPORAL_LT ( TPDTCUR, TDTFRC(1) ) ) THEN
ZXTENDRVFRC(:) = XTENDRVFRC(:,1)
ZXGXTHFRC(:) = XGXTHFRC(:,1)
ZXGYTHFRC(:) = XGYTHFRC(:,1)
+ ZXTENDUFRC(:) = XTENDUFRC(:,1)
+ ZXTENDVFRC(:) = XTENDVFRC(:,1)
ZXPGROUNDFRC = XPGROUNDFRC(1)
ELSE IF ( .NOT. TEMPORAL_LT ( TPDTCUR, TDTFRC(NFRC) ) ) THEN
ZXUFRC(:) = XUFRC(:,NFRC)
@@ -385,6 +409,8 @@ ELSE IF ( .NOT. TEMPORAL_LT ( TPDTCUR, TDTFRC(NFRC) ) ) THEN
ZXTENDRVFRC(:) = XTENDRVFRC(:,NFRC)
ZXGXTHFRC(:) = XGXTHFRC(:,NFRC)
ZXGYTHFRC(:) = XGYTHFRC(:,NFRC)
+ ZXTENDUFRC(:) = XTENDUFRC(:,NFRC)
+ ZXTENDVFRC(:) = XTENDVFRC(:,NFRC)
ZXPGROUNDFRC = XPGROUNDFRC(NFRC)
ELSE
JXP = JSX + 1
@@ -415,6 +441,8 @@ ELSE
ZXRVFRC(:) = XRVFRC(:,JSX) +(XRVFRC(:,JXP)-XRVFRC(:,JSX))*ZALPHA
ZXTENDTHFRC(:) = XTENDTHFRC(:,JSX)+(XTENDTHFRC(:,JXP)-XTENDTHFRC(:,JSX))*ZALPHA
ZXTENDRVFRC(:) = XTENDRVFRC(:,JSX)+(XTENDRVFRC(:,JXP)-XTENDRVFRC(:,JSX))*ZALPHA
+ ZXTENDUFRC(:) = XTENDUFRC(:,JSX)+(XTENDUFRC(:,JXP)-XTENDUFRC(:,JSX))*ZALPHA
+ ZXTENDVFRC(:) = XTENDVFRC(:,JSX)+(XTENDVFRC(:,JXP)-XTENDVFRC(:,JSX))*ZALPHA
ZXGXTHFRC(:) = XGXTHFRC(:,JSX)+(XGXTHFRC(:,JXP)-XGXTHFRC(:,JSX))*ZALPHA
ZXGYTHFRC(:) = XGYTHFRC(:,JSX)+(XGYTHFRC(:,JXP)-XGYTHFRC(:,JSX))*ZALPHA
ZXPGROUNDFRC = XPGROUNDFRC(JSX) +(XPGROUNDFRC(JXP)-XPGROUNDFRC(JSX))*ZALPHA
@@ -436,6 +464,8 @@ ALLOCATE(ZTENDTHF(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
ALLOCATE(ZTENDRVF(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
ALLOCATE(ZDUF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
ALLOCATE(ZDVF(SIZE(PVT,1),SIZE(PVT,2),SIZE(PVT,3)))
+ALLOCATE(ZTENDUF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
+ALLOCATE(ZTENDVF(SIZE(PVT,1),SIZE(PVT,2),SIZE(PVT,3)))
!
IF (LFLAT) THEN
!
@@ -448,6 +478,8 @@ IF (LFLAT) THEN
ZRVF(:,:,:) = SPREAD( SPREAD( ZXRVFRC(:),1,IIU ) ,2,IJU )
ZTENDTHF(:,:,:) = SPREAD( SPREAD( ZXTENDTHFRC(:),1,IIU ),2,IJU )
ZTENDRVF(:,:,:) = SPREAD( SPREAD( ZXTENDRVFRC(:),1,IIU ),2,IJU )
+ ZTENDUF(:,:,:) = SPREAD( SPREAD( ZXTENDUFRC(:),1,IIU ),2,IJU )
+ ZTENDVF(:,:,:) = SPREAD( SPREAD( ZXTENDVFRC(:),1,IIU ),2,IJU )
ZGXTHF(:,:,:) = SPREAD( SPREAD( ZXGXTHFRC(:),1,IIU ),2,IJU )
ZGYTHF(:,:,:) = SPREAD( SPREAD( ZXGYTHFRC(:),1,IIU ),2,IJU )
ELSE
@@ -542,6 +574,8 @@ ELSE
ZGYTHF(JI,JJ,JK) = ZXGYTHFRC(JL+1)*ZDZ + ZXGYTHFRC(JL)*(1-ZDZ)
ZTENDTHF(JI,JJ,JK) = ZXTENDTHFRC(JL+1)*ZDZ + ZXTENDTHFRC(JL)*(1-ZDZ)
ZTENDRVF(JI,JJ,JK) = ZXTENDRVFRC(JL+1)*ZDZ + ZXTENDRVFRC(JL)*(1-ZDZ)
+ ZTENDUF(JI,JJ,JK) = ZXTENDUFRC(JL+1)*ZDZ + ZXTENDUFRC(JL)*(1-ZDZ)
+ ZTENDVF(JI,JJ,JK) = ZXTENDVFRC(JL+1)*ZDZ + ZXTENDVFRC(JL)*(1-ZDZ)
ELSE IF( ZZF(JI,JJ,JK) > PZHAT(IKU) ) THEN
ZDZ = (ZZF(JI,JJ,JK)-PZHAT(IKU)) * ZDZHAT_INV_IKU
ZTHF(JI,JJ,JK) = ZXTHFRC(IKU)*ZDZ + ZXTHFRC(IKU-1)*(1-ZDZ)
@@ -550,6 +584,8 @@ ELSE
ZGYTHF(JI,JJ,JK) = ZXGYTHFRC(IKU)*ZDZ + ZXGYTHFRC(IKU-1)*(1-ZDZ)
ZTENDTHF(JI,JJ,JK) = ZXTENDTHFRC(IKU)*ZDZ + ZXTENDTHFRC(IKU-1)*(1-ZDZ)
ZTENDRVF(JI,JJ,JK) = ZXTENDRVFRC(IKU)*ZDZ + ZXTENDRVFRC(IKU-1)*(1-ZDZ)
+ ZTENDUF(JI,JJ,JK) = ZXTENDUFRC(IKU)*ZDZ + ZXTENDUFRC(IKU-1)*(1-ZDZ)
+ ZTENDVF(JI,JJ,JK) = ZXTENDVFRC(IKU)*ZDZ + ZXTENDVFRC(IKU-1)*(1-ZDZ)
END IF
END DO
END DO
@@ -557,6 +593,15 @@ ELSE
END DO
END IF
!
+!!============================
+!!
+!! Ligne to add if you want W in Pa/s in namelist instead of m/s (omega = - w/(rho*g))
+!!
+!ZWF(:,:,:) = - ZWF(:,:,:)/(XG*MZM(1,IKU,1,(PRHODJ(:,:,:)/PJ(:,:,:))))
+!
+!!============================
+!
+!
!
! under the ground, forcings do not exist.
!
@@ -570,6 +615,8 @@ DO JK=1,JPVEXT
ZGYTHF(:,:,JK) = 0.
ZTENDTHF(:,:,JK) = 0.
ZTENDRVF(:,:,JK) = 0.
+ ZTENDUF(:,:,JK) = 0.
+ ZTENDVF(:,:,JK) = 0.
END DO
!
! store large scale w in module to be used later
@@ -658,6 +705,13 @@ IF ( LTEND_THRV_FRC ) THEN
END IF
END IF
!
+!* 4.2.1 integration of the tendency forcing for uv
+!
+IF ( LTEND_UV_FRC ) THEN
+ PRUS(:,:,:) = PRUS(:,:,:) + MXM(PRHODJ) * ZTENDUF(:,:,:)
+ PRVS(:,:,:) = PRVS(:,:,:) + MYM(PRHODJ) * ZTENDVF(:,:,:)
+END IF
+!
!* 4.3 integration of the thermal and geostrophic wind
!
IF( LCORIO ) THEN
@@ -681,27 +735,29 @@ IF( LCORIO ) THEN
! adds tendency of geostrophic wind to force wind in the free troposphere to
! follow the geostrophic wind when the latter changes.
! When winds differs from the geotrophic wind, the impact of this tendency is reduced.
- ALLOCATE(ZCOEF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
- ZCOEF(:,:,:) = (MXF(PUT **2)+MYF(PVT **2)) &
- /MAX(MXF(PUFRC_PAST**2)+MYF(PVFRC_PAST**2), 1.E-3)
- !
- ZCOEF(:,:,:) = MIN(1.,SQRT(ZCOEF))
- !
- ZDUT(:,:,:) = ZDUF(:,:,:) * MXM(ZCOEF)
- ZDVT(:,:,:) = ZDVF(:,:,:) * MYM(ZCOEF)
- !
- PRUS(:,:,:) = PRUS(:,:,:) + ZDUT(:,:,:) * MXM(PRHODJ) / PTSTEP
+ IF ( .NOT. LTEND_UV_FRC ) THEN
+ ALLOCATE(ZCOEF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
+ ZCOEF(:,:,:) = (MXF(PUT **2)+MYF(PVT **2)) &
+ /MAX(MXF(PUFRC_PAST**2)+MYF(PVFRC_PAST**2), 1.E-3)
+ !
+ ZCOEF(:,:,:) = MIN(1.,SQRT(ZCOEF))
+ !
+ ZDUT(:,:,:) = ZDUF(:,:,:) * MXM(ZCOEF)
+ ZDVT(:,:,:) = ZDVF(:,:,:) * MYM(ZCOEF)
+ !
+ PRUS(:,:,:) = PRUS(:,:,:) + ZDUT(:,:,:) * MXM(PRHODJ) / PTSTEP
+ !
+ PRVS(:,:,:) = PRVS(:,:,:) + ZDVT(:,:,:) * MYM(PRHODJ) / PTSTEP
+ !
+ !
+ ! Takes into acount the Coriolis force due to this evolution
+ PRUS(:,:,:) = PRUS(:,:,:) &
+ + MXM( MYF(ZDVT(:,:,:))*PRHODJ(:,:,:)*SPREAD(PCORIOZ(:,:),3,IKU))
+ PRVS(:,:,:) = PRVS(:,:,:) &
+ - MYM( MXF(ZDUT(:,:,:))*PRHODJ(:,:,:)*SPREAD(PCORIOZ(:,:),3,IKU))
!
- PRVS(:,:,:) = PRVS(:,:,:) + ZDVT(:,:,:) * MYM(PRHODJ) / PTSTEP
- !
- !
- ! Takes into acount the Coriolis force due to this evolution
- PRUS(:,:,:) = PRUS(:,:,:) &
- + MXM( MYF(ZDVT(:,:,:))*PRHODJ(:,:,:)*SPREAD(PCORIOZ(:,:),3,IKU))
- PRVS(:,:,:) = PRVS(:,:,:) &
- - MYM( MXF(ZDUT(:,:,:))*PRHODJ(:,:,:)*SPREAD(PCORIOZ(:,:),3,IKU))
- !
- DEALLOCATE(ZCOEF)
+ DEALLOCATE(ZCOEF)
+ END IF
END IF
!
END IF
@@ -816,6 +872,8 @@ DEALLOCATE(ZGXTHF)
DEALLOCATE(ZGYTHF)
DEALLOCATE(ZTENDTHF)
DEALLOCATE(ZTENDRVF)
+DEALLOCATE(ZTENDUF)
+DEALLOCATE(ZTENDVF)
DEALLOCATE(ZDZZ)
DEALLOCATE(ZRWCF)
DEALLOCATE(ZDUF)
diff --git a/src/MNH/get_vegn.f90 b/src/MNH/get_vegn.f90
deleted file mode 100644
index 37c1d15a88df9bb72d1c1036878055e02c326405..0000000000000000000000000000000000000000
--- a/src/MNH/get_vegn.f90
+++ /dev/null
@@ -1,171 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-! ##########################
- MODULE MODI_GET_VEG_n
-! ##########################
-INTERFACE
- SUBROUTINE GET_VEG_n(HPROGRAM, KI, PLAI, PVH)
-!
-CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
-INTEGER, INTENT(IN) :: KI ! number of points
-
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PVH
-REAL, DIMENSION(KI), INTENT(OUT) :: PLAI
-!
-END SUBROUTINE GET_VEG_n
-!
-END INTERFACE
-END MODULE MODI_GET_VEG_n
-! #######################################################################
- SUBROUTINE GET_VEG_n(HPROGRAM, KI, PLAI, PVH)
-! #######################################################################
-!
-!!**** *GET_VEG_n* - gets some veg fields on atmospheric grid
-!!
-!! PURPOSE
-!! -------
-!!
-!! This program returns some veg variables needed by the atmosphere
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! P. Aumond
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2009
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_DATA_COVER_PAR
-USE MODD_SURF_ATM_n, ONLY : CSEA, CWATER, CTOWN, CNATURE, &
- XSEA, XWATER, XTOWN, XNATURE, &
- NSIZE_SEA, NSIZE_WATER, NSIZE_TOWN, NSIZE_NATURE, &
- NR_SEA, NR_WATER, NR_TOWN, NR_NATURE, &
- NDIM_FULL, NSIZE_FULL, &
- NDIM_NATURE, NDIM_SEA, NDIM_WATER, NDIM_TOWN
-USE MODD_ISBA_n
-
-USE MODI_GET_LUOUT
-USE MODI_VEGTYPE_TO_PATCH
-!
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
-INTEGER, INTENT(IN) :: KI ! number of points
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PVH ! Tree height
-REAL, DIMENSION(KI), INTENT(OUT) :: PLAI
-!-------------------------------------------------------------------------------
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-! Arrays defined for each tile
-!
-!
-INTEGER :: JI,JJ ! loop index over tiles
-INTEGER :: ILUOUT ! unit numberi
-REAL, DIMENSION(NSIZE_FULL) :: ZH_TREE_FULL, ZLAI_FULL
-REAL, DIMENSION(NSIZE_NATURE) :: ZH_TREE, ZLAI,ZWORK
-INTEGER:: IPATCH_TREE, IPATCH_EVER, IPATCH_CONI
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. Logical unit for writing out
-!
-CALL GET_LUOUT(HPROGRAM,ILUOUT)
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. Passage dur le masque global
-! -------------------------------
-
-
-ZH_TREE_FULL(:)=0
-ZLAI_FULL(:)=XUNDEF
-
-IPATCH_TREE=VEGTYPE_TO_PATCH(NVT_TREE, NPATCH)
-IPATCH_EVER=VEGTYPE_TO_PATCH(NVT_EVER, NPATCH)
-IPATCH_CONI=VEGTYPE_TO_PATCH(NVT_CONI, NPATCH)
-
-
-ZWORK(:)=(XVEGTYPE(:,NVT_CONI)+&
- XVEGTYPE(:,NVT_EVER)+&
- XVEGTYPE(:,NVT_TREE))
-
-DO JJ=1,NSIZE_NATURE
- IF (ZWORK(JJ)==0) THEN
- ZH_TREE(JJ) = 0.
- ZLAI(JJ) = 0.
- ELSE
- ZH_TREE(JJ) =(((XH_TREE(JJ,IPATCH_TREE)*XVEGTYPE(JJ,NVT_TREE))+&
- (XH_TREE(JJ,IPATCH_EVER)*XVEGTYPE(JJ,NVT_EVER))+&
- (XH_TREE(JJ,IPATCH_CONI)*XVEGTYPE(JJ,NVT_CONI)))/&
- (ZWORK(JJ)))
-
- ZLAI(JJ) = (((XLAI(JJ,IPATCH_EVER)*XVEGTYPE(JJ,NVT_EVER))+&
- (XLAI(JJ,IPATCH_CONI)*XVEGTYPE(JJ,NVT_CONI))+&
- (XLAI(JJ,IPATCH_TREE)*XVEGTYPE(JJ,NVT_TREE))))
-
- ZH_TREE_FULL(NR_NATURE(JJ)) = ZH_TREE(JJ)
- ZLAI_FULL(NR_NATURE(JJ)) = ZLAI(JJ)
- END IF
-END DO
-
-ZLAI_FULL(:)=XNATURE(:)*ZLAI_FULL(:)
-
-
-!* 2. Envoi les variables vers mesonH
-! ------------------------------
-
-IF ( SIZE(PVH) /= SIZE(ZH_TREE_FULL) ) THEN
- WRITE(ILUOUT,*) 'try to get VH field from atmospheric model, but size is not correct'
- WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (PVH) :', SIZE(PVH)
- WRITE(ILUOUT,*) 'size of field inthe surface (XVH) :', SIZE(ZH_TREE_FULL)
- CALL ABOR1_SFX('GET_VHN: VH SIZE NOT CORRECT')
-ELSE
- PVH = ZH_TREE_FULL
-END IF
-!
-!==============================================================================
-!
-!-------------------------------------------------------------------------------
-!
-IF ( SIZE(PLAI) /= SIZE(ZLAI_FULL) ) THEN
- WRITE(ILUOUT,*) 'try to get LAI field from atmospheric model, but size is not correct'
- WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (PLAI) :', SIZE(PLAI)
- WRITE(ILUOUT,*) 'size of field inthe surface (XLAI) :', SIZE(ZLAI_FULL)
- CALL ABOR1_SFX('GET_LAIN: LAI SIZE NOT CORRECT')
-ELSE
- PLAI = ZLAI_FULL
-END IF
-!
-!==============================================================================
-!
-!-------------------------------------------------------------------------------
-!
-!==============================================================================
-!
-END SUBROUTINE GET_VEG_n
diff --git a/src/MNH/goto_model_wrapper.f90 b/src/MNH/goto_model_wrapper.f90
index cc4c35b41505c4683304688f1e1be33d76001f8b..6082372e64375fb518ca5d431f1bfe1680dbf549 100644
--- a/src/MNH/goto_model_wrapper.f90
+++ b/src/MNH/goto_model_wrapper.f90
@@ -16,6 +16,7 @@
!! 2016 (Leriche) Add MODD_CH_ICE Suppress MODD_CH_DEP_n
!! Modification 01/2016 (JP Pinty) Add LIMA
!! 10/2016 (F Brosse) Add prod/loss terms computation for chemistry
+!! 07/2017 (M.Leriche) Add DIAG chimical surface fluxes
!-----------------------------------------------------------------
MODULE MODI_GOTO_MODEL_WRAPPER
@@ -32,6 +33,7 @@ SUBROUTINE GOTO_MODEL_WRAPPER(KFROM, KTO)
USE MODD_ADV_n
USE MODD_BIKHARDT_n
USE MODD_CH_AERO_n
+USE MODD_CH_FLX_n
USE MODD_CH_JVALUES_n
USE MODD_CH_MNHC_n
USE MODD_CH_SOLVER_n
@@ -128,6 +130,7 @@ CALL PRINT_MSG(NVERB_DEBUG,'GEN','GOTO_MODEL_WRAPPER',TRIM(YMSG))
CALL ADV_GOTO_MODEL(KFROM, KTO)
CALL BIKHARDT_GOTO_MODEL(KFROM, KTO)
CALL CH_AERO_GOTO_MODEL(KFROM,KTO)
+CALL CH_FLX_GOTO_MODEL(KFROM, KTO)
CALL CH_JVALUES_GOTO_MODEL(KFROM, KTO)
CALL CH_MNHC_GOTO_MODEL(KFROM, KTO)
CALL CH_SOLVER_GOTO_MODEL(KFROM, KTO)
diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90
index 0aba42873940d02b0667520e57521da23a6ad318..6ef8cbf4ecaaa7b2a119ab7583398f61a9964e0c 100644
--- a/src/MNH/ground_paramn.f90
+++ b/src/MNH/ground_paramn.f90
@@ -107,6 +107,7 @@ END MODULE MODI_GROUND_PARAM_n
!! 06/2016 (G.Delautier) phasage surfex 8
!! (B.Vie) 2016 LIMA
!! (M.Leriche) 24/03/16 remove flag for chemical surface fluxes
+!! (M.Leriche) 01/07/2017 Add DIAG chimical surface fluxes
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -141,6 +142,8 @@ USE MODD_SALT, ONLY : LSALT
USE MODD_CH_AEROSOL, ONLY : LORILAM
USE MODD_CSTS_DUST, ONLY : XMOLARWEIGHT_DUST
USE MODD_CSTS_SALT, ONLY : XMOLARWEIGHT_SALT
+USE MODD_CH_FLX_n, ONLY : XCHFLX
+USE MODD_DIAG_FLAG, ONLY : LCHEMDIAG
!
USE MODI_NORMAL_INTERPOL
USE MODI_ROTATE_WIND
@@ -598,6 +601,7 @@ END IF
IF (LUSECHEM) THEN
DO JSV=NSV_CHEMBEG,NSV_CHEMEND
PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / ( XAVOGADRO * XRHODREF(:,:,IKB))
+ IF ((LCHEMDIAG).AND.(CPROGRAM == 'DIAG ')) XCHFLX(:,:,JSV) = PSFSV(:,:,JSV)
END DO
ELSE
PSFSV(:,:,NSV_CHEMBEG:NSV_CHEMEND) = 0.
diff --git a/src/MNH/hypgeo.f90 b/src/MNH/hypgeo.f90
index d147afd53da655f192d956bc19c99bfe487be378..fa64d778da5ee68c7483f3a2ce969f7dda5269fe 100644
--- a/src/MNH/hypgeo.f90
+++ b/src/MNH/hypgeo.f90
@@ -74,6 +74,7 @@ END MODULE MODI_HYPGEO
!
!
USE MODI_GAMMA
+USE MODI_HYPSER
!
IMPLICIT NONE
!
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index 647b79fc9b98405891be6ff96c02d80d36075aa9..788f0dfb99124c9ce71337c6a0a374b6c81fb065 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -175,7 +175,8 @@ USE MODD_2D_FRC
USE MODD_PARAM_LIMA, ONLY : OWARM=>LWARM, OCOLD=>LCOLD, OSEDI=>LSEDI, &
OHHONI=>LHHONI, ORAIN=>LRAIN, OSEDC=>LSEDC, &
ONUCL=>LNUCL, OACTI=>LACTI, OSNOW=>LSNOW, &
- OHAIL=>LHAIL, OSCAV=>LSCAV, OMEYERS=>LMEYERS
+ OHAIL=>LHAIL, OSCAV=>LSCAV, OMEYERS=>LMEYERS,&
+ ODEPOC=>LDEPOC
!
USE MODE_ll
USE MODE_IO_ll
@@ -1315,6 +1316,8 @@ IF (LBU_RRC) THEN
IF (HCLOUD == 'LIMA') THEN
IF (OWARM .AND. OSEDC) IPROACTV(7,IPROC) = NSEDIRC
IPROC=IPROC+1
+ IF (OWARM .AND. ODEPOC) IPROACTV(7,IPROC) = NDEPORC
+ IPROC=IPROC+1
IF (OWARM .AND. OACTI) IPROACTV(7,IPROC) = NHENURC
IPROC=IPROC+1
IF (OWARM .AND. ORAIN) IPROACTV(7,IPROC) = NAUTORC
@@ -1422,6 +1425,8 @@ IF (LBU_RRC) THEN
IF (HCLOUD == 'LIMA') THEN
YWORK2(7,IPROC) = 'SEDI_'
IPROC=IPROC+1
+ YWORK2(7,IPROC) = 'DEPO_'
+ IPROC=IPROC+1
YWORK2(7,IPROC) = 'HENU_'
IPROC=IPROC+1
YWORK2(7,IPROC) = 'AUTO_'
@@ -2675,42 +2680,42 @@ CONTAINS
USE MODD_NSV
USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, NMOD_IMM
!
- IF (JSV <= NSV_USER) THEN
- ! NSV_USER Case
-! SELECT CASE(JSV)
-! CASE (1)
-! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
-! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC1_'
-! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
-! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC2_'
-! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-! CASE (2)
-! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
-! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC3_'
-! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
-! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC4_'
-! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-! END SELECT
- !
- ELSEIF (JSV >= NSV_C2R2BEG .AND. JSV <= NSV_C2R2END) THEN
- ! C2R2 or KHKO Case
- SELECT CASE(JSV-NSV_C2R2BEG+1)
- CASE (1) ! Concentration of activated nuclei
- IF (.NOT. LSUPSAT) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HENU_'
- END IF
+IF (JSV <= NSV_USER) THEN
+ ! NSV_USER Case
+ ! SELECT CASE(JSV)
+ ! CASE (1)
+ ! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ ! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC1_'
+ ! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ ! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC2_'
+ ! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ! CASE (2)
+ ! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ ! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC3_'
+ ! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ ! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC4_'
+ ! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ! END SELECT
+ !
+ELSEIF (JSV >= NSV_C2R2BEG .AND. JSV <= NSV_C2R2END) THEN
+ ! C2R2 or KHKO Case
+ SELECT CASE(JSV-NSV_C2R2BEG+1)
+ CASE (1) ! Concentration of activated nuclei
+ IF (.NOT. LSUPSAT) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HENU_'
+ END IF
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEVA_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- CASE (2) ! Concentration of cloud droplets
- IF (.NOT. LSUPSAT) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HENU_'
- END IF
+ CASE (2) ! Concentration of cloud droplets
+ IF (.NOT. LSUPSAT) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HENU_'
+ END IF
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'SELF_'
@@ -2719,26 +2724,26 @@ USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, NMOD_IMM
YWORK2(12+JSV,ILAST_PROC_NBR)= 'ACCR_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
IF (LSEDC) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
END IF
IF (LDEPOC) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'DEPO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'DEPO_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEVA_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- CASE (3) ! Concentration of raindrops
+ CASE (3) ! Concentration of raindrops
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'AUTO_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
IF (HCLOUD /= 'KHKO') THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SCBU_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'SCBU_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEVA_'
@@ -2749,136 +2754,140 @@ USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, NMOD_IMM
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END SELECT
- !
-
+ END SELECT
+ !
- ELSEIF (JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END) THEN
- ! LIMA case
-IF (JSV == NSV_LIMA_NC) THEN
-! Cloud droplets conc.
+ELSEIF (JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END) THEN
+ ! LIMA case
+ IF (JSV == NSV_LIMA_NC) THEN
+ ! Cloud droplets conc.
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
IF (OWARM) THEN
- IF (OSEDC) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OACTI) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HENU_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SELF_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'AUTO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'ACCR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ IF (OSEDC) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
+ IF (ODEPOC) THEN
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'REVA_'
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'DEPO_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
+ END IF
+ IF (OACTI) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HENU_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'SELF_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ IF (ORAIN) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'AUTO_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'ACCR_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'REVA_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
END IF
IF (OCOLD .AND. ONUCL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HINC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HINC_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONC_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
END IF
IF (OWARM .AND. OCOLD) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'IMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OSNOW) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'RIM_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OHAIL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETH_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'IMLT_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ IF (OSNOW) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'RIM_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETG_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'DRYG_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ IF (OHAIL) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETH_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEDS_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-!
-ELSE IF (JSV == NSV_LIMA_NR) THEN
-! Rain drops conc.
+ !
+ ELSE IF (JSV == NSV_LIMA_NR) THEN
+ ! Rain drops conc.
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
IF (OWARM .AND. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'AUTO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SCBU_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'REVA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'BRKU_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'AUTO_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'SCBU_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'REVA_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'BRKU_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
END IF
IF (OCOLD .AND. OWARM .AND. ORAIN .AND. ONUCL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONR_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
END IF
IF (OWARM .AND. OCOLD) THEN
- IF (OSNOW) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'ACC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CFRZ_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'GMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OHAIL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETH_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
+ IF (OSNOW) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'ACC_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'CFRZ_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETG_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'DRYG_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'GMLT_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ IF (OHAIL) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETH_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HMLT_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
END IF
-!
-ELSE IF (JSV.GE.NSV_LIMA_CCN_FREE .AND. JSV.LT.(NSV_LIMA_CCN_FREE+NMOD_CCN)) THEN
-! Free CCN conc.
+ !
+ ELSE IF (JSV.GE.NSV_LIMA_CCN_FREE .AND. JSV.LT.(NSV_LIMA_CCN_FREE+NMOD_CCN)) THEN
+ ! Free CCN conc.
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
@@ -2900,84 +2909,84 @@ ELSE IF (JSV.GE.NSV_LIMA_CCN_FREE .AND. JSV.LT.(NSV_LIMA_CCN_FREE+NMOD_CCN)) THE
YWORK2(12+JSV,ILAST_PROC_NBR)= 'SCAV_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
END IF
-!
-ELSE IF (JSV.GE.NSV_LIMA_CCN_ACTI .AND. JSV.LT.(NSV_LIMA_CCN_ACTI+NMOD_CCN)) THEN
-! Activated CCN conc.
+ !
+ ELSE IF (JSV.GE.NSV_LIMA_CCN_ACTI .AND. JSV.LT.(NSV_LIMA_CCN_ACTI+NMOD_CCN)) THEN
+ ! Activated CCN conc.
-ELSE IF (JSV == NSV_LIMA_NI) THEN
-! Pristine ice crystals conc.
+ ELSE IF (JSV == NSV_LIMA_NI) THEN
+ ! Pristine ice crystals conc.
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
IF (OCOLD) THEN
- IF (OSEDI) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (ONUCL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HIND_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HINC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OWARM .AND. OHHONI) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONH_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OWARM) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- END IF
- IF (OSNOW) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CNVI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CNVS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'AGGS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
+ IF (OSEDI) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
+ IF (ONUCL) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HIND_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HINC_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ IF (OWARM .AND. OHHONI) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONH_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
+ IF (OWARM) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONC_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
+ END IF
+ IF (OSNOW) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'CNVI_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'CNVS_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'AGGS_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
END IF
IF (OWARM .AND. OCOLD) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'IMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OSNOW) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HMS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CFRZ_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HMG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OHAIL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETH_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'IMLT_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ IF (OSNOW) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HMS_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'CFRZ_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETG_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'DRYG_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HMG_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ IF (OHAIL) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETH_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEDS_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-!
-ELSE IF (JSV.GE.NSV_LIMA_IFN_FREE .AND. JSV.LT.(NSV_LIMA_IFN_FREE+NMOD_IFN)) THEN
-! Free IFN conc.
+ !
+ ELSE IF (JSV.GE.NSV_LIMA_IFN_FREE .AND. JSV.LT.(NSV_LIMA_IFN_FREE+NMOD_IFN)) THEN
+ ! Free IFN conc.
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
@@ -2986,11 +2995,11 @@ ELSE IF (JSV.GE.NSV_LIMA_IFN_FREE .AND. JSV.LT.(NSV_LIMA_IFN_FREE+NMOD_IFN)) THE
YWORK2(12+JSV,ILAST_PROC_NBR)= 'HIND_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
END IF
-! IF (OCOLD .AND. OWARM) THEN
-! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
-! YWORK2(12+JSV,ILAST_PROC_NBR)= 'IMLT_'
-! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-! END IF
+ ! IF (OCOLD .AND. OWARM) THEN
+ ! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ ! YWORK2(12+JSV,ILAST_PROC_NBR)= 'IMLT_'
+ ! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ ! END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEDS_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
@@ -2999,24 +3008,29 @@ ELSE IF (JSV.GE.NSV_LIMA_IFN_FREE .AND. JSV.LT.(NSV_LIMA_IFN_FREE+NMOD_IFN)) THE
YWORK2(12+JSV,ILAST_PROC_NBR)= 'SCAV_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
END IF
-!
-ELSE IF (JSV.GE.NSV_LIMA_IFN_NUCL .AND. JSV.LT.(NSV_LIMA_IFN_NUCL+NMOD_IFN)) THEN
-! Nucleated IFN conc.
+ !
+ ELSE IF (JSV.GE.NSV_LIMA_IFN_NUCL .AND. JSV.LT.(NSV_LIMA_IFN_NUCL+NMOD_IFN)) THEN
+ ! Nucleated IFN conc.
-ELSE IF (JSV.GE.NSV_LIMA_IMM_NUCL .AND. JSV.LT.(NSV_LIMA_IMM_NUCL+NMOD_IMM)) THEN
-! Nucleated IMM conc.
+ ELSE IF (JSV.GE.NSV_LIMA_IMM_NUCL .AND. JSV.LT.(NSV_LIMA_IMM_NUCL+NMOD_IMM)) THEN
+ ! Nucleated IMM conc.
-ELSE IF (JSV == NSV_LIMA_HOM_HAZE) THEN
-! Homogeneous freezing of CCN
+ ELSE IF (JSV == NSV_LIMA_HOM_HAZE) THEN
+ ! Homogeneous freezing of CCN
+ IF (OCOLD .AND. ONUCL .AND. OWARM .AND. OHHONI) THEN
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONH_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
+ END IF
-END IF
+ END IF
- ELSEIF (JSV >= NSV_ELECBEG .AND. JSV <= NSV_ELECEND) THEN
- SELECT CASE(JSV-NSV_ELECBEG+1)
- CASE(1) ! volumetric charge of water vapor
+ELSEIF (JSV >= NSV_ELECBEG .AND. JSV <= NSV_ELECEND) THEN
+ SELECT CASE(JSV-NSV_ELECBEG+1)
+ CASE(1) ! volumetric charge of water vapor
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPS_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPSQV
@@ -3024,9 +3038,9 @@ END IF
YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPG_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPGQV
IF (LWARM) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'REVA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NREVAQV
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR) = 'REVA_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NREVAQV
END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPI_'
@@ -3034,14 +3048,14 @@ END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEUTQV
- CASE(2) ! volumetric charge of cloud droplets
+ CASE(2) ! volumetric charge of cloud droplets
IF (LWARM) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'AUTO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NAUTOQC
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'ACCR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NACCRQC
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR) = 'AUTO_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NAUTOQC
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR) = 'ACCR_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NACCRQC
END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'RIM_'
@@ -3062,29 +3076,29 @@ END IF
YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPI_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPIQC
IF (LINDUCTIVE) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'IND_'
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR) = 'IND_'
END IF
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NINDQC
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NINDQC
IF (LSEDIC) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NSEDIQC
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR) = 'SEDI_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NSEDIQC
END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEUTQC
- CASE(3) ! volumetric charge of rain drops
+ CASE(3) ! volumetric charge of rain drops
IF (LWARM) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'AUTO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NAUTOQR
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'ACCR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NACCRQR
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'REVA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NREVAQR
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR) = 'AUTO_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NAUTOQR
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR) = 'ACCR_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NACCRQR
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR) = 'REVA_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NREVAQR
END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'ACC_'
@@ -3107,7 +3121,7 @@ END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEUTQR
- CASE(4) ! volumetric charge of ice crystals
+ CASE(4) ! volumetric charge of ice crystals
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'AGGS_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NAGGSQI
@@ -3141,7 +3155,7 @@ END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEUTQI
- CASE(5) ! volumetric charge of snow
+ CASE(5) ! volumetric charge of snow
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPS_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPSQS
@@ -3174,7 +3188,7 @@ END IF
IPROACTV(12+JSV,ILAST_PROC_NBR) = NSEDIQS
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
- CASE(6) ! volumetric charge of graupel
+ CASE(6) ! volumetric charge of graupel
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPG_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPGQG
@@ -3200,9 +3214,9 @@ END IF
YWORK2(12+JSV,ILAST_PROC_NBR) = 'GMLT_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NGMLTQG
IF (LINDUCTIVE) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'IND_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NINDQG
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR) = 'IND_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NINDQG
END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'SEDI_'
@@ -3210,31 +3224,30 @@ END IF
ILAST_PROC_NBR = ILAST_PROC_NBR + 1
YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEUTQG
- CASE(7) ! volumetric charge of hail
-! add budget for hail volumetric charge
- END SELECT
+ CASE(7) ! volumetric charge of hail
+ ! add budget for hail volumetric charge
+ END SELECT
+ !
+ELSE IF (JSV >= NSV_CHEMBEG .AND. JSV <= NSV_CHEMEND) THEN
+ ! Chemical Case
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'CHEM_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NCHEMSV
+ ! other processes
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'ADV_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NADVSV
+ ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
+ IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEGASV
+ !
+ELSE
+ ! other processes
+ ! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
+ ! YWORK2(12+JSV,ILAST_PROC_NBR)= 'ADV_'
+ ! IPROACTV(12+JSV,ILAST_PROC_NBR) = NADVSV
+END IF
!
- END IF
- IF (JSV >= NSV_CHEMBEG .AND. JSV <= NSV_CHEMEND) THEN
- ! Chemical Case
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CHEM_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NCHEMSV
- ! other processes
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'ADV_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NADVSV
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEGASV
- !
- ELSE
- ! other processes
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'ADV_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NADVSV
- END IF
- !
END SUBROUTINE BUDGET_OTHERPROC_SV
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ini_cst.f90 b/src/MNH/ini_cst.f90
index 9434bc16f448b032f3affa9b6f6b5e8196938b44..d73d39463a50ed68c711df7629cc34fcd8a0d2fc 100644
--- a/src/MNH/ini_cst.f90
+++ b/src/MNH/ini_cst.f90
@@ -66,6 +66,7 @@ END MODULE MODI_INI_CST
!! C. Mari 31/10/00 add NDAYSEC
!! V. Masson 01/03/03 add XCONDI
!! J. Escobar 28/03/2014 for pb with emissivity/aerosol reset XMNH_TINY=1.0e-80 in real8 case
+!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
!!
!-------------------------------------------------------------------------------
!
@@ -159,6 +160,7 @@ XALPI = LOG(XESTT) + (XBETAI /XTT) + (XGAMI *LOG(XTT))
XMNH_EPSILON = EPSILON (XMNH_EPSILON )
XMNH_HUGE = HUGE (XMNH_HUGE )
+XMNH_HUGE_12_LOG = LOG ( SQRT(XMNH_HUGE) )
#ifdef MNH_MPI_DOUBLE_PRECISION
XMNH_TINY = 1.0e-80
diff --git a/src/MNH/ini_mean_field.f90 b/src/MNH/ini_mean_field.f90
index 2a5e5eca1b8214deca9eb357c0cb7b3f8c848c12..36eafb4586599ef980f804c73ac1674cea7448c8 100644
--- a/src/MNH/ini_mean_field.f90
+++ b/src/MNH/ini_mean_field.f90
@@ -47,9 +47,7 @@ END MODULE MODI_INI_MEAN_FIELD
!! MODIFICATIONS
!! -------------
!! Original 11/12/09
-!! Modifications 10/2016 (C.Lac) Add max values
-!! 04/2017 (P. Wautelet) Initialize MAX variables to lowest possible value
-!!
+!! 10/2016 (C.Lac) Add max values
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -62,10 +60,6 @@ USE MODD_PARAM_n
IMPLICIT NONE
!
-REAL :: ZMIN !Largest real negative value
-!
-ZMIN = -HUGE(ZMIN)
-!
MEAN_COUNT = 0
XUM_MEAN = 0.0
@@ -83,12 +77,12 @@ XTH2_MEAN = 0.0
XTEMP2_MEAN = 0.0
XPABS2_MEAN = 0.0
-XUM_MAX = ZMIN
-XVM_MAX = ZMIN
-XWM_MAX = ZMIN
-XTHM_MAX = ZMIN
-XTEMPM_MAX = ZMIN
-IF (CTURB /= 'NONE') XTKEM_MAX = ZMIN
-XPABSM_MAX = ZMIN
+XUM_MAX = -1.E20
+XVM_MAX = -1.E20
+XWM_MAX = -1.E20
+XTHM_MAX = 0.0
+XTEMPM_MAX = 0.0
+IF (CTURB /= 'NONE') XTKEM_MAX = 0.0
+XPABSM_MAX = 0.0
END SUBROUTINE INI_MEAN_FIELD
diff --git a/src/MNH/ini_micron.f90 b/src/MNH/ini_micron.f90
index ae6dfbb6cd1118d83060d204617107e9c03e1137..c66a5673d69e143c1b8d3ddc456f38adfac03ad4 100644
--- a/src/MNH/ini_micron.f90
+++ b/src/MNH/ini_micron.f90
@@ -104,7 +104,7 @@ USE MODD_NSV, ONLY : NSV,NSV_CHEM,NSV_C2R2BEG,NSV_C2R2END, &
NSV_LIMA_NI, &
NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, &
NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
-USE MODD_PARAM_LIMA, ONLY : LSCAV, MSEDC=>LSEDC, MACTIT=>LACTIT
+USE MODD_PARAM_LIMA, ONLY : LSCAV, MSEDC=>LSEDC, MACTIT=>LACTIT, MDEPOC=>LDEPOC
USE MODD_LIMA_PRECIP_SCAVENGING_n
!
USE MODI_INIT_AEROSOL_CONCENTRATION
@@ -173,8 +173,9 @@ ELSE
ALLOCATE(XACPRC(0,0))
END IF
!
-IF ( (((CCLOUD == 'KHKO') .OR.(CCLOUD == 'C2R2')) .AND. LDEPOC) &
- .OR. ( (CCLOUD(1:3) == 'ICE') .AND. LDEPOSC) ) THEN
+IF (( CCLOUD(1:3) == 'ICE' .AND.LDEPOSC) .OR. &
+ ((CCLOUD=='C2R2' .OR. CCLOUD=='KHKO').AND.LDEPOC) .OR. &
+ ( CCLOUD=='LIMA' .AND.MDEPOC)) THEN
ALLOCATE(XINDEP(IIU,IJU))
ALLOCATE(XACDEP(IIU,IJU))
XINDEP(:,:)=0.0
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 739bf6a92c304cf6ff7a5766c0a3072985e4a593..51d4954559021873053a73ca86c8090a471d0bd7 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -270,9 +270,11 @@ END MODULE MODI_INI_MODEL_n
!! M.Leriche 2016 Chemistry
!! 10/2016 M.Mazoyer New KHKO output fields
!! 10/2016 (C.Lac) Add max values
-!! F. Brosse Oct. 2016 add prod/loss terms computation for chemistry
-!! 01/2017 (G.Delautier) bug chemistry : modify test for prod/loss terms computation
-!! Apr. 2017 (P. Wautelet) allocate MAX variables if LMEAN_FIELD and call INI_MEAN_FIELD
+!! F. Brosse Oct. 2016 add prod/loss terms computation for chemistry
+!! M.Leriche 2016 Chemistry
+!! M.Leriche 10/02/17 prevent negative values in LBX(Y)SVS
+!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -331,6 +333,7 @@ USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHAQ, LUSECHIC, LCH_INIT_FIELD, &
USE MODD_CH_PH_n
USE MODD_CH_AEROSOL, ONLY : LORILAM
USE MODD_CH_AERO_n, ONLY : XSOLORG,XMI
+USE MODD_CH_FLX_n, ONLY : XCHFLX
USE MODD_PARAM_KAFR_n
USE MODD_PARAM_MFSHALL_n
USE MODD_DEEP_CONVECTION_n
@@ -670,31 +673,34 @@ IF (LMEAN_FIELD) THEN
!
MEAN_COUNT = 0
!
- ALLOCATE(XUM_MEAN(IIU,IJU,IKU))
- ALLOCATE(XVM_MEAN(IIU,IJU,IKU))
- ALLOCATE(XWM_MEAN(IIU,IJU,IKU))
- ALLOCATE(XTHM_MEAN(IIU,IJU,IKU))
- ALLOCATE(XTEMPM_MEAN(IIU,IJU,IKU))
- IF (CTURB/='NONE') ALLOCATE(XTKEM_MEAN(IIU,IJU,IKU))
- ALLOCATE(XPABSM_MEAN(IIU,IJU,IKU))
-!
- ALLOCATE(XU2_MEAN(IIU,IJU,IKU))
- ALLOCATE(XV2_MEAN(IIU,IJU,IKU))
- ALLOCATE(XW2_MEAN(IIU,IJU,IKU))
- ALLOCATE(XTH2_MEAN(IIU,IJU,IKU))
- ALLOCATE(XTEMP2_MEAN(IIU,IJU,IKU))
- ALLOCATE(XPABS2_MEAN(IIU,IJU,IKU))
-!
- ALLOCATE(XUM_MAX(IIU,IJU,IKU))
- ALLOCATE(XVM_MAX(IIU,IJU,IKU))
- ALLOCATE(XWM_MAX(IIU,IJU,IKU))
- ALLOCATE(XTHM_MAX(IIU,IJU,IKU))
- ALLOCATE(XTEMPM_MAX(IIU,IJU,IKU))
- IF (CTURB/='NONE') ALLOCATE(XTKEM_MAX(IIU,IJU,IKU))
- ALLOCATE(XPABSM_MAX(IIU,IJU,IKU))
-!
- CALL INI_MEAN_FIELD()
-!
+ ALLOCATE(XUM_MEAN(IIU,IJU,IKU)) ; XUM_MEAN = 0.0
+ ALLOCATE(XVM_MEAN(IIU,IJU,IKU)) ; XVM_MEAN = 0.0
+ ALLOCATE(XWM_MEAN(IIU,IJU,IKU)) ; XWM_MEAN = 0.0
+ ALLOCATE(XTHM_MEAN(IIU,IJU,IKU)) ; XTHM_MEAN = 0.0
+ ALLOCATE(XTEMPM_MEAN(IIU,IJU,IKU)) ; XTEMPM_MEAN = 0.0
+ IF (CTURB/='NONE') THEN
+ ALLOCATE(XTKEM_MEAN(IIU,IJU,IKU))
+ XTKEM_MEAN = 0.0
+ END IF
+ ALLOCATE(XPABSM_MEAN(IIU,IJU,IKU)) ; XPABSM_MEAN = 0.0
+!
+ ALLOCATE(XU2_MEAN(IIU,IJU,IKU)) ; XU2_MEAN = 0.0
+ ALLOCATE(XV2_MEAN(IIU,IJU,IKU)) ; XV2_MEAN = 0.0
+ ALLOCATE(XW2_MEAN(IIU,IJU,IKU)) ; XW2_MEAN = 0.0
+ ALLOCATE(XTH2_MEAN(IIU,IJU,IKU)) ; XTH2_MEAN = 0.0
+ ALLOCATE(XTEMP2_MEAN(IIU,IJU,IKU)) ; XTEMP2_MEAN = 0.0
+ ALLOCATE(XPABS2_MEAN(IIU,IJU,IKU)) ; XPABS2_MEAN = 0.0
+!
+ ALLOCATE(XUM_MAX(IIU,IJU,IKU)) ; XUM_MAX = -1.E20
+ ALLOCATE(XVM_MAX(IIU,IJU,IKU)) ; XVM_MAX = -1.E20
+ ALLOCATE(XWM_MAX(IIU,IJU,IKU)) ; XWM_MAX = -1.E20
+ ALLOCATE(XTHM_MAX(IIU,IJU,IKU)) ; XTHM_MAX = 0.0
+ ALLOCATE(XTEMPM_MAX(IIU,IJU,IKU)) ; XTEMPM_MAX = 0.0
+ IF (CTURB/='NONE') THEN
+ ALLOCATE(XTKEM_MAX(IIU,IJU,IKU))
+ XTKEM_MAX = 0.0
+ END IF
+ ALLOCATE(XPABSM_MAX(IIU,IJU,IKU)) ; XPABSM_MAX = 0.0
END IF
!
IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
@@ -1373,6 +1379,8 @@ IF (KMI == 1) THEN
ALLOCATE(XGXTHFRC(IKU,NFRC))
ALLOCATE(XGYTHFRC(IKU,NFRC))
ALLOCATE(XPGROUNDFRC(NFRC))
+ ALLOCATE(XTENDUFRC(IKU,NFRC))
+ ALLOCATE(XTENDVFRC(IKU,NFRC))
ELSE
ALLOCATE(TDTFRC(0))
ALLOCATE(XUFRC(0,0))
@@ -1385,6 +1393,8 @@ IF (KMI == 1) THEN
ALLOCATE(XGXTHFRC(0,0))
ALLOCATE(XGYTHFRC(0,0))
ALLOCATE(XPGROUNDFRC(0))
+ ALLOCATE(XTENDUFRC(0,0))
+ ALLOCATE(XTENDVFRC(0,0))
END IF
IF ( LFORCING ) THEN
ALLOCATE(XWTFRC(IIU,IJU,IKU))
@@ -1486,6 +1496,10 @@ IF (LUSECHAQ.AND.(CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN
XACPRAQ(:,:,:) = 0.
ENDIF
ENDIF
+IF ((LUSECHEM).AND.(CPROGRAM == 'DIAG ')) THEN
+ ALLOCATE(XCHFLX(IIU,IJU,NSV_CHEM))
+ XCHFLX(:,:,:) = 0.
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -1619,6 +1633,7 @@ CALL READ_FIELD(TPINIFILE,HLUOUT,IMASDEV, IIU,IJU,IKU,XTSTEP, &
NFRC,TDTFRC,XUFRC,XVFRC,XWFRC,XTHFRC,XRVFRC, &
XTENDTHFRC,XTENDRVFRC,XGXTHFRC,XGYTHFRC, &
XPGROUNDFRC, XATC, &
+ XTENDUFRC, XTENDVFRC, &
NADVFRC,TDTADVFRC,XDTHFRC,XDRVFRC, &
NRELFRC,TDTRELFRC,XTHREL,XRVREL, &
XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, &
@@ -1720,6 +1735,59 @@ IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_cpl::XUT",PRECISION)
+!
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_LNOXBEG,NSV_LNOXEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#ifdef MNH_FOREFIRE
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#endif
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+!
END IF
!
IF ( KMI > 1) THEN
@@ -2179,6 +2247,7 @@ IF ( LFOREFIRE ) THEN
, TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, TDTCUR%TDATE%DAY, TDTCUR%TIME, XTSTEP)
END IF
#endif
+
!-------------------------------------------------------------------------------
!
!* 30. Total production/Loss for chemical species
diff --git a/src/MNH/ini_prog_var.f90 b/src/MNH/ini_prog_var.f90
index 778cf9472ca4bcf5ec9f2f0d1807ed26acc1903e..8b686161c35bdc1be00f6d506e7c8e77e95ae62f 100644
--- a/src/MNH/ini_prog_var.f90
+++ b/src/MNH/ini_prog_var.f90
@@ -95,6 +95,8 @@ END MODULE MODI_INI_PROG_VAR
!! Aug 2012 (J.-P. Chaboureau) read the chem-file descriptor
!! Fev 2015 (J.-P. Chaboureau) read instant T insteed of M
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Mai 2017 (M. Leriche) read aerosol namelists before call ini_nsv
+!! Mai 2017 (M. Leriche) Get wet dep. sv in Meso-NH init file
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -121,6 +123,7 @@ USE MODD_SALT
!
USE MODN_DUST
USE MODN_SALT
+USE MODN_CH_ORILAM
!
USE MODI_PGDFILTER
USE MODI_CH_INIT_SCHEME_n
@@ -128,6 +131,7 @@ USE MODI_CH_AER_INIT_SOA
!
USE MODE_FIELD, ONLY : TFIELDDATA,TYPEREAL
USE MODE_FM
+USE MODE_MODELN_HANDLER
USE MODE_FMREAD
USE MODE_IO_ll
USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
@@ -158,14 +162,16 @@ INTEGER :: IIU_ll, IJU_ll
INTEGER :: IKU
INTEGER :: ILBX,ILBY
INTEGER :: JSV ! Loop index
-INTEGER :: JMOM, IMOMENTS, JMODE, ISV_NAME_IDX ! dust modes
+INTEGER :: JMOM, IMOMENTS, JMODE, ISV_NAME_IDX, IMODEIDX ! dust and salt modes
INTEGER :: ILUDES ! logical unit numbers of DESFM file
LOGICAL :: GFOUND ! Return code when searching namelist
TYPE(TFIELDDATA) :: TZFIELD
TYPE(TFILEDATA),POINTER :: TZCHEMFILE => NULL()
!-------------------------------------------------------------------------------
!
-CALL GET_MODEL_NUMBER_ll(IMI)
+! get model index
+IMI = GET_CURRENT_MODEL_INDEX()
+!
CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
@@ -212,22 +218,6 @@ END IF
ALLOCATE(XSVT(0,0,0,0))
IF(PRESENT(HCHEMFILE)) THEN
WRITE(ILUOUT,*) 'Routine INI_PROG_VAR: CHEMical species read in ',TRIM(HCHEMFILE)
-
- IF (.NOT.LDUST) THEN
- ! Always initialize chemical scheme variables before INI_NSV call !
- CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB)
-! Question CL : Maud a supprime l appel a CH_INIT_CCS ?
- LUSECHEM = .TRUE.
- END IF
- IF (LORILAM) THEN
- CORGANIC = "MPMPO"
- LVARSIGI = .TRUE.
- LVARSIGJ = .TRUE.
- CALL CH_AER_INIT_SOA(ILUOUT,NVERB)
- END IF ! lorilam
- ! initialise NSV_* variables
- CALL INI_NSV(1)
- ALLOCATE(XSVT(IIU,IJU,IKU,NSV))
! Read dimensions in chem file and checks with output file
CALL IO_FILE_ADD2LIST(TZCHEMFILE,TRIM(HCHEMFILE),'UNKNOWN','READ',KLFINPRAR=0,KLFITYPE=2,KLFIVERB=NVERB)
CALL IO_FILE_OPEN_ll(TZCHEMFILE)
@@ -258,8 +248,40 @@ IF(PRESENT(HCHEMFILE)) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR','')
END IF ! IIMAX
+! check nsv to be read
+ IF (.NOT.LDUST) THEN
+ ! Always initialize chemical scheme variables before INI_NSV call !
+ CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB)
+ LUSECHEM = .TRUE.
+ END IF
+ IF (LORILAM) THEN
+ YDESFM=TRIM(ADJUSTL(HCHEMFILE))//'.des'
+ CALL FMLOOK_ll(YDESFM,HLUOUT,ILUDES,IRESP)
+ CALL POSNAM(ILUDES,'NAM_CH_ORILAM',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CH_ORILAM)
+ ENDIF
+ IF (LDUST) THEN
+ LDSTINIT=.TRUE.
+ LDSTPRES=.FALSE.
+ YDESFM=TRIM(ADJUSTL(HCHEMFILE))//'.des'
+ CALL FMLOOK_ll(YDESFM,HLUOUT,ILUDES,IRESP)
+ CALL POSNAM(ILUDES,'NAM_DUST',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DUST)
+ ENDIF
+ IF (LSALT) THEN
+ LSLTINIT=.TRUE.
+ LSLTPRES=.FALSE.
+ YDESFM=TRIM(ADJUSTL(HCHEMFILE))//'.des'
+ CALL FMLOOK_ll(YDESFM,HLUOUT,ILUDES,IRESP)
+ CALL POSNAM(ILUDES,'NAM_SALT',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SALT)
+ ! initialise NSV_* variables
+ ENDIF
+ CALL INI_NSV(1)
+ ALLOCATE(XSVT(IIU,IJU,IKU,NSV))
+
+ ! Read scalars in chem file
IF (.NOT.LDUST) THEN
- ! Read scalars in chem file
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = ''
TZFIELD%CDIR = 'XY'
@@ -283,6 +305,44 @@ IF(PRESENT(HCHEMFILE)) THEN
END IF
END IF
+ IF (LORILAM) THEN
+ CALL CH_AER_INIT_SOA(ILUOUT,NVERB)
+ DO JSV = NSV_AERBEG,NSV_AEREND
+ YRECFM=TRIM(CAERONAMES(JSV-NSV_AERBEG+1))//'T'
+ YDIR='XY'
+ CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVT(:,:,:,JSV),IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ IF (IRESP/=0) THEN
+ WRITE(ILUOUT,FMT=9000)
+ WRITE(ILUOUT,*) TRIM(YRECFM),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE
+!callabortstop
+!CALL ABORT
+! STOP
+ LORILAM=.FALSE.
+ END IF !IRESP
+ END DO ! JSV
+ IF (LDEPOS_AER(IMI)) THEN
+ IF(.NOT.ALLOCATED(CDEAERNAMES)) THEN
+ ALLOCATE(CDEAERNAMES(JPMODE*2))
+ CDEAERNAMES(:) = YPDEAER_INI(:)
+ ENDIF
+ DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND
+ YRECFM=TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1))//'T'
+ YDIR='XY'
+ CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVT(:,:,:,JSV),IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ IF (IRESP/=0) THEN
+ WRITE(ILUOUT,FMT=9000)
+ WRITE(ILUOUT,*) TRIM(YRECFM),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE
+!callabortstop
+!CALL ABORT
+! STOP
+ LDEPOS_AER(IMI)=.FALSE.
+ END IF !IRESP
+ END DO ! JSV
+ END IF ! ldepos_aer
+ END IF ! lorilam
+
IF (LDUST) THEN
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'ppp'
@@ -291,13 +351,6 @@ IF(PRESENT(HCHEMFILE)) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
!
- LDSTINIT=.TRUE.
- LDSTPRES=.FALSE.
- YDESFM=TRIM(ADJUSTL(HCHEMFILE))//'.des'
- CALL FMLOOK_ll(YDESFM,HLUOUT,ILUDES,IRESP)
- CALL POSNAM(ILUDES,'NAM_DUST',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DUST)
- CALL INI_NSV(1)
IMOMENTS = INT(NSV_DSTEND - NSV_DSTBEG+1)/NMODE_DST
IF (IMOMENTS == 1) THEN
DO JMODE=1, NMODE_DST
@@ -331,7 +384,31 @@ IF(PRESENT(HCHEMFILE)) THEN
END IF !IRESP
END DO ! JMOM
END DO !JMOD
- END IF !if IMOMENTS
+ END IF !if IMOMENTS
+ IF (LDEPOS_DST(IMI)) THEN
+ IF(.NOT.ALLOCATED(CDEDSTNAMES)) THEN
+ ALLOCATE(CDEDSTNAMES(NMODE_DST*2))
+ DO JMODE=1,NMODE_DST
+ IMODEIDX=JPDUSTORDER(JMODE)
+ CDEDSTNAMES(JMODE) = YPDEDST_INI(IMODEIDX)
+ CDEDSTNAMES(NMODE_DST+JMODE) = YPDEDST_INI(NMODE_DST+IMODEIDX)
+ ENDDO
+ ENDIF
+ DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND
+ YRECFM=TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))//'T'
+ YDIR='XY'
+ CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVT(:,:,:,JSV),IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ IF (IRESP/=0) THEN
+ WRITE(ILUOUT,FMT=9000)
+ WRITE(ILUOUT,*) TRIM(YRECFM),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE
+!callabortstop
+!CALL ABORT
+! STOP
+ LDEPOS_DST(IMI)=.FALSE.
+ END IF !IRESP
+ END DO ! JSV
+ END IF ! ldepos_dst
END IF ! LDUST
IF (LSALT) THEN
@@ -342,11 +419,6 @@ IF(PRESENT(HCHEMFILE)) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
!
- LSLTINIT=.TRUE.
- LSLTPRES=.FALSE.
- CALL POSNAM(ILUDES,'NAM_SALT',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SALT)
- CALL INI_NSV(1)
IMOMENTS = INT(NSV_SLTEND - NSV_SLTBEG+1)/NMODE_SLT
IF (IMOMENTS == 1) THEN
DO JMODE=1, NMODE_SLT
@@ -379,31 +451,32 @@ IF(PRESENT(HCHEMFILE)) THEN
END IF !IRESP
END DO ! JMOM
END DO !JMOD
- END IF !if IMOMENTS
- END IF ! LSALT
- !
- IF (NSV_AEREND>=NSV_AERBEG) THEN
- TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'ppp'
- TZFIELD%CDIR = 'XY'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- !
- DO JSV = NSV_AERBEG,NSV_AEREND
- TZFIELD%CMNHNAME = TRIM(CAERONAMES(JSV-NSV_AERBEG+1))//'T'
- TZFIELD%CLONGNAME = 'MesoNH: '//TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
- IF (IRESP/=0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'GEN','INI_PROG_VAR',TRIM(TZFIELD%CMNHNAME)//' not found in the CHEM file '//TRIM(HCHEMFILE))
+ END IF !if IMOMENTS
+ IF (LDEPOS_SLT(IMI)) THEN
+ IF(.NOT.ALLOCATED(CDESLTNAMES)) THEN
+ ALLOCATE(CDESLTNAMES(NMODE_SLT*2))
+ DO JMODE=1,NMODE_SLT
+ IMODEIDX=JPDUSTORDER(JMODE)
+ CDESLTNAMES(JMODE) = YPDESLT_INI(IMODEIDX)
+ CDESLTNAMES(NMODE_SLT+JMODE) = YPDESLT_INI(NMODE_SLT+IMODEIDX)
+ ENDDO
+ ENDIF
+ DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND
+ YRECFM=TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))//'T'
+ YDIR='XY'
+ CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVT(:,:,:,JSV),IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ IF (IRESP/=0) THEN
+ WRITE(ILUOUT,FMT=9000)
+ WRITE(ILUOUT,*) TRIM(YRECFM),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE
!callabortstop
!CALL ABORT
! STOP
- LORILAM=.FALSE.
- END IF !IRESP
- END DO ! JSV
- END IF
+ LDEPOS_SLT(IMI)=.FALSE.
+ END IF !IRESP
+ END DO ! JSV
+ ENDIF ! ldepos_slt
+ END IF ! LSALT
!
CALL IO_FILE_CLOSE_ll(TZCHEMFILE)
!
diff --git a/src/MNH/init_aerosol_properties.f90 b/src/MNH/init_aerosol_properties.f90
index 52c9d68f6de7f76d5837576c68624ae6ee0ecac5..c641a8bed0f07ec9ade7428059a122dce7194937 100644
--- a/src/MNH/init_aerosol_properties.f90
+++ b/src/MNH/init_aerosol_properties.f90
@@ -1,3 +1,12 @@
+! ####################
+ MODULE MODI_INIT_AEROSOL_PROPERTIES
+INTERFACE
+ SUBROUTINE INIT_AEROSOL_PROPERTIES
+ END SUBROUTINE INIT_AEROSOL_PROPERTIES
+END INTERFACE
+END MODULE MODI_INIT_AEROSOL_PROPERTIES
+! ####################
+!
! #############################################################
SUBROUTINE INIT_AEROSOL_PROPERTIES
! #############################################################
@@ -108,6 +117,10 @@ IF ( NMOD_CCN .GE. 1 ) THEN
RCCN(:) = (/ 0.0218E-6 , 0.058E-6 , 0.763E-6 /)
LOGSIGCCN(:) = (/ 1.16 , 0.57 , 0.34 /)
RHOCCN(:) = (/ 1500. , 1500. , 1500. /)
+ CASE ('MOCAGE') ! ordre : sulfates, sels marins, BC+O
+ RCCN(:) = (/ 0.01E-6 , 0.05E-6 , 0.008E-6 /)
+ LOGSIGCCN(:) = (/ 0.788 , 0.993 , 0.916 /)
+ RHOCCN(:) = (/ 1000. , 2200. , 1000. /)
CASE DEFAULT
! d'après Jaenicke 1993, aerosols troposphere libre, masse volumique typique
RCCN(:) = (/ 0.0035E-6 , 0.125E-6 , 0.26E-6 /)
@@ -235,6 +248,14 @@ END IF ! NMOD_CCN > 0
!
IF ( NMOD_IFN .GE. 1 ) THEN
SELECT CASE (CIFN_SPECIES)
+ CASE ('MOCAGE')
+ NSPECIE = 4
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/ 0.05E-6 , 3.E-6 , 0.016E-6 , 0.016E-6 /)
+ XSIGMA_IFN = (/ 2.4 , 1.6 , 2.5 , 2.5 /)
+ XRHO_IFN = (/ 2650. , 2650. , 1000. , 1000. /)
CASE ('MACC_JPP')
! sea-salt, sulfate, hydrophilic (GADS data)
! 2 species, dust-metallic and hydrophobic (as BC)
@@ -299,6 +320,15 @@ IF ( NMOD_IFN .GE. 1 ) THEN
XFRAC(2,2)=0.0
XFRAC(3,2)=0.5
XFRAC(4,2)=0.5
+ CASE ('MOCAGE')
+ XFRAC(1,1)=1.
+ XFRAC(2,1)=0.
+ XFRAC(3,1)=0.
+ XFRAC(4,1)=0.
+ XFRAC(1,2)=0.
+ XFRAC(2,2)=0.
+ XFRAC(3,2)=0.7
+ XFRAC(4,2)=0.3
CASE DEFAULT
XFRAC(1,:)=0.6
XFRAC(2,:)=0.009
diff --git a/src/MNH/isofwd.f b/src/MNH/isofwd.f
index 800f81e7080a59347c39b5a795b8d454eb399634..8e030d139b1e5cdff482e8b5611df8651d8845ed 100644
--- a/src/MNH/isofwd.f
+++ b/src/MNH/isofwd.f
@@ -19,6 +19,7 @@ C THE AMBIENT RELATIVE HUMIDITY.
C
C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
C *** WRITTEN BY ATHANASIOS NENES
+C J.Escobar : 10/2017 , for real*4 replace DOUBLE => REAL
C
C=======================================================================
C
@@ -474,7 +475,7 @@ C
DO 10 I=1,NDIV
X2 = MAX(X1-DX, OMELO)
Y2 = FUNCA2 (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -490,7 +491,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCA2 (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -760,7 +761,7 @@ C
DO 10 I=1,NDIV
Z2 = Z1+DZ
Y2 = FUNCB3A (Z2, TLC, TNH42S4)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
Z1 = Z2
Y1 = Y2
10 CONTINUE
@@ -794,7 +795,7 @@ C
20 DO 30 I=1,MAXIT
Z3 = 0.5*(Z1+Z2)
Y3 = FUNCB3A (Z3, TLC, TNH42S4)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
Z2 = Z3
ELSE
@@ -1127,7 +1128,7 @@ C
DO 10 I=1,NDIV
X2 = X1-DX
Y2 = FUNCB2B (X2,TNH4HS4,TLC)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -1161,7 +1162,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCB2B (X3,TNH4HS4,TLC)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -1496,7 +1497,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCC1 (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2) .LT. ZERO) GOTO 20 ! (Y1*Y2 .LT. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2) .LT. ZERO) GOTO 20 ! (Y1*Y2 .LT. ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -1528,7 +1529,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCC1 (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -1672,7 +1673,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCD3 (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -1719,7 +1720,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCD3 (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -1890,7 +1891,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCD2 (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) THEN
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) THEN
C
C This is done, in case if Y(PSI4LO)>0, but Y(PSI4LO+DX) < 0 (i.e.undersat)
C
@@ -1942,7 +1943,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCD2 (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -2213,7 +2214,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCG5A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -2228,7 +2229,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCG5A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -2315,7 +2316,7 @@ C
C
CCC IF(CHI4.GT.TINY) THEN
IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
- BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
+ BB =-(CHI4 + PSI6 + PSI5 + 1./A4)
CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01
PSI4 =0.5d0*(-BB - SQRT(DD))
@@ -2420,7 +2421,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCG4A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -2435,7 +2436,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCG4A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -2522,7 +2523,7 @@ C
C
CCC IF(CHI4.GT.TINY) THEN
IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
- BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
+ BB =-(CHI4 + PSI6 + PSI5 + 1./A4)
CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma shankar, 19/11/2001
PSI4 =0.5d0*(-BB - SQRT(DD))
@@ -2706,7 +2707,7 @@ C
X2 = X1+DX
Y2 = FUNCG3A (X2)
C
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -2721,7 +2722,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCG3A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -2827,7 +2828,7 @@ C
C
CCC IF(CHI4.GT.TINY) THEN
IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
- BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
+ BB =-(CHI4 + PSI6 + PSI5 + 1./A4)
CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01
PSI4 =0.5d0*(-BB - SQRT(DD))
@@ -3006,7 +3007,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCG2A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -3021,7 +3022,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCG2A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -3443,7 +3444,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCH6A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -3458,7 +3459,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCH6A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -3547,7 +3548,7 @@ C
PSI5 = MAX(PSI5, TINY)
C
IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
- BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
+ BB =-(CHI4 + PSI6 + PSI5 + 1./A4)
CC = CHI4*(PSI5+PSI6)
DD = BB*BB-4.d0*CC
PSI4 =0.5d0*(-BB - SQRT(DD))
@@ -3660,7 +3661,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCH5A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -3675,7 +3676,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCH5A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -3764,7 +3765,7 @@ C
PSI5 = MAX(PSI5, TINY)
C
IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
- BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
+ BB =-(CHI4 + PSI6 + PSI5 + 1./A4)
CC = CHI4*(PSI5+PSI6)
DD = BB*BB-4.d0*CC
PSI4 =0.5d0*(-BB - SQRT(DD))
@@ -3889,7 +3890,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCH4A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -3904,7 +3905,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCH4A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -3993,7 +3994,7 @@ C
PSI5 = MAX(PSI5, TINY)
C
IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
- BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
+ BB =-(CHI4 + PSI6 + PSI5 + 1./A4)
CC = CHI4*(PSI5+PSI6)
DD = BB*BB-4.d0*CC
PSI4 =0.5d0*(-BB - SQRT(DD))
@@ -4143,7 +4144,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCH3A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -4158,7 +4159,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCH3A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -4247,7 +4248,7 @@ C
PSI5 = MAX(PSI5, TINY)
C
IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
- BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
+ BB =-(CHI4 + PSI6 + PSI5 + 1./A4)
CC = CHI4*(PSI5+PSI6)
DD = BB*BB-4.d0*CC
PSI4 =0.5d0*(-BB - SQRT(DD))
@@ -4452,7 +4453,7 @@ C
DO 10 I=1,NDIV
X2 = X1+DX
Y2 = FUNCH2A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -4467,7 +4468,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCH2A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -4558,7 +4559,7 @@ C
PSI5 = MAX(PSI5, TINY)
C
IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
- BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
+ BB =-(CHI4 + PSI6 + PSI5 + 1./A4)
CC = CHI4*(PSI5+PSI6)
DD = BB*BB-4.d0*CC
PSI4 =0.5d0*(-BB - SQRT(DD))
@@ -4996,7 +4997,7 @@ C
DO 10 I=1,NDIV
X2 = X1-DX
Y2 = FUNCI5A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -5019,7 +5020,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCI5A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -5187,7 +5188,7 @@ C
DO 10 I=1,NDIV
X2 = X1-DX
Y2 = FUNCI4A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -5210,7 +5211,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCI4A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -5439,7 +5440,7 @@ C
DO 10 I=1,NDIV
X2 = MAX(X1-DX, PSI2LO)
Y2 = FUNCI3A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -5454,7 +5455,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCI3A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -5533,7 +5534,7 @@ C
DO 10 I=1,NDIV
X2 = MAX(X1-DX, PSI4LO)
Y2 = FUNCI3B (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -5548,7 +5549,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCI3B (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -5782,7 +5783,7 @@ C
DO 10 I=1,NDIV
X2 = MAX(X1-DX, PSI2LO)
Y2 = FUNCI2A (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -5797,7 +5798,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCI2A (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -6154,7 +6155,7 @@ C
DO 10 I=1,NDIV
X2 = X1-DX
Y2 = FUNCJ2 (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -6177,7 +6178,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCJ2 (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
@@ -6325,7 +6326,7 @@ C
DO 10 I=1,NDIV
X2 = X1-DX
Y2 = FUNCJ1 (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -6348,7 +6349,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCJ1 (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
diff --git a/src/MNH/isorev.f b/src/MNH/isorev.f
index 8fbddd50e598fc2fac07cb518957f438bd3ea54d..f4588f11c4246a7bcc1b4f82159d00fafff15efb 100644
--- a/src/MNH/isorev.f
+++ b/src/MNH/isorev.f
@@ -19,6 +19,7 @@ C THE AMBIENT RELATIVE HUMIDITY.
C
C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
C *** WRITTEN BY ATHANASIOS NENES
+C J.Escobar : 10/2017 , for real*4 replace DOUBLE => REAL
C
C=======================================================================
C
@@ -775,7 +776,7 @@ C
DO 10 I=1,NDIV
X2 = MAX(X1-DX, ZERO)
Y2 = FUNCN2 (X2)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
X1 = X2
Y1 = Y2
10 CONTINUE
@@ -809,7 +810,7 @@ C
20 DO 30 I=1,MAXIT
X3 = 0.5*(X1+X2)
Y3 = FUNCN2 (X3)
- IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
+ IF (SIGN(1.,Y1)*SIGN(1.,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
Y2 = Y3
X2 = X3
ELSE
diff --git a/src/MNH/lima_cold_hom_nucl.f90 b/src/MNH/lima_cold_hom_nucl.f90
index fccb8e7f0debc4886334daf706cad8d120a04c40..3d0231c7cd0690afdd29f7327f59b8a9bcf66622 100644
--- a/src/MNH/lima_cold_hom_nucl.f90
+++ b/src/MNH/lima_cold_hom_nucl.f90
@@ -378,7 +378,7 @@ IF (INEGT.GT.0) THEN
ALLOCATE(ZTAU(INEGT))
ALLOCATE(ZBFACT(INEGT))
!
- WHERE( (ZZT(:)<XTT-35.0) .AND. (ZSI(:)>ZZY(:)) .AND. (ZTHS(:)<-1.0E-6) )
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZSI(:)>ZZY(:)) )
ZLS(:) = XLSTT+(XCPV-XCI)*ZTCELSIUS(:) ! Ls
!
ZPSI1(:) = ZZY(:) * (XG/(XRD*ZZT(:)))*(ZEPS*ZLS(:)/(XCPD*ZZT(:))-1.)
@@ -418,7 +418,7 @@ IF (INEGT.GT.0) THEN
PNFS(:,:,:,JMOD_CCN)=UNPACK( ZNFS(:,JMOD_CCN), MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:))
END DO
ZZNHS(:) = ZZNHS(:) + ZZX(:)
- ZNHS(:,:,:) = ZNHS(:,:,:) + UNPACK( ZZNHS(:), MASK=GNEGT(:,:,:),FIELD=0.0)
+ ZNHS(:,:,:) = UNPACK( ZZNHS(:), MASK=GNEGT(:,:,:),FIELD=0.0)
PNHS(:,:,:) = ZNHS(:,:,:)
!
DEALLOCATE(ZFREECCN)
@@ -456,6 +456,9 @@ IF (INEGT.GT.0) THEN
CALL BUDGET ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
END DO
+ CALL BUDGET ( UNPACK(ZZNHS(:),MASK=GNEGT(:,:,:),FIELD=ZNHS(:,:,:))*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV')
+
END IF
END IF
END IF
@@ -522,7 +525,7 @@ IF (INEGT.GT.0) THEN
! Compute the drop homogeneous nucleation source: RRHONG
!
ZZW(:) = 0.0
- WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRS(:)>0.) )
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) )
ZZW(:) = ZRRS(:) ! Instantaneous freezing of the raindrops
ZRRS(:) = ZRRS(:) - ZZW(:)
ZRGS(:) = ZRGS(:) + ZZW(:)
@@ -657,11 +660,13 @@ ELSE
ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
IF( OHHONI ) CALL BUDGET (ZW,12+NSV_LIMA_NI,'HONH_BU_RSV')
CALL BUDGET (ZW,12+NSV_LIMA_NI,'HONC_BU_RSV')
- IF (NMOD_CCN.GE.1) THEN
+ IF (NMOD_CCN.GE.1 .AND. OHHONI) THEN
DO JL=1, NMOD_CCN
- CALL BUDGET ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
- 12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
+ ZW(:,:,:) = PNFS(:,:,:,JL)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
END DO
+ ZW(:,:,:) = ZNHS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV')
END IF
END IF
END IF
diff --git a/src/MNH/lima_cold_slow_processes.f90 b/src/MNH/lima_cold_slow_processes.f90
index 963a2b926d28346e4ad678afb99fd844e778e98d..4ee8c4659a3a188273f05f9f1b6b97446864f7b5 100644
--- a/src/MNH/lima_cold_slow_processes.f90
+++ b/src/MNH/lima_cold_slow_processes.f90
@@ -325,7 +325,7 @@ IF( IMICRO >= 1 ) THEN
! ----------------------------------------
!
!
- WHERE ( ZRST(:)>0.0 )
+ WHERE ( ZRST(:)>XRTMIN(5) )
ZLBDAS(:) = MIN( XLBDAS_MAX, &
XLBS*( ZRHODREF(:)*MAX( ZRST(:),XRTMIN(5) ) )**XLBEXS )
END WHERE
@@ -365,7 +365,7 @@ IF( IMICRO >= 1 ) THEN
!
!
ZZW(:) = 0.0
- WHERE ( (ZRST(:)>0.0) .AND. (ZRSS(:)>0.0) )
+ WHERE ( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>ZRTMIN(5)) )
!Correction BVIE rhodref
! ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
ZZW(:) = ( ZSSI(:)/(ZAI(:)) ) * &
@@ -431,8 +431,8 @@ IF( IMICRO >= 1 ) THEN
! ---------------------------------------------------
!
!
- WHERE ( (ZRIT(:)>XRTMIN(4)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRIS(:)>0.0) &
- .AND. (ZCIS(:)>0.0) )
+ WHERE ( (ZRIT(:)>XRTMIN(4)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRIS(:)>ZRTMIN(4)) &
+ .AND. (ZCIS(:)>ZCTMIN(4)) )
ZZW1(:,3) = (ZLBDAI(:) / ZLBDAS(:))**3
ZZW1(:,1) = (ZCIT(:)*(XCCS*ZLBDAS(:)**XCXS)*EXP( XCOLEXIS*(ZZT(:)-XTT) )) &
/ (ZLBDAI(:)**3)
diff --git a/src/MNH/lima_mixed.f90 b/src/MNH/lima_mixed.f90
index ea9c1bee549e190583a609eec422a3853e700e9b..2d6fae1c3c8106a455e7bcfb7f662ead97b64df2 100644
--- a/src/MNH/lima_mixed.f90
+++ b/src/MNH/lima_mixed.f90
@@ -517,7 +517,7 @@ IF( IMICRO >= 1 ) THEN
!* 2. Compute the slow processes involving cloud water and graupel
! ------------------------------------------------------------
!
- CALL LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, &
+ CALL LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, PTSTEP, &
ZLSFACT, ZLVFACT, ZAI, ZCJ, &
ZRGT, ZCIT, &
ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
diff --git a/src/MNH/lima_mixed_fast_processes.f90 b/src/MNH/lima_mixed_fast_processes.f90
index e7b9d55fe067ad09609fe64550724cc4c056f353..06058f529c6f4b88823437681c02d70e340b65c3 100644
--- a/src/MNH/lima_mixed_fast_processes.f90
+++ b/src/MNH/lima_mixed_fast_processes.f90
@@ -241,7 +241,7 @@ IF (LSNOW) THEN
!
ZZW1(:,:) = 0.0
!
-GRIM(:) = (ZRCT(:)>0.0) .AND. (ZRST(:)>0.0) .AND. (ZRCS(:)>0.0) .AND. (ZZT(:)<XTT)
+GRIM(:) = (ZRCT(:)>XRTMIN(2)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZZT(:)<XTT)
IGRIM = COUNT( GRIM(:) )
!
IF( IGRIM>0 ) THEN
@@ -297,7 +297,7 @@ IF( IGRIM>0 ) THEN
! 1.1.6 riming-conversion of the large sized aggregates into graupeln
!
!
- WHERE ( GRIM(:) .AND. (ZRSS(:)>0.0) )
+ WHERE ( GRIM(:) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) )
ZZW1(:,2) = MIN( ZRCS(:), &
XCRIMSG * ZRCT(:) & ! RCRIMSG
* ZLBDAS(:)**XEXCRIMSG &
@@ -395,7 +395,7 @@ END IF
!
!
ZZW1(:,2:3) = 0.0
-GACC(:) = (ZRRT(:)>0.0) .AND. (ZRST(:)>0.0) .AND. (ZRRS(:)>0.0) .AND. (ZZT(:)<XTT)
+GACC(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) .AND. (ZZT(:)<XTT)
IGACC = COUNT( GACC(:) )
!
IF( IGACC>0 ) THEN
@@ -485,7 +485,7 @@ IF( IGACC>0 ) THEN
! 1.3.6 raindrop accretion-conversion of the large sized aggregates
! into graupeln
!
- WHERE ( GACC(:) .AND. (ZRSS(:)>0.0) )
+ WHERE ( GACC(:) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) )
ZZW1(:,2) = MIN( ZRRS(:),ZZW1(:,2)-ZZW1(:,4) ) ! RRACCSG
ZZW1(:,3) = MIN( ZRSS(:),XFSACCRG*ZZW(:)* & ! RSACCRG
( ZLBDAS(:)**(XCXS-XBS) )*( ZRHODREF(:)**(-XCEXVT-1.) ) &
@@ -531,7 +531,7 @@ END IF
!
!
ZZW(:) = 0.0
-WHERE( (ZRST(:)>0.0) .AND. (ZRSS(:)>0.0) .AND. (ZZT(:)>XTT) )
+WHERE( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) .AND. (ZZT(:)>XTT) )
ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
@@ -577,7 +577,7 @@ END IF ! LSNOW
!
!
ZZW1(:,3:4) = 0.0
-WHERE( (ZRIT(:)>0.0) .AND. (ZRRT(:)>0.0) .AND. (ZRIS(:)>0.0) .AND. (ZRRS(:)>0.0) )
+WHERE( (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) )
ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) * ZCRT(:) & ! RICFRRG
* ZLBDAR(:)**XEXICFRR &
* ZRHODREF(:)**(-XCEXVT-1.0) )
@@ -621,8 +621,8 @@ END IF
!
!
ZZW1(:,:) = 0.0
-WHERE( ((ZRCT(:)>0.0) .AND. (ZRGT(:)>0.0) .AND. (ZRCS(:)>0.0)) .OR. &
- ((ZRIT(:)>0.0) .AND. (ZRGT(:)>0.0) .AND. (ZRIS(:)>0.0)) )
+WHERE( ((ZRCT(:)>XRTMIN(2)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP)) .OR. &
+ ((ZRIT(:)>XRTMIN(4)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP)) )
ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT)
ZZW1(:,1) = MIN( ZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG
ZZW1(:,2) = MIN( ZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) &
@@ -632,7 +632,7 @@ END WHERE
!* 2.2.1 accretion of aggregates on the graupeln
! ----------------------------------------------
!
-GDRY(:) = (ZRST(:)>0.0) .AND. (ZRGT(:)>0.0) .AND. (ZRSS(:)>0.0)
+GDRY(:) = (ZRST(:)>XRTMIN(5)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP)
IGDRY = COUNT( GDRY(:) )
!
IF( IGDRY>0 ) THEN
@@ -696,7 +696,7 @@ END IF
!* 2.2.6 accretion of raindrops on the graupeln
! ---------------------------------------------
!
-GDRY(:) = (ZRRT(:)>0.0) .AND. (ZRGT(:)>0.0) .AND. (ZRRS(:)>0.0)
+GDRY(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRRS(:)>XRTMIN(3))
IGDRY = COUNT( GDRY(:) )
!
IF( IGDRY>0 ) THEN
@@ -765,7 +765,7 @@ ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
!
ZZW(:) = 0.0
ZRWETG(:) = 0.0
-WHERE( ZRGT(:)>0.0 )
+WHERE( ZRGT(:)>XRTMIN(6) )
ZZW1(:,5) = MIN( ZRIS(:), &
ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(ZZT(:)-XTT)) ) ) ! RIWETG
ZZW1(:,6) = MIN( ZRSS(:), &
@@ -965,7 +965,7 @@ END IF
!
!
ZZW(:) = 0.0
-WHERE( (ZRGT(:)>0.0) .AND. (ZRGS(:)>0.0) .AND. (ZZT(:)>XTT) )
+WHERE( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) .AND. (ZZT(:)>XTT) )
ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
@@ -1023,8 +1023,8 @@ IF( IHAIL>0 ) THEN
! ----------------------------
!
ZZW1(:,:) = 0.0
- WHERE( GHAIL(:) .AND. ( (ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>0.0) .OR. &
- (ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>0.0) ) )
+ WHERE( GHAIL(:) .AND. ( (ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>XRTMIN(2)/PTSTEP) .OR. &
+ (ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>XRTMIN(4)/PTSTEP) ) )
ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHODREF(:)**(-XCEXVT)
ZZW1(:,1) = MIN( ZRCS(:),XFWETH * ZRCT(:) * ZZW(:) ) ! RCWETH
ZZW1(:,2) = MIN( ZRIS(:),XFWETH * ZRIT(:) * ZZW(:) ) ! RIWETH
@@ -1033,7 +1033,7 @@ IF( IHAIL>0 ) THEN
!* 3.1.1 accretion of aggregates on the hailstones
! ------------------------------------------------
!
- GWET(:) = GHAIL(:) .AND. (ZRST(:)>XRTMIN(5) .AND. ZRSS(:)>0.0)
+ GWET(:) = GHAIL(:) .AND. (ZRST(:)>XRTMIN(5) .AND. ZRSS(:)>XRTMIN(5)/PTSTEP)
IGWET = COUNT( GWET(:) )
!
IF( IGWET>0 ) THEN
@@ -1096,7 +1096,7 @@ IF( IHAIL>0 ) THEN
!* 3.1.6 accretion of graupeln on the hailstones
! ----------------------------------------------
!
- GWET(:) = GHAIL(:) .AND. (ZRGT(:)>XRTMIN(6) .AND. ZRGS(:)>0.0)
+ GWET(:) = GHAIL(:) .AND. (ZRGT(:)>XRTMIN(6) .AND. ZRGS(:)>XRTMIN(6)/PTSTEP)
IGWET = COUNT( GWET(:) )
!
IF( IGWET>0 ) THEN
@@ -1276,7 +1276,7 @@ END IF
!
IF ( IHAIL>0 ) THEN
ZZW(:) = 0.0
- WHERE( GHAIL(:) .AND. (ZRHS(:)>0.0) .AND. (ZRHT(:)>0.0) .AND. (ZZT(:)>XTT) )
+ WHERE( GHAIL(:) .AND. (ZRHS(:)>XRTMIN(7)/PTSTEP) .AND. (ZRHT(:)>XRTMIN(7)) .AND. (ZZT(:)>XTT) )
ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
diff --git a/src/MNH/lima_mixed_slow_processes.f90 b/src/MNH/lima_mixed_slow_processes.f90
index 85c78adeb68476eb88b3baf7ea0e3974d514ea7a..9146da229d127b36f07b9944bf421369a1404100 100644
--- a/src/MNH/lima_mixed_slow_processes.f90
+++ b/src/MNH/lima_mixed_slow_processes.f90
@@ -3,7 +3,7 @@
! #####################################
!
INTERFACE
- SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, &
+ SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, PTSTEP, &
ZLSFACT, ZLVFACT, ZAI, ZCJ, &
ZRGT, ZCIT, &
ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
@@ -16,6 +16,7 @@ INTERFACE
REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
REAL, DIMENSION(:), INTENT(IN) :: ZSSI ! Supersaturation over ice
+REAL, INTENT(IN) :: PTSTEP ! Time-step
!
REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
@@ -57,7 +58,7 @@ END INTERFACE
END MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
!
! #######################################################################
- SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, &
+ SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, PTSTEP, &
ZLSFACT, ZLVFACT, ZAI, ZCJ, &
ZRGT, ZCIT, &
ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
@@ -128,6 +129,7 @@ IMPLICIT NONE
REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
REAL, DIMENSION(:), INTENT(IN) :: ZSSI ! Supersaturation over ice
+REAL, INTENT(IN) :: PTSTEP ! Time-step
!
REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
@@ -177,7 +179,7 @@ INTEGER :: JMOD_IFN
!
!
ZZW(:) = 0.0
- WHERE ( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>0.0) )
+ WHERE ( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) )
!Correction BVIE RHODREF
! ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
ZZW(:) = ( ZSSI(:)/(ZAI(:)) ) * &
@@ -208,7 +210,7 @@ INTEGER :: JMOD_IFN
!
!
ZMASK(:) = 1.0
- WHERE( (ZRIS(:)>0.0) .AND. (ZZT(:)>XTT) )
+ WHERE( (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZZT(:)>XTT) )
ZRCS(:) = ZRCS(:) + ZRIS(:)
ZTHS(:) = ZTHS(:) - ZRIS(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RIMLTC))
ZRIS(:) = 0.0
@@ -248,7 +250,7 @@ INTEGER :: JMOD_IFN
!
!
ZZW(:) = 0.0
- WHERE( (ZRCS(:)>0.0) .AND. (ZRIS(:)>0.0) .AND. (ZCIT(:)>XCTMIN(4)) )
+ WHERE( (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZCIT(:)>XCTMIN(4)) )
ZZW(:) = EXP( (XALPW-XALPI) - (XBETAW-XBETAI)/ZZT(:) &
- (XGAMW-XGAMI)*ALOG(ZZT(:)) ) -1.0
! supersaturation of saturated water over ice
diff --git a/src/MNH/lima_phillips_integ.f90 b/src/MNH/lima_phillips_integ.f90
index 26a653b6aa49eb579ec67db3433c4aacf305a383..3af3048c6be9e97c9e7f21db12995e446ec2c802 100644
--- a/src/MNH/lima_phillips_integ.f90
+++ b/src/MNH/lima_phillips_integ.f90
@@ -68,7 +68,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: Z_FRAC_ACT
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: JSPECIE, JL
+INTEGER :: JSPECIE, JL, JL2
REAL :: XB
!
REAL, DIMENSION(:), ALLOCATABLE :: ZZX, & ! Work array
@@ -105,11 +105,20 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
! For T warmer than -35°C, the integration is approximated with µ_X << 1
! Error function : GAMMA_INC(1/2, x**2) = ERF(x) !!! for x>=0 !!!
!
- WHERE (ZZT(:)>(XTT-35.) .AND. ZEMBRYO(:)>1.0E-8)
- ZZX(:) = ZZX(:) + ZEMBRYO(:) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
- * EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
- * (1.0+GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
- END WHERE
+! WHERE (ZZT(:)>(XTT-35.) .AND. ZEMBRYO(:)>1.0E-8)
+! ZZX(:) = ZZX(:) + ZEMBRYO(:) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
+! * EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
+! * (1.0+GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
+! END WHERE
+
+ DO JL = 1, SIZE(ZZT)
+ IF (ZZT(JL)>(XTT-35.) .AND. ZEMBRYO(JL)>1.0E-8) THEN
+ ZZX(JL) = ZZX(JL) + ZEMBRYO(JL) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
+ * EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
+ * (1.0+SIGN(1.,SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)*GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
+ END IF
+ ENDDO
+
!
! For other T, integration between 0 and infinity is made with a Gauss-Hermite
! quadrature method and integration between 0 and 0.1 uses e(x) ~ 1+x+O(x**2)
@@ -118,17 +127,28 @@ DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
GINTEG(:) = ZZT(:)<=(XTT-35.) .AND. ZSI(:)>1.0 .AND. ZEMBRYO(:)>1.0E-8
!
DO JL = 1, NDIAM
- WHERE (GINTEG(:))
- ZZX(:) = ZZX(:) - XWEIGHT(JL)*EXP(-ZEMBRYO(:)*XPI*(XMDIAM_IFN(JSPECIE))**2 &
- * EXP(2.0*SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE)) * XABSCISS(JL)) )
- END WHERE
+ DO JL2 = 1, SIZE(GINTEG)
+ IF (GINTEG(JL2)) THEN
+ ZZX(JL2) = ZZX(JL2) - XWEIGHT(JL)*EXP(-ZEMBRYO(JL2)*XPI*(XMDIAM_IFN(JSPECIE))**2 &
+ * EXP(2.0*SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE)) * XABSCISS(JL)) )
+ END IF
+ ENDDO
ENDDO
!
- WHERE (GINTEG(:))
- ZZX(:) = ZZX(:) + 0.5* XPI*ZEMBRYO(:)*(XMDIAM_IFN(JSPECIE))**2 &
- * (1.0-( 1.0-GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) &
- * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) )
- END WHERE
+! DO JL2 = 1, SIZE(GINTEG)
+! IF (GINTEG(JL2)) THEN
+! ZZX(JL2) = ZZX(JL2) + 0.5* XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 &
+! * (1.0-( 1.0-GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) &
+! * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) )
+! END IF
+! ENDDO
+ DO JL2 = 1, SIZE(GINTEG)
+ IF (GINTEG(JL2)) THEN
+ ZZX(JL2) = 1 + ZZX(JL2) &
+ - ( 0.5* XPI*ZEMBRYO(JL2)*(XMDIAM_IFN(JSPECIE))**2 * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
+ * ( 1.0-SIGN(1.,SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)*GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) )
+ END IF
+ ENDDO
!
Z_FRAC_ACT(:,JSPECIE)=ZZX(:)
!
diff --git a/src/MNH/lima_phillips_ref_spectrum.f90 b/src/MNH/lima_phillips_ref_spectrum.f90
index c2fcff11499ec699bf00180846d5ba8072a5241f..d549d7051fc8cb3c43ef7d755fe31da9060dd8b0 100644
--- a/src/MNH/lima_phillips_ref_spectrum.f90
+++ b/src/MNH/lima_phillips_ref_spectrum.f90
@@ -66,7 +66,8 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZMAX, &
ZZY1, &
ZZY2, &
Z1, &
- Z2
+ Z2, &
+ ZSI2
!
REAL :: XPSI
!
@@ -78,25 +79,28 @@ ALLOCATE(ZZY1(SIZE(ZZT))) ; ZZY1(:)= 0.0
ALLOCATE(ZZY2(SIZE(ZZT))) ; ZZY2(:)= 0.0
ALLOCATE(Z1(SIZE(ZZT))) ; Z1(:) = 0.0
ALLOCATE(Z2(SIZE(ZZT))) ; Z2(:) = 0.0
+ALLOCATE(ZSI2(SIZE(ZZT))) ; ZSI2(:)= 0.0
!
ZZY(:) = 0.0
!
XPSI = 0.058707*XGAMMA/XRHO_CFDC
!
+ZSI2(:)=min(ZSI(:),ZSI_W(:))
+!
WHERE( ZSI(:)>1.0 )
!
!* T <= -35 C
!
ZZY(:) =1000.*XGAMMA/XRHO_CFDC &
- * ( EXP(12.96*(MIN(ZSI(:),7.)-1.1)) )**0.3 &
+ * ( EXP(12.96*(MIN(ZSI2(:),7.)-1.1)) )**0.3 &
* RECT(1.,0.,ZZT(:),(XTT-80.),(XTT-35.))
!
!* -35 C < T <= -25 C (in Appendix A)
!
ZZY1(:) =1000.*XGAMMA/XRHO_CFDC &
- * ( EXP(12.96*(MIN(ZSI(:),7.)-1.1)) )**0.3
+ * ( EXP(12.96*(MIN(ZSI2(:),7.)-1.1)) )**0.3
ZZY2(:) =1000.*XPSI &
- * EXP(12.96*(MIN(ZSI(:),7.)-1.0)-0.639)
+ * EXP(12.96*(MIN(ZSI2(:),7.)-1.0)-0.639)
!
!* -35 C < T <= -30 C
!
@@ -115,7 +119,7 @@ WHERE( ZSI(:)>1.0 )
!* T > -25 C
!
ZZY(:) = ZZY(:) + 1000.*XPSI &
- * EXP( 12.96*(MIN(ZSI(:),7.)-1.0)-0.639 ) &
+ * EXP( 12.96*(MIN(ZSI2(:),7.)-1.0)-0.639 ) &
* RECT(1.,0.,ZZT(:),(XTT-25.),(XTT-2.))
END WHERE
!
diff --git a/src/MNH/lima_warm.f90 b/src/MNH/lima_warm.f90
index 6c3562aea68f8d2a552e43292dea622f50d063a5..25715dcb8867bbb47fd16f5b9ac2e98860c16a37 100644
--- a/src/MNH/lima_warm.f90
+++ b/src/MNH/lima_warm.f90
@@ -9,7 +9,7 @@ INTERFACE
PTHM, PRCM, &
PTHT, PRT, PSVT, &
PTHS, PRS, PSVS, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D )
+ PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
!
LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
! activation by radiative
@@ -51,6 +51,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud droplets deposition
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
!
@@ -64,7 +65,7 @@ END MODULE MODI_LIMA_WARM
PTHM, PRCM, &
PTHT, PRT, PSVT, &
PTHS, PRS, PSVS, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D )
+ PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
! ###################################################################
!
!!
@@ -114,6 +115,7 @@ END MODULE MODI_LIMA_WARM
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
+!! J. Escobar : for real*4 , use XMNH_HUGE
!!
!-------------------------------------------------------------------------------
!
@@ -183,6 +185,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud droplets deposition
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
!
@@ -217,6 +220,8 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZWLBDR,ZWLBDR3,ZWLBDC,ZWLBDC3
INTEGER :: JL
!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: GDEP
+!
!-------------------------------------------------------------------------------
!
!
@@ -269,7 +274,7 @@ END IF
! ----------------------------------------
!
!
-ZWLBDC3(:,:,:) = 1.E45
+ZWLBDC3(:,:,:) = XMNH_HUGE
ZWLBDC(:,:,:) = 1.E15
!
WHERE (PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2))
@@ -284,7 +289,11 @@ WHERE (PRRT(:,:,:)>XRTMIN(3) .AND. PCRT(:,:,:)>XCTMIN(3))
ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
END WHERE
ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
-ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
+IF( OACTIT ) THEN
+ ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
+ELSE
+ ZTM(:,:,:) = ZT(:,:,:)
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -298,7 +307,7 @@ CALL LIMA_WARM_SEDIM (OSEDC, KSPLITR, PTSTEP, KMI, &
ZWLBDC, &
PRCT, PRRT, PCCT, PCRT, &
PRCS, PRRS, PCCS, PCRS, &
- PINPRC, PINPRR, &
+ PINPRC, PINPRR, &
PINPRR3D )
!
IF (LBUDGET_RC .AND. OSEDC) &
@@ -311,6 +320,22 @@ IF (LBUDGET_SV) THEN
&'SEDI_BU_RSV') ! RCR
END IF
!
+! 2.bis Deposition at 1st level above ground
+!
+IF (LDEPOC) THEN
+ PINDEP(:,:)=0.
+ GDEP(:,:) = .FALSE.
+ GDEP(:,:) = PRCS(:,:,2) >0 .AND. PCCS(:,:,2) >0
+ WHERE (GDEP)
+ PRCS(:,:,2) = PRCS(:,:,2) - XVDEPOC * PRCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
+ PCCS(:,:,2) = PCCS(:,:,2) - XVDEPOC * PCCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
+ PINDEP(:,:) = XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
+ END WHERE
+!
+ IF ( LBUDGET_RC ) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
+ IF ( LBUDGET_SV ) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'DEPO_BU_RSV')
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -382,7 +407,7 @@ IF (ORAIN) THEN
! --------------------
!
ZWLBDR(:,:,:) = 1.E10
- WHERE (PRRS(:,:,:)>0.0.AND.PCRS(:,:,:)>0.0 )
+ WHERE (PRRS(:,:,:)>XRTMIN(3)/PTSTEP.AND.PCRS(:,:,:)>XCTMIN(3)/PTSTEP )
ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:)
ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
END WHERE
diff --git a/src/MNH/lima_warm_evap.f90 b/src/MNH/lima_warm_evap.f90
index a4881ffb3960b182339dd7729bc2b0294a81d97e..7a26c57c351f57b63658adaeea62cdeaa79861df 100644
--- a/src/MNH/lima_warm_evap.f90
+++ b/src/MNH/lima_warm_evap.f90
@@ -176,7 +176,7 @@ ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
!
GEVAP(:,:,:) = .FALSE.
GEVAP(IIB:IIE,IJB:IJE,IKB:IKE) = &
- PRRS(IIB:IIE,IJB:IJE,IKB:IKE)> 0.0 .AND. &
+ PRRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(3) .AND. &
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)<ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
!
IEVAP = COUNTJV( GEVAP(:,:,:),I1(:),I2(:),I3(:))
diff --git a/src/MNH/lima_warm_nucl.f90 b/src/MNH/lima_warm_nucl.f90
index 7415ceda068af24980b67d1b609cf22e73379b7d..c74c42275f65328dace58c816f9dbec61e183e83 100644
--- a/src/MNH/lima_warm_nucl.f90
+++ b/src/MNH/lima_warm_nucl.f90
@@ -90,6 +90,7 @@ END MODULE MODI_LIMA_WARM_NUCL
!! MODIFICATIONS
!! -------------
!! Original ??/??/13
+!! J. Escobar : 10/2017 , for real*4 use XMNH_EPSILON
!!
!-------------------------------------------------------------------------------
!
@@ -161,6 +162,7 @@ REAL, DIMENSION(:) , ALLOCATABLE :: ZZT ! Temperature
REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, &
ZCTMIN, &
ZZTDT, & ! dT/dt
+ ZSW, & ! real supersaturation
ZSMAX, & ! Maximum supersaturation
ZVEC1
!
@@ -219,8 +221,11 @@ IF (OACTIT) THEN
ZDRC(:,:,:) = PRCS(:,:,:)-(PRCT(:,:,:)/PTSTEP) ! drc/dt
!!! JPP
!!! JPP
- ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
- (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))*ZDRC(:,:,:)/XCPD)
+!!
+!! BV - W and drc/dt effect should not be included in ZTDT (already accounted for in the computations) ?
+!!
+!! ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
+!! (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))*ZDRC(:,:,:)/XCPD)
END IF
!
! find locations where CCN are available
@@ -259,6 +264,7 @@ IF( INUCT >= 1 ) THEN
ALLOCATE(ZCCS(INUCT))
ALLOCATE(ZZT(INUCT))
ALLOCATE(ZZTDT(INUCT))
+ ALLOCATE(ZSW(INUCT))
ALLOCATE(ZZW1(INUCT))
ALLOCATE(ZZW2(INUCT))
ALLOCATE(ZZW3(INUCT))
@@ -276,6 +282,7 @@ IF( INUCT >= 1 ) THEN
ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
ZZTDT(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
+ ZSW(JL) = PRVT(I1(JL),I2(JL),I3(JL))/ZRVSAT(I1(JL),I2(JL),I3(JL)) - 1.
ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
DO JMOD = 1,NMOD_CCN
@@ -371,6 +378,7 @@ IF( INUCT >= 1 ) THEN
ZXACC = 1.0E-7 ! Accuracy needed for the search in [NO UNITS]
!
ZSMAX(:) = ZRIDDR(ZS1,ZS2,ZXACC,ZZW3(:),INUCT) ! ZSMAX(:) is in [NO UNITS]
+ ZSMAX(:) = MIN(MAX(ZSMAX(:), ZSW(:)),ZS2)
!
!
!-------------------------------------------------------------------------------
@@ -478,6 +486,7 @@ IF( INUCT >= 1 ) THEN
DEALLOCATE(ZZW5)
DEALLOCATE(ZZW6)
DEALLOCATE(ZZTDT)
+ DEALLOCATE(ZSW)
DEALLOCATE(ZRHODREF)
DEALLOCATE(ZCHEN_MULTI)
DEALLOCATE(ZEXNREF)
@@ -612,7 +621,6 @@ DO JL = 1, NPTS
PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
go to 100
- print*, 'PZRIDDR: never get here'
STOP
end if
if (abs(xh-xl) <= PXACC) then
@@ -625,7 +633,6 @@ DO JL = 1, NPTS
!!$ endif
!!SB
end do
- print*, 'PZRIDDR: exceeded maximum iterations',j
STOP
else if (fl(JL) == 0.0) then
PZRIDDR(JL)=PX1
@@ -728,7 +735,7 @@ INTEGER :: PIVEC1
ALLOCATE(PFUNCSMAX(NPTS))
!
PFUNCSMAX(:) = 0.
-PZVEC1 = MAX( 1.00001,MIN( FLOAT(NHYP)-0.00001, &
+PZVEC1 = MAX( ( 1.0 + 10.0 * XMNH_EPSILON ) ,MIN( FLOAT(NHYP)*( 1.0 - 10.0 * XMNH_EPSILON ) , &
XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
PIVEC1 = INT( PZVEC1 )
PZVEC1 = PZVEC1 - FLOAT( PIVEC1 )
diff --git a/src/MNH/mnh2lpdm.f90 b/src/MNH/mnh2lpdm.f90
index bfbe25bfa095b9c87adaeb1180c38b10c489c11f..b8a7d9c8875dda68bd1093575148c2c97ef00b8f 100644
--- a/src/MNH/mnh2lpdm.f90
+++ b/src/MNH/mnh2lpdm.f90
@@ -29,10 +29,14 @@ USE MODD_IO_ll,ONLY : TPTR2FILE
USE MODE_FM
USE MODE_IO_ll
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+USE MODE_MODELN_HANDLER
+USE MODE_POS
!
USE MODI_MNH2LPDM_INI
USE MODI_MNH2LPDM_ECH
!
+USE MODN_CONFIO
+!
!
!* 0.2 Variables locales.
!
@@ -42,6 +46,7 @@ CHARACTER(LEN=28) :: YFNML,YFLOG ! Nom NAMELIST et LOG.
INTEGER :: IFNML,IFLOG ! Unite NAMELIST et LOG.
INTEGER :: IFMTO,IFGRI,IFDAT ! Unite METEO et GRILLE.
INTEGER :: IREP,IVERB,JFIC
+LOGICAL :: GFOUND ! Return code when searching namelist
TYPE(TPTR2FILE),DIMENSION(JPMNHMAX) :: TZFMNH ! MesoNH files
!
!
@@ -50,6 +55,9 @@ TYPE(TPTR2FILE),DIMENSION(JPMNHMAX) :: TZFMNH ! MesoNH files
!* 1. INITIALISATION.
! ---------------
!
+CPROGRAM='M2LPDM'
+CALL GOTO_MODEL(1)
+!
!* 1.1 Variables generales.
!
YFLOG = 'METEO.log'
@@ -60,7 +68,7 @@ IVERB = 5
!
!* 1.2 Initialisation routines LL.
!
-CALL INITIO_LL
+CALL INITIO_ll()
!
!
!* 1.3 Ouverture du fichier log.
@@ -77,6 +85,12 @@ print *,'Ouverture fichier Namlist OK'
READ(UNIT=IFNML,NML=NAM_TURB)
READ(UNIT=IFNML,NML=NAM_FIC)
print *,'Lecture de NAM_FIC OK.'
+
+CALL POSNAM(IFNML,'NAM_CONFIO',GFOUND)
+IF (GFOUND) THEN
+ READ(UNIT=IFNML,NML=NAM_CONFIO)
+END IF
+CALL SET_CONFIO_ll(.FALSE., .FALSE., .FALSE.)
CALL CLOSE_LL(YFNML,IREP,'KEEP')
!
!
diff --git a/src/MNH/mnh2lpdm_ini.f90 b/src/MNH/mnh2lpdm_ini.f90
index ab70fd32b9eb9257035b1f59fb253ca79d09e624..2f559062e311c06f7451fbf7ac9a5fc157db7181 100644
--- a/src/MNH/mnh2lpdm_ini.f90
+++ b/src/MNH/mnh2lpdm_ini.f90
@@ -223,9 +223,11 @@ NSJMAX = NSJE-NSJB+1
! -------------------------------
!
! Domaine horizontal Meso-NH.
+!modif 12.2014 : passage a 1 seul domaine MesoNH
! ---------------------------
WRITE(KFLOG,'(I1,a12)') IGRILLE,' ngrid '
-WRITE(KFLOG,'(a13)') '2 ngrids'
+!WRITE(KFLOG,'(a13)') '2 ngrids'
+WRITE(KFLOG,'(a13)') '1 ngrids'
WRITE(KFLOG,'(i4,3x,a6)') NSIMAX,'nx '
WRITE(KFLOG,'(i4,3x,a6)') NSJMAX,'ny '
WRITE(KFLOG,'(i4,3x,a6)') NKU-2,'nz '
@@ -390,9 +392,13 @@ WRITE(KFLOG,*)' =================================================='
WRITE(KFLOG,*) 'TERRAIN TOPOGRAPHY'
c=1
a=0
-300 format(i2,'|',18i4)
-400 format(i2,'|',18(f4.2))
-301 format(3x,18('__',i2))
+!modif 12/2014 : passage a une grille haute resolution MesoNH, on depasse 99
+!300 format(i2,'|',18i4)
+300 format(i3,'|',18i5)
+!400 format(i2,'|',18(f4.2))
+!400 format(i3,'|',18(f5.2))
+!301 format(3x,18('__',i2))
+301 format(3x,18('__',i3))
ALLOCATE(TAB2D(NSIMAX,NSJMAX))
ALLOCATE(TAB1D(NSIMAX))
DO I=1,NSIMAX
diff --git a/src/MNH/modd_ch_flxn.f90 b/src/MNH/modd_ch_flxn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..47c729a93a24003e3a3b7871975de0cb25e07a9f
--- /dev/null
+++ b/src/MNH/modd_ch_flxn.f90
@@ -0,0 +1,66 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/modd_ch_flxn.f90,v $ $Revision: 1.1 $
+! MASDEV5_2 modd 2016/06/27 14:05:40
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODD_CH_FLX_n
+! ######################
+!
+!!
+!! PURPOSE
+!! -------
+! Save the net surface flux at the surface
+! for output with diag
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!
+!! AUTHOR
+!! ------
+!! P. Tulet *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! 12/07/16 (M. Leriche) keep only the flux
+!!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+
+TYPE CH_FLX_t
+!
+ REAL, DIMENSION(:,:,:), POINTER :: XCHFLX=>NULL() ! chemical fluxes ppp.m/s at t
+!
+END TYPE CH_FLX_t
+
+TYPE(CH_FLX_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: CH_FLX_MODEL
+
+REAL, DIMENSION(:,:,:), POINTER :: XCHFLX=>NULL()
+
+CONTAINS
+
+SUBROUTINE CH_FLX_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+CH_FLX_MODEL(KFROM)%XCHFLX=>XCHFLX
+!
+! Current model is set to model KTO
+XCHFLX=>CH_FLX_MODEL(KTO)%XCHFLX
+
+END SUBROUTINE CH_FLX_GOTO_MODEL
+
+END MODULE MODD_CH_FLX_n
diff --git a/src/MNH/modd_cst.f90 b/src/MNH/modd_cst.f90
index a0c5f441a54e314a268f1f7ea5d8340047780136..0becaf15d7402f8c460d16f69a05b4630bfb6301 100644
--- a/src/MNH/modd_cst.f90
+++ b/src/MNH/modd_cst.f90
@@ -41,6 +41,7 @@
!! V. Masson 05/10/98 add XRHOLI
!! C. Mari 31/10/00 add NDAYSEC
!! V. Masson 01/03/03 add conductivity of ice
+!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -93,7 +94,8 @@ INTEGER, SAVE :: NDAYSEC ! Number of seconds in a day
REAL,SAVE :: XMNH_TINY ! minimum real on this machine
REAL,SAVE :: XMNH_TINY_12 ! sqrt(minimum real on this machine)
REAL,SAVE :: XMNH_EPSILON ! minimum space with 1.0
-REAL,SAVE :: XMNH_HUGE ! minimum real on this machine
+REAL,SAVE :: XMNH_HUGE ! maximum real on this machine
+REAL,SAVE :: XMNH_HUGE_12_LOG ! maximum log(sqrt(real)) on this machine
REAL,SAVE :: XEPS_DT ! default value for DT test
REAL,SAVE :: XRES_FLAT_CART ! default flat&cart residual tolerance
diff --git a/src/MNH/modd_diag_flag.f90 b/src/MNH/modd_diag_flag.f90
index 589faa6df032df5846db417b5a870e466400e5cb..fda235d7a4d8fdeb005dde66660cd6a9c66ce8ff 100644
--- a/src/MNH/modd_diag_flag.f90
+++ b/src/MNH/modd_diag_flag.f90
@@ -39,6 +39,7 @@
!! D.Ricard 2015 : add LMOIST_ES
!! C.Lac 10/2016 Add visibility diagnostic
!! 10/2016 (F Brosse) Add prod/loss terms computation for chemistry
+!! 10/2017 (G.Delautier) New boundary layer height : replace LBLTOP by CBLTOP
!!
!-------------------------------------------------------------------------------
!
@@ -92,7 +93,7 @@ REAL, DIMENSION(2) :: XMEAN_PR
INTEGER :: NCAPE ! CAPE, DCAPE, CIN, CAPEMAX, CINMAX
LOGICAL :: LBV_FR
LOGICAL :: LRADAR
-LOGICAL :: LBLTOP
+CHARACTER (LEN=5) :: CBLTOP
LOGICAL :: LVISI
LOGICAL :: LTRAJ ! to compute trajectories
LOGICAL :: LCHEMDIAG = .FALSE. ! flag for chemistry
diff --git a/src/MNH/modd_frc.f90 b/src/MNH/modd_frc.f90
index 82eeabe7eff36480d9b471019280924c1d1d2c4b..a2dfc1c56630e513f63397f422411fa00967675e 100644
--- a/src/MNH/modd_frc.f90
+++ b/src/MNH/modd_frc.f90
@@ -49,6 +49,7 @@
!! 27/01/98 P. Bechtold use tendency forcing
!! add SST and surface pressure forcing
!! 01/2004 V. Masson surface externalization: removes SST forcing
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -79,6 +80,8 @@ REAL, SAVE :: XUTRANS, &! horizontal components of
XVTRANS ! a constant
! Galilean TRANSlation
REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XPGROUNDFRC! surf. pressure
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTENDUFRC ! large scale U tendency
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTENDVFRC ! large scale V tendency
!
!* control parameters for FORCING
! ------------------------------
@@ -86,6 +89,7 @@ REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XPGROUNDFRC! surf. pressure
LOGICAL, SAVE :: LGEOST_UV_FRC ! enables geostrophic wind term
LOGICAL, SAVE :: LGEOST_TH_FRC ! enables thermal wind advection
LOGICAL, SAVE :: LTEND_THRV_FRC ! enables tendency forcing
+LOGICAL, SAVE :: LTEND_UV_FRC ! enables tendency forcing of the wind
LOGICAL, SAVE :: LVERT_MOTION_FRC ! enables prescribed a forced vertical
! transport for all prognostic variables
LOGICAL, SAVE :: LRELAX_THRV_FRC ! enables temp. and humidity relaxation
diff --git a/src/MNH/modd_param_lima.f90 b/src/MNH/modd_param_lima.f90
index cf0a66ff2ae63e4ef0b6c242378afabf1288872d..6c90b2dfa50ce24ece881fc833b20c0f6b8fec39 100644
--- a/src/MNH/modd_param_lima.f90
+++ b/src/MNH/modd_param_lima.f90
@@ -118,6 +118,7 @@ LOGICAL, SAVE :: LACTIT ! TRUE to enable the usage of dT/dt in CCN activa
LOGICAL, SAVE :: LBOUND ! TRUE to enable the continuously replenishing
! aerosol concentrations through the open
! lateral boundaries -> boundaries.f90
+LOGICAL, SAVE :: LDEPOC ! Deposition of rc at 1st level above ground
!
! 2.2 CCN initialisation
!
@@ -148,6 +149,10 @@ REAL,SAVE :: XFSOLUB_CCN, & ! Fractionnal solubility of the CC
XACTEMP_CCN, & ! Expected temperature of CCN activation
XAERDIFF, XAERHEIGHT ! For the vertical gradient of aerosol distribution
!
+! Cloud droplet deposition
+!
+REAL, SAVE :: XVDEPOC
+!
!-------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 7e93c673c54fc7b274209798c589de12fd390c7b..ef3807e70cacfd36847f7162e0412d984f7ca348 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -246,6 +246,9 @@ END MODULE MODI_MODEL_n
!! _ Add droplet deposition
!! 10/2016 (M.Mazoyer) New KHKO output fields
!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 10/2017 (C.Lac) Necessity to have chemistry processes as
+!! the las process modifying XRSVS
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -315,10 +318,15 @@ USE MODD_SERIES_n, ONLY: NFREQSERIES
USE MODD_CH_AERO_n, ONLY: XSOLORG, XMI
USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX,LUSECHAQ,LUSECHIC, &
LCH_INIT_FIELD
+USE MODD_DUST, ONLY: LDUST
+USE MODD_SALT, ONLY: LSALT
USE MODD_CST, ONLY: XMD
USE MODD_NUDGING_n
USE MODD_PARAM_MFSHALL_n
USE MODD_ELEC_DESCR
+USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN
+USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN_C1R3=>XRTMIN
+USE MODD_PARAM_LIMA, ONLY : XRTMIN_LIMA=>XRTMIN
!
USE MODD_CLOUD_MF_n
USE MODI_INITIAL_GUESS
@@ -375,7 +383,11 @@ USE MODI_END_DIAG_IN_RUN
USE MODI_TURB_CLOUD_INDEX
USE MODI_INI_LG
USE MODI_INI_MEAN_FIELD
+USE MODI_CH_MONITOR_n
+USE MODI_AER_MONITOR_n
!
+USE MODE_GRIDCART
+USE MODE_GRIDPROJ
USE MODE_MODELN_HANDLER
!
USE MODD_2D_FRC
@@ -513,6 +525,7 @@ INTEGER :: IGRID ! C-grid indicator in LFIFM file
INTEGER :: ILENCH ! Length of comment string in LFIFM file
!
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZJ
!
! for various testing
INTEGER :: IK
@@ -520,6 +533,12 @@ REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZTMP
!
TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
TYPE(HALO2LIST_ll), POINTER :: TZHALO2C_ll ! list of fields to exchange
+LOGICAL :: GCLD ! conditionnal call for dust wet deposition
+LOGICAL :: GCLOUD_ONLY ! conditionnal radiation computations for
+ ! the only cloudy columns
+REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER) :: ZWETDEPAER
+
+
!
TYPE(TFILEDATA),POINTER :: TZBAKFILE, TZOUTFILE
! TYPE(TFILEDATA),SAVE :: TZDIACFILE
@@ -1095,12 +1114,19 @@ XT_2WAY = XT_2WAY + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(CLUOUT,XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ)
+ XMAP=1.
+ELSE
+ CALL SM_GRIDPROJ(CLUOUT,XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, &
+ XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,ZJ)
+END IF
!
IF ( LFORCING ) THEN
CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
XUFRC_PAST, XVFRC_PAST, &
XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, &
- XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI)
+ XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI,ZJ)
END IF
!
IF ( L2D_ADV_FRC ) THEN
@@ -1301,7 +1327,7 @@ ZTIME1 = ZTIME2
CALL PHYS_PARAM_n(KTCOUNT,TZBAKFILE, GCLOSE_OUT, &
XT_RAD,XT_SHADOWS,XT_DCONV,XT_GROUND,XT_MAFL, &
XT_DRAG,XT_TURB,XT_TRACER, &
- XT_CHEM,ZTIME,GMASKkids)
+ ZTIME,ZWETDEPAER,GMASKkids,GCLOUD_ONLY)
!
IF (CDCONV/='NONE') THEN
XPACCONV = XPACCONV + XPRCONV * XTSTEP
@@ -1461,6 +1487,7 @@ CALL SECOND_MNH2(ZTIME2)
!
XT_ADV = XT_ADV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
!
+!-------------------------------------------------------------------------------
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
@@ -1606,6 +1633,68 @@ CALL SECOND_MNH2(ZTIME2)
XT_PRESS = XT_PRESS + ZTIME2 - ZTIME1 &
- XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
!
+!-------------------------------------------------------------------------------
+!
+!* 20. CHEMISTRY/AEROSOLS
+! ------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (LUSECHEM) THEN
+ CALL CH_MONITOR_n(ZWETDEPAER,KTCOUNT,XTSTEP, ILUOUT, NVERB)
+END IF
+!
+! For inert aerosol (dust and sea salt) => aer_monitor_n
+IF ((LDUST).OR.(LSALT)) THEN
+!
+! tests to see if any cloud exists
+!
+ GCLD=.TRUE.
+ IF (GCLD .AND. NRR.LE.3 ) THEN
+ IF( MAXVAL(XCLDFR(:,:,:)).LE. 1.E-10 .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no clouds
+ END IF
+ END IF
+!
+ IF (GCLD .AND. NRR.GE.4 ) THEN
+ IF( CCLOUD(1:3)=='ICE' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='C3R5' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_C1R3(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='LIMA' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_LIMA(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ END IF
+
+!
+ CALL AER_MONITOR_n(KTCOUNT,XTSTEP, ILUOUT, NVERB, GCLD)
+END IF
+!
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_CHEM = XT_CHEM + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+ZTIME = ZTIME + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+
!-------------------------------------------------------------------------------
!
!* 20. WATER MICROPHYSICS
diff --git a/src/MNH/modn_frc.f90 b/src/MNH/modn_frc.f90
index 0207d75790f1525722aaec799fa08e326a645bd6..685ee4f243d5c526fed26540b16b1cabf6259430 100644
--- a/src/MNH/modn_frc.f90
+++ b/src/MNH/modn_frc.f90
@@ -47,6 +47,7 @@
!! 27/01/98 (P. Bechtold) use tendency forcing
!! add SST and surf pressure forcing
!! 06/2003 (V. Masson) removes SST forcing (externalisation of surface)
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!-------------------------------------------------------------------------------
USE MODD_FRC
!
@@ -55,6 +56,7 @@ IMPLICIT NONE
NAMELIST /NAM_FRC/ LGEOST_UV_FRC , &
LGEOST_TH_FRC , &
LTEND_THRV_FRC , &
+ LTEND_UV_FRC , &
LVERT_MOTION_FRC , &
LRELAX_THRV_FRC , &
LRELAX_UV_FRC , &
diff --git a/src/MNH/modn_param_lima.f90 b/src/MNH/modn_param_lima.f90
index e65579400b844ff1bbd93f61f2301b644ccf3c00..f876e45cbeaf920726b2a4f82b1c8a89eb4a670d 100644
--- a/src/MNH/modn_param_lima.f90
+++ b/src/MNH/modn_param_lima.f90
@@ -24,6 +24,6 @@ NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,&
LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, &
XALPHAC, XNUC, XALPHAR, XNUR, &
XFSOLUB_CCN, XACTEMP_CCN, XAERDIFF, XAERHEIGHT, &
- LSCAV, LAERO_MASS
+ LSCAV, LAERO_MASS, LDEPOC, XVDEPOC
!
END MODULE MODN_PARAM_LIMA
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index f8816f40cc1204dddaa1cf34ef0f13266be10097..b43b5990b3653b45badb49aa0d6c5534e9aba095 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -10,9 +10,8 @@
INTERFACE
!
SUBROUTINE PHYS_PARAM_n(KTCOUNT,TPFILE,OCLOSE_OUT, &
- PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER,PCHEM, &
- PTIME_BU, OMASKkids )
-
+ PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER, &
+ PTIME_BU, PWETDEPAER, OMASKkids,OCLOUD_ONLY )
!
USE MODD_IO_ll, ONLY: TFILEDATA
!
@@ -24,10 +23,13 @@ LOGICAL, INTENT(IN) :: OCLOSE_OUT! conditional closure of the
REAL*8,DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
! time for computing time
-REAL*8,DIMENSION(2), INTENT(INOUT) :: PCHEM ! to store CPU time for chemistry
REAL*8,DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets
! statistics
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWETDEPAER
LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASKkids ! kids domains mask
+LOGICAL, INTENT(OUT) :: OCLOUD_ONLY ! conditionnal radiation computations for
+ ! the only cloudy columns
+ !
END SUBROUTINE PHYS_PARAM_n
!
END INTERFACE
@@ -36,8 +38,8 @@ END MODULE MODI_PHYS_PARAM_n
!
! ######################################################################
SUBROUTINE PHYS_PARAM_n(KTCOUNT,TPFILE,OCLOSE_OUT, &
- PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER,PCHEM, &
- PTIME_BU, OMASKkids )
+ PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER, &
+ PTIME_BU, PWETDEPAER, OMASKkids,OCLOUD_ONLY )
! ######################################################################
!
!!**** *PHYS_PARAM_n * -monitor of the parameterizations used by model _n
@@ -224,6 +226,9 @@ END MODULE MODI_PHYS_PARAM_n
!! 2014 (M.Faivre)
!! 06/2016 (G.Delautier) phasage surfex 8
!! 2016 B.VIE LIMA
+!! M. Leriche 02/2017 Avoid negative fluxes if sv=0 outside the physics domain
+!! C.Lac 10/2017 : ch_monitor and aer_monitor extracted from phys_param
+!! to be called directly by modeln as the last process
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -233,7 +238,8 @@ USE MODE_ll
USE MODE_FM
USE MODE_FMWRIT
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-!
+!
+USE MODD_BLANK
USE MODD_CST
USE MODD_DYN
USE MODD_CONF
@@ -291,8 +297,6 @@ USE MODI_SUNPOS_n
USE MODI_RADIATIONS
USE MODI_CONVECTION
USE MODI_TEMPORAL_DIST
-USE MODI_CH_MONITOR_n
-USE MODI_AER_MONITOR_n
USE MODI_BUDGET
USE MODI_PASPOL
USE MODI_CONDSAMP
@@ -343,9 +347,12 @@ LOGICAL, INTENT(IN) :: OCLOSE_OUT! conditional closure of the
REAL*8,DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
! time for computing time
! statistics
-REAL*8,DIMENSION(2), INTENT(INOUT) :: PCHEM ! to store CPU time for chemistry
REAL*8,DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWETDEPAER
LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASKkids ! kids domains mask
+LOGICAL, INTENT(OUT) :: OCLOUD_ONLY ! conditionnal radiation computations for
+ ! the only cloudy columns
+ !
!
!* 0.2 declarations of local variables
!
@@ -390,7 +397,6 @@ LOGICAL :: GRAD ! conditionnal call for the full radiation
! computations
REAL :: ZRAD_GLOB_ll ! 'real' global parallel mask of 'GRAD'
INTEGER :: INFO_ll ! error report of parallel routines
-LOGICAL :: GCLOUD_ONLY ! conditionnal radiation computations for
! the only cloudy columns
!
REAL*8,DIMENSION(2) :: ZTIME1,ZTIME2,ZTIME3,ZTIME4 ! for computing time analysis
@@ -423,7 +429,6 @@ REAL :: ZINIRADIUSI, ZINIRADIUSJ ! ORILAM initial radius
REAL, DIMENSION(NMODE_DST) :: ZINIRADIUS ! DUST initial radius
REAL, DIMENSION(NMODE_SLT) :: ZINIRADIUS_SLT ! Sea Salt initial radius
REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), SIZE(XRSVS,4)) :: ZRSVS
-REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER) :: ZWETDEPAER
LOGICAL :: GCLD ! conditionnal call for dust wet deposition
! * arrays to store the surface fields before radiation and convection scheme
! calls
@@ -451,7 +456,7 @@ ZTIME3 = 0.0
ZTIME4 = 0.0
PTIME_BU = 0.
ZTIME_LES_MF = 0.0
-ZWETDEPAER(:,:,:,:) = 0.
+PWETDEPAER(:,:,:,:) = 0.
!
!* allocation of variables used in more than one parameterization
!
@@ -576,7 +581,7 @@ CALL SECOND_MNH2(ZTIME1)
!
!
GRAD = .FALSE.
-GCLOUD_ONLY = .FALSE.
+OCLOUD_ONLY = .FALSE.
!
IF (CRAD /='NONE') THEN
!
@@ -591,7 +596,7 @@ IF (CRAD /='NONE') THEN
IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTRAD_CLONLY/XTSTEP))==0 ) THEN
TDTRAD_CLONLY = TDTCUR
GRAD = .TRUE.
- GCLOUD_ONLY = .TRUE.
+ OCLOUD_ONLY = .TRUE.
END IF
END IF
!
@@ -605,14 +610,14 @@ IF (CRAD /='NONE') THEN
IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTRAD/XTSTEP))==0 ) THEN
TDTRAD_FULL = TDTCUR
GRAD = .TRUE.
- GCLOUD_ONLY = .FALSE.
+ OCLOUD_ONLY = .FALSE.
END IF
!
! tests to see if any cloud exists
!
IF (CRAD =='ECMW') THEN
IF (GRAD .AND. NRR.LE.3 ) THEN
- IF( MAXVAL(XCLDFR(:,:,:)).LE. 1.E-10 .AND. GCLOUD_ONLY ) THEN
+ IF( MAXVAL(XCLDFR(:,:,:)).LE. 1.E-10 .AND. OCLOUD_ONLY ) THEN
GRAD = .FALSE. ! only the cloudy verticals would be
! refreshed but there is no clouds
END IF
@@ -621,21 +626,21 @@ IF (CRAD /='NONE') THEN
IF (GRAD .AND. NRR.GE.4 ) THEN
IF( CCLOUD(1:3)=='ICE' )THEN
IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN(2) .AND. &
- MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. GCLOUD_ONLY ) THEN
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. OCLOUD_ONLY ) THEN
GRAD = .FALSE. ! only the cloudy verticals would be
! refreshed but there is no cloudwater and ice
END IF
END IF
IF( CCLOUD=='C3R5' )THEN
IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_C1R3(2) .AND. &
- MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. GCLOUD_ONLY ) THEN
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. OCLOUD_ONLY ) THEN
GRAD = .FALSE. ! only the cloudy verticals would be
! refreshed but there is no cloudwater and ice
END IF
END IF
IF( CCLOUD=='LIMA' )THEN
IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_LIMA(2) .AND. &
- MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. GCLOUD_ONLY ) THEN
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. OCLOUD_ONLY ) THEN
GRAD = .FALSE. ! only the cloudy verticals would be
! refreshed but there is no cloudwater and ice
END IF
@@ -662,7 +667,7 @@ IF( GRAD ) THEN
! -------------------------
!
! Ajout PP
-IF (.NOT. GCLOUD_ONLY .AND. KTCOUNT /= 1) THEN
+IF (.NOT. OCLOUD_ONLY .AND. KTCOUNT /= 1) THEN
IF (LAERO_FT) THEN
CALL AEROZON (XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
NDLON,NFLEV,CAER,NAER,NSTATM, &
@@ -713,7 +718,7 @@ CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
! ----------------------------------------------
!
CASE('ECMW')
- IF (LLES_MEAN) GCLOUD_ONLY=.FALSE.
+ IF (LLES_MEAN) OCLOUD_ONLY=.FALSE.
XRADEFF(:,:,:)=0.0
XSWU(:,:,:)=0.0
XSWD(:,:,:)=0.0
@@ -722,7 +727,7 @@ CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
XDTHRADSW(:,:,:)=0.0
XDTHRADLW(:,:,:)=0.0
CALL RADIATIONS ( OCLOSE_OUT, TPFILE, CLUOUT, &
- LCLEAR_SKY,GCLOUD_ONLY, NCLEARCOL_TM1,CEFRADL, CEFRADI,COPWSW,COPISW,&
+ LCLEAR_SKY,OCLOUD_ONLY, NCLEARCOL_TM1,CEFRADL, CEFRADI,COPWSW,COPISW,&
COPWLW,COPILW, XFUDG, &
NDLON, NFLEV, NRAD_DIAG, NFLUX, NRAD, NAER,NSWB, NSTATM, NRAD_COLNBR,&
ZCOSZEN, XSEA, XCORSOL, &
@@ -733,7 +738,7 @@ CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
!
WRITE(UNIT=ILUOUT,FMT='(" RADIATIONS called for KTCOUNT=",I6, &
- & "with the CLOUD_ONLY option set ",L2)') KTCOUNT,GCLOUD_ONLY
+ & "with the CLOUD_ONLY option set ",L2)') KTCOUNT,OCLOUD_ONLY
!
WHERE( XDIRFLASWD(:,:,1) + XSCAFLASWD(:,:,1) >0. )
XALBUV(:,:) = ( XDIR_ALB(:,:,1) * XDIRFLASWD(:,:,1) &
@@ -963,7 +968,7 @@ IF( CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) THEN
END DO
IF (LORILAM) THEN
DO JSV = NSV_AERBEG,NSV_AEREND
- ZWETDEPAER(:,:,:,JSV-NSV_AERBEG+1) = XDSVCONV(:,:,:,JSV) * XRHODJ(:,:,:)
+ PWETDEPAER(:,:,:,JSV-NSV_AERBEG+1) = XDSVCONV(:,:,:,JSV) * XRHODJ(:,:,:)
XRSVS(:,:,:,JSV) = ZRSVS(:,:,:,JSV)
END DO
END IF
@@ -1293,7 +1298,12 @@ IF ( CTURB == 'TKEL' ) THEN
ZSFRV(IIB-1,:)=ZSFRV(IIB,:)
ZSFU(IIB-1,:)=ZSFU(IIB,:)
ZSFV(IIB-1,:)=ZSFV(IIB,:)
- IF (NSV>0) ZSFSV(IIB-1,:,:)=ZSFSV(IIB,:,:)
+ IF (NSV>0) THEN
+ ZSFSV(IIB-1,:,:)=ZSFSV(IIB,:,:)
+ WHERE ((ZSFSV(IIB-1,:,:).LT.0.).AND.(XSVT(IIB-1,:,IKB,:).EQ.0.))
+ ZSFSV(IIB-1,:,:) = 0.
+ END WHERE
+ ENDIF
ZSFCO2(IIB-1,:)=ZSFCO2(IIB,:)
END IF
IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
@@ -1301,7 +1311,12 @@ IF ( CTURB == 'TKEL' ) THEN
ZSFRV(IIE+1,:)=ZSFRV(IIE,:)
ZSFU(IIE+1,:)=ZSFU(IIE,:)
ZSFV(IIE+1,:)=ZSFV(IIE,:)
- IF (NSV>0) ZSFSV(IIE+1,:,:)=ZSFSV(IIE,:,:)
+ IF (NSV>0) THEN
+ ZSFSV(IIE+1,:,:)=ZSFSV(IIE,:,:)
+ WHERE ((ZSFSV(IIE+1,:,:).LT.0.).AND.(XSVT(IIE+1,:,IKB,:).EQ.0.))
+ ZSFSV(IIE+1,:,:) = 0.
+ END WHERE
+ ENDIF
ZSFCO2(IIE+1,:)=ZSFCO2(IIE,:)
END IF
IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
@@ -1309,7 +1324,12 @@ IF ( CTURB == 'TKEL' ) THEN
ZSFRV(:,IJB-1)=ZSFRV(:,IJB)
ZSFU(:,IJB-1)=ZSFU(:,IJB)
ZSFV(:,IJB-1)=ZSFV(:,IJB)
- IF (NSV>0) ZSFSV(:,IJB-1,:)=ZSFSV(:,IJB,:)
+ IF (NSV>0) THEN
+ ZSFSV(:,IJB-1,:)=ZSFSV(:,IJB,:)
+ WHERE ((ZSFSV(:,IJB-1,:).LT.0.).AND.(XSVT(:,IJB-1,IKB,:).EQ.0.))
+ ZSFSV(:,IJB-1,:) = 0.
+ END WHERE
+ ENDIF
ZSFCO2(:,IJB-1)=ZSFCO2(:,IJB)
END IF
IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
@@ -1317,7 +1337,12 @@ IF ( CTURB == 'TKEL' ) THEN
ZSFRV(:,IJE+1)=ZSFRV(:,IJE)
ZSFU(:,IJE+1)=ZSFU(:,IJE)
ZSFV(:,IJE+1)=ZSFV(:,IJE)
- IF (NSV>0) ZSFSV(:,IJE+1,:)=ZSFSV(:,IJE,:)
+ IF (NSV>0) THEN
+ ZSFSV(:,IJE+1,:)=ZSFSV(:,IJE,:)
+ WHERE ((ZSFSV(:,IJE+1,:).LT.0.).AND.(XSVT(:,IJE+1,IKB,:).EQ.0.))
+ ZSFSV(:,IJE+1,:) = 0.
+ END WHERE
+ ENDIF
ZSFCO2(:,IJE+1)=ZSFCO2(:,IJE)
END IF
!
@@ -1443,67 +1468,6 @@ PMAFL = PMAFL + ZTIME4 - ZTIME3 - ZTIME_LES_MF
!
PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
!
-!-------------------------------------------------------------------------------
-!
-!* 8. CHEMISTRY-AEROSOLS
-! ------------------
-!
-ZTIME1 = ZTIME2
-XTIME_BU_PROCESS = 0.
-XTIME_LES_BU_PROCESS = 0.
-!
-IF (LUSECHEM) THEN
- CALL CH_MONITOR_n(ZWETDEPAER,KTCOUNT,XTSTEP, ILUOUT, NVERB)
-END IF
-!
-! For inert aerosol (dust and sea salt) => aer_monitor_n
-IF ((LDUST).OR.(LSALT)) THEN
-!
-! tests to see if any cloud exists
-!
- GCLD=.TRUE.
- IF (GCLD .AND. NRR.LE.3 ) THEN
- IF( MAXVAL(XCLDFR(:,:,:)).LE. 1.E-10 .AND. GCLOUD_ONLY ) THEN
- GCLD = .FALSE. ! only the cloudy verticals would be
- ! refreshed but there is no clouds
- END IF
- END IF
-!
- IF (GCLD .AND. NRR.GE.4 ) THEN
- IF( CCLOUD(1:3)=='ICE' )THEN
- IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN(2) .AND. &
- MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. GCLOUD_ONLY ) THEN
- GCLD = .FALSE. ! only the cloudy verticals would be
- ! refreshed but there is no cloudwater and ice
- END IF
- END IF
- IF( CCLOUD=='C3R5' )THEN
- IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_C1R3(2) .AND. &
- MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. GCLOUD_ONLY ) THEN
- GCLD = .FALSE. ! only the cloudy verticals would be
- ! refreshed but there is no cloudwater and ice
- END IF
- END IF
- IF( CCLOUD=='LIMA' )THEN
- IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_LIMA(2) .AND. &
- MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. GCLOUD_ONLY ) THEN
- GCLD = .FALSE. ! only the cloudy verticals would be
- ! refreshed but there is no cloudwater and ice
- END IF
- END IF
- END IF
-
-!
- CALL AER_MONITOR_n(KTCOUNT,XTSTEP, ILUOUT, NVERB, GCLD)
-END IF
-!
-!
-CALL SECOND_MNH2(ZTIME2)
-!
-PCHEM = PCHEM + ZTIME2 - ZTIME1 &
- - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
-!
-PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
!
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ppm.f90 b/src/MNH/ppm.f90
index e66202efca64a848be81afdc908539e0e1aea9f9..2b27e0e0d3202388cb09aca5f8dc1b8236989ee2 100644
--- a/src/MNH/ppm.f90
+++ b/src/MNH/ppm.f90
@@ -570,6 +570,7 @@ CONTAINS
!!
!! 18.3.2006. T. Maric - original version
!! 07/2010 J.Escobar : Correction for reproducility
+!! 04/2017 J.Escobar : initialize realistic value in all HALO pts
!-------------------------------------------------------------------------------
!
!
@@ -592,7 +593,9 @@ INTEGER :: IIE,IJE ! End useful area in x,y directions
!* 1.0. COMPUTE THE DOMAIN DIMENSIONS
! -----------------------------
!
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!!$CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+IIB=2 ; IIE = SIZE(PQ,1) -1
+IJB=2 ; IJE = SIZE(PQ,2) -1
!
!-------------------------------------------------------------------------------
!
@@ -984,6 +987,7 @@ CONTAINS
!!
!! 18.3.2006. T. Maric - original version, works only for periodic boundary
!! conditions and on one domain
+!! 04/2017 J.Escobar : initialize realistic value in all HALO pts
!!
!-------------------------------------------------------------------------------
!
@@ -1007,7 +1011,9 @@ INTEGER :: IIE,IJE ! End useful area in x,y directions
!* 1.0. COMPUTE THE DOMAIN DIMENSIONS
! -----------------------------
!
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!!$CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+IIB=2 ; IIE = SIZE(PQ,1) -1
+IJB=2 ; IJE = SIZE(PQ,2) -1
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/prandtl.f90 b/src/MNH/prandtl.f90
index 82761b44a85ea771dc69437d661bf4b0d4482c16..303f030907c2581f2bd58f8f1d04aec9a43eb04c 100644
--- a/src/MNH/prandtl.f90
+++ b/src/MNH/prandtl.f90
@@ -192,6 +192,7 @@ END MODULE MODI_PRANDTL
!! change of YCOMMENT
!! 2012-02 Y. Seity, add possibility to run with reversed
!! vertical levels
+!! 2017-09 J.Escobar, use epsilon XMNH_TINY_12 for R*4
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -358,7 +359,7 @@ END DO
!
DO JSV=1,ISV
ZW2=SIGN(1.,PREDS1(:,:,:,JSV))
- PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
+ PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
END DO
!
!---------------------------------------------------------------------------
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index 99a5186295f09470ec76db2d637874e09857a15f..eda9a8424f70c40bf668fdfafda7e69c848f51b7 100644
--- a/src/MNH/prep_real_case.f90
+++ b/src/MNH/prep_real_case.f90
@@ -368,6 +368,9 @@
!! Jun 01, 2002 (O.Nuissier) filtering of tropical cyclone
!! Aou 09, 2005 (D.Barbary) add CDADATMFILE CDADBOGFILE
!! May 2006 Remove KEPS
+!! Feb 02, 2012 (C. Mari) interpolation from MOZART
+!! add call to READ_CHEM_NETCDF_CASE &
+!! VER_PREP_NETCDF_CASE
!! Mar 2012 Add NAM_NCOUT for netcdf output
!! July 2013 (Bosseur & Filippi) Adds Forefire
!! Mars 2014 (J.Escobar) Missing 'full' UPDATE_METRICS for arp2lfi // run
@@ -421,6 +424,8 @@ USE MODI_MNHREAD_ZS_DUMMY_n
USE MODI_MNHWRITE_ZS_DUMMY_n
USE MODI_COMPARE_DAD
USE MODI_PREP_SURF_MNH
+USE MODI_READ_CHEM_DATA_NETCDF_CASE
+USE MODI_VER_PREP_NETCDF_CASE
!
USE MODD_CONF ! declaration modules
USE MODD_CONF_n
@@ -746,6 +751,8 @@ IF(LEN_TRIM(YCHEMFILE)>0)THEN
IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
IF(YCHEMFILETYPE=='GRIBEX') &
CALL READ_ALL_DATA_GRIB_CASE('CHEM',YPRE_REAL1,YCHEMFILE,TZPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+ IF (YCHEMFILETYPE=='NETCDF') &
+ CALL READ_CHEM_DATA_NETCDF_CASE(YPRE_REAL1,YCHEMFILE,YPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
END IF
!
CALL CLOSE_ll(YPRE_REAL1, IOSTAT=IRESP)
@@ -883,6 +890,9 @@ END IF
IF (LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='GRIBEX') THEN
CALL VER_PREP_GRIBEX_CASE('CHEM',ZDG)
END IF
+IF (LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='NETCDF') THEN
+ CALL VER_PREP_NETCDF_CASE(ZDG)
+END IF
!
CALL SECOND_MNH(ZTIME2)
ZPREP = ZTIME2 - ZTIME1 - ZDG
diff --git a/src/MNH/profilern.f90 b/src/MNH/profilern.f90
index a31a16dd501aea2c60a04fa22ed3ade8768a2fd2..84d627190cf4c1260a089b1ece3ba6f702095c1c 100644
--- a/src/MNH/profilern.f90
+++ b/src/MNH/profilern.f90
@@ -408,13 +408,13 @@ ZTHV(:,:,:) = PTH(:,:,:) / (1.+WATER_SUM(PR(:,:,:,:)))*(1.+PR(:,:,:,1)/ZRDSRV)
ZTEMPV(:,:,:)=ZTHV(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
CALL GPS_ZENITH_GRID(PR(:,:,:,1),ZTEMP,PP,ZZTD,ZZHD,ZZWD)
! Kunkel formulation
-IF (SIZE(PR,2) >= 2) THEN
+IF (SIZE(PR,4) >= 2) THEN
WHERE ( PR(:,:,:,2) /=0 )
ZVISIKUN(:,:,:) =0.027/(PR(:,:,:,2)*PRHODREF(:,:,:))**0.88
END WHERE
END IF
! Gultepe formulation
-IF ((SIZE(PR,2) >= 2) .AND. NSV_C2R2END /= 0 ) THEN
+IF ((SIZE(PR,4) >= 2) .AND. NSV_C2R2END /= 0 ) THEN
WHERE ( (PR(:,:,:,2) /=0. ) .AND. (PSV(:,:,:,NSV_C2R2BEG+1) /=0. ) )
ZVISI(:,:,:) =1.002/(PR(:,:,:,2)*PRHODREF(:,:,:)*PSV(:,:,:,NSV_C2R2BEG+1))**0.6473
END WHERE
diff --git a/src/MNH/radiations.f90 b/src/MNH/radiations.f90
index 7cfb6396256426b68233fad7a3fffc4a960f9017..309da7da1f84fc8cb8771cb0f715fdf0edb39cf5 100644
--- a/src/MNH/radiations.f90
+++ b/src/MNH/radiations.f90
@@ -210,6 +210,8 @@ END MODULE MODI_RADIATIONS
!! C.Lac 11/2015 Correction on aerosols
!! B.Vie /13 LIMA
!! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
+!! J.Escobar 29/06/2017 : Check if Pressure Decreasing with height <-> elsif PB & STOP
+!! Q.LIBOIS 06/2017 : correction on CLOUD_ONLY
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -253,6 +255,8 @@ USE MODD_PARAM_LIMA
#ifdef MNH_PGI
USE MODE_PACK_PGI
#endif
+!
+USE MODI_SUM_ll , ONLY : GMINLOC_ll , MIN_ll
!
IMPLICIT NONE
!
@@ -621,6 +625,12 @@ INTEGER :: JSWB ! loop on SW spectral bands
INTEGER :: JAE ! loop on aerosol class
TYPE(TFIELDDATA) :: TZFIELD
!
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZDZPABST
+REAL :: ZMINVAL
+INTEGER, DIMENSION(3) :: IMINLOC
+INTEGER :: IINFO_ll
+LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: GCLOUD_SURF
+!
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
@@ -640,6 +650,22 @@ IKUP = IKE-JPVEXT+1
ISWB = SIZE(PSRFSWD_DIR,3)
!
!-------------------------------------------------------------------------------
+!* 1.1 CHECK PRESSURE DECREASING
+! -------------------------
+ZDZPABST(:,:,1:IKU-1) = PPABST(:,:,1:IKU-1) - PPABST(:,:,2:IKU)
+ZDZPABST(:,:,IKU) = ZDZPABST(:,:,IKU-1)
+!
+ZMINVAL=MIN_ll(ZDZPABST,IINFO_ll)
+!
+IF ( ZMINVAL <= 0.0 ) THEN
+ CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
+ IMINLOC=GMINLOC_ll( ZDZPABST )
+ WRITE(ILUOUT,*) ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST <= 0.0 '
+ WRITE(ILUOUT,*) ' radiation :: ZDZPABST ', ZMINVAL,' located at ', IMINLOC
+ CALL FLUSH(ILUOUT)
+ STOP ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST < 0.0 '
+ENDIF
+!-------------------------------------------------------------------------------
!
!* 2. INITIALIZES THE MEAN-LAYER VARIABLES
! ------------------------------------
@@ -2511,8 +2537,17 @@ END DO
!final THETA_radiative tendency and surface fluxes
!
IF(OCLOUD_ONLY) THEN
- !
- ZWORKL(:,:) = SUM(PCLDFR(:,:,:),DIM=3) > 0.0
+ !! Q.LIBOIS 06/2017
+ !ZWORKL(:,:) = SUM(PCLDFR(:,:,:),DIM=3) > 0.0
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ GCLOUD_SURF(JI,JJ) = GCLOUD(IIJ,1)
+ END DO
+ END DO
+
+ ZWORKL(:,:) = GCLOUD_SURF(:,:) ! nouvelle condition
+ !! Q.LIBOIS 06/2017
DO JK = IKB,IKE
WHERE( ZWORKL(:,:) )
PDTHRAD(:,:,JK) = (ZDTRAD_LW(:,:,JK)+ZDTRAD_SW(:,:,JK))/ZEXNT(:,:,JK)
diff --git a/src/MNH/rain_c2r2_khko.f90 b/src/MNH/rain_c2r2_khko.f90
index a0189e58783e5d3a7148068575ead602656662d0..da6032ca9e1b6a097fa114f582d22faa710b9e91 100644
--- a/src/MNH/rain_c2r2_khko.f90
+++ b/src/MNH/rain_c2r2_khko.f90
@@ -216,6 +216,7 @@ END MODULE MODI_RAIN_C2R2_KHKO
!! activation by cooling (OACTIT : mis en commentaires)
!! M.Mazoyer : 04/2016 : Add supersaturation diagnostics
!! C.Lac : 07/2016 : Add droplet deposition
+!! C.Lac : 01/2017 : Correction on droplet deposition
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1744,6 +1745,9 @@ INTEGER :: JL ! and PACK intrinsics
! optimization by looking for locations where
! the precipitating fields are larger than a minimal value only !!!
!
+IF (OSEDC) PINPRC (:,:) = 0.
+IF (LDEPOC) PINDEP (:,:) = 0.
+!
DO JN = 1 , KSPLITR
GSEDIM(:,:,:) = .FALSE.
IF( OSEDC ) THEN
@@ -1940,10 +1944,10 @@ IF (LDEPOC) THEN
GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,2) >0 .AND. &
PCCS(IIB:IIE,IJB:IJE,2) >0
WHERE (GDEP)
- PRCS(:,:,2) = PRCS(:,:,2) - XVDEPOC * PRCT(:,:,2) * PRHODJ(:,:,2)
- PCCS(:,:,2) = PCCS(:,:,2) - XVDEPOC * PCCT(:,:,2) * PRHODJ(:,:,2)
- PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * PRCT(:,:,2) * PRHODJ(:,:,2) /XRHOLW
- PINDEP(:,:) = XVDEPOC * PRCT(:,:,2) * PRHODJ(:,:,2) /XRHOLW
+ PRCS(:,:,2) = PRCS(:,:,2) - XVDEPOC * PRCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
+ PCCS(:,:,2) = PCCS(:,:,2) - XVDEPOC * PCCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
+ PINDEP(:,:) = XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
END WHERE
END IF
!
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index e2f9fd9196b28fe58f31914d89fe0ffd29b6926d..a427235c565dac0698da4a99d3dc1334933e5297 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -238,7 +238,9 @@ END MODULE MODI_RAIN_ICE
!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
!! aircraft, ballon and profiler
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! C.LAc : 10/2016 : add droplets depposition
+!! C.Lac : 10/2016 : add droplet deposition
+!! C.Lac : 01/2017 : correction on droplet deposition
+!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_SLOW with XMNH_HUGE_12_LOG
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -869,6 +871,7 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D !
! O. Initialization of for sedimentation
!
IF (OSEDIC) PINPRC (:,:) = 0.
+IF (LDEPOSC) PINDEP (:,:) = 0.
PINPRR (:,:) = 0.
PINPRR3D (:,:,:) = 0.
PINPRS (:,:) = 0.
@@ -1278,11 +1281,11 @@ IF ( KRR == 7 .AND. LBUDGET_RH) &
!
IF (LDEPOSC) THEN
GDEP(:,:) = .FALSE.
- GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,2) >0
+ GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,IKB) >0
WHERE (GDEP)
- PRCS(:,:,2) = PRCS(:,:,2) - XVDEPOSC * PRCT(:,:,2) * PRHODJ(:,:,2)
- PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,2) * PRHODJ(:,:,2) /XRHOLW
- PINDEP(:,:) = XVDEPOSC * PRCT(:,:,2) * PRHODJ(:,:,2) /XRHOLW
+ PRCS(:,:,IKB) = PRCS(:,:,IKB) - XVDEPOSC * PRCT(:,:,IKB) / PDZZ(:,:,IKB)
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
+ PINDEP(:,:) = XVDEPOSC * PRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
END WHERE
END IF
!
@@ -1316,6 +1319,7 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D !
!-------------------------------------------------------------------------------
!
IF (OSEDIC) PINPRC (:,:) = 0.
+IF (LDEPOSC) PINDEP (:,:) = 0.
PINPRR (:,:) = 0.
PINPRR3D (:,:,:) = 0.
PINPRS (:,:) = 0.
@@ -1736,11 +1740,11 @@ IF ( KRR == 7 .AND. LBUDGET_RH) &
!
IF (LDEPOSC) THEN
GDEP(:,:) = .FALSE.
- GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,2) >0
+ GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,IKB) >0
WHERE (GDEP)
- PRCS(:,:,2) = PRCS(:,:,2) - XVDEPOSC * PRCT(:,:,2) * PRHODJ(:,:,2)
- PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,2) * PRHODJ(:,:,2) /XRHOLW
- PINDEP(:,:) = XVDEPOSC * PRCT(:,:,2) * PRHODJ(:,:,2) /XRHOLW
+ PRCS(:,:,IKB) = PRCS(:,:,IKB) - XVDEPOSC * PRCT(:,:,IKB) / PDZZ(:,:,IKB)
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
+ PINDEP(:,:) = XVDEPOSC * PRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
END WHERE
END IF
!
@@ -1864,6 +1868,7 @@ IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HENU_BU_RRI')
!
!* 0. DECLARATIONS
! ------------
+USE MODD_CST, ONLY : XMNH_HUGE_12_LOG
!
IMPLICIT NONE
!
@@ -1875,7 +1880,7 @@ IMPLICIT NONE
ZZW(:) = 0.0
WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRCT(:)>XRTMIN(2)) .AND. (ZRCS(:)>0.) )
ZZW(:) = MIN( ZRCS(:),XHON*ZRHODREF(:)*ZRCT(:) &
- *EXP( XALPHA3*(ZZT(:)-XTT)-XBETA3 ) )
+ *EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(ZZT(:)-XTT)-XBETA3) ) )
ZRIS(:) = ZRIS(:) + ZZW(:)
ZRCS(:) = ZRCS(:) - ZZW(:)
ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCHONI))
diff --git a/src/MNH/rain_ice_elec.f90 b/src/MNH/rain_ice_elec.f90
index dddcd3e60a8b9f8ec975de2263818e8bda8f8861..dfe87a5c81a0a9f94eb27fc5a873ce33fefe0ab4 100644
--- a/src/MNH/rain_ice_elec.f90
+++ b/src/MNH/rain_ice_elec.f90
@@ -228,6 +228,7 @@ END MODULE MODI_RAIN_ICE_ELEC
!! M. Chong 15/11/13 Bug in the computation of RGWETH (wrong sign)
!! J-P Pinty 25/04/14 Many bugs with ZWQ1(:,...) = 0.0
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_ELEC_SLOW with XMNH_HUGE_12_LOG
!!
!-------------------------------------------------------------------------------
!
@@ -2498,6 +2499,7 @@ IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HENU_BU_RRI')
!
!* 0. DECLARATIONS
! ------------
+USE MODD_CST, ONLY : XMNH_HUGE_12_LOG
!
IMPLICIT NONE
!
@@ -2515,7 +2517,7 @@ IMPLICIT NONE
!
WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRCT(:)>XRTMIN(2)) .AND. (ZRCS(:)>0.) )
ZZW(:) = MIN( ZRCS(:),XHON*ZRHODREF(:)*ZRCT(:) &
- *EXP( XALPHA3*(ZZT(:)-XTT)-XBETA3 ) )
+ *EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(ZZT(:)-XTT)-XBETA3) ) )
ZRIS(:) = ZRIS(:) + ZZW(:)
ZRCS(:) = ZRCS(:) - ZZW(:)
ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCHONI))
diff --git a/src/MNH/read_chem_data_netcdf_case.f90 b/src/MNH/read_chem_data_netcdf_case.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f8294a62fcb212641ee5b9a083393ad47231762f
--- /dev/null
+++ b/src/MNH/read_chem_data_netcdf_case.f90
@@ -0,0 +1,821 @@
+! ################################
+ MODULE MODI_READ_CHEM_DATA_NETCDF_CASE
+! #################################
+INTERFACE
+SUBROUTINE READ_CHEM_DATA_NETCDF_CASE(HPRE_REAL1,HFILE,HPGDFILE, &
+ PTIME_HORI,KVERB,ODUMMY_REAL )
+!
+CHARACTER(LEN=28), INTENT(IN) :: HPRE_REAL1 ! name of the PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file
+CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! name of the physiographic data file
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+END SUBROUTINE READ_CHEM_DATA_NETCDF_CASE
+!
+END INTERFACE
+END MODULE MODI_READ_CHEM_DATA_NETCDF_CASE
+! ##########################################################################
+ SUBROUTINE READ_CHEM_DATA_NETCDF_CASE(HPRE_REAL1,HFILE,HPGDFILE, &
+ PTIME_HORI,KVERB,ODUMMY_REAL )
+! ##########################################################################
+!
+!!**** *READ_CHEM_DATA_NETCDF_CASE* - reads data for the initialization of real cases.
+!!
+!! PURPOSE
+!! -------
+! This routine reads the two input files :
+! The PGD which is closed after reading
+! The NETCDF file
+! Projection is read in READ_LFIFM_PGD (MODD_GRID).
+! Grid and definition of large domain are read in PGD file and
+! NETCDF files.
+! The PGD files are also read in READ_LFIFM_PGD.
+! The PGD file is closed.
+! Vertical grid is defined in READ_VER_GRID.
+! PGD fields are stored on MESO-NH domain (in TRUNC_PGD).
+!!
+!!** METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Read PGD file
+!! 1. Domain restriction
+!! 2. Coordinate conversion to lat,lon system
+!! 2. Read Netcdf fields
+!! 3. Vertical grid
+!! 4. Free all temporary allocations
+!!
+!! EXTERNAL
+!! --------
+!! subroutine READ_LFIFM_PGD : to read PGD file
+!! subroutine READ_VER_GRID : to read the vertical grid in namelist file.
+!! subroutine HORIBL : horizontal bilinear interpolation
+!! subroutine XYTOLATLON : projection from conformal to lat,lon
+!!
+!! function FMLOOK_ll : to retrieve the logical unit associated with a file
+!!
+!! Module MODI_READ_VER_GRID : interface for subroutine READ_VER_GRID
+!! Module MODI_HORIBL : interface for subroutine HORIBL
+!! Module MODI_XYTOLATLON : interface for subroutine XYTOLATLON
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!! Module MODD_LUNIT : contains logical unit names for all models
+!! CLUOUT0 : name of output-listing
+!! Module MODD_PGDDIM : contains dimension of PGD fields
+!! NPGDIMAX: dimension along x (no external point)
+!! NPGDJMAX: dimension along y (no external point)
+!! Module MODD_PARAMETERS
+!! JPHEXT
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 23/01/12 (C. Mari)
+!! A. Berger 20/03/12 adapt whatever the chemical mechanism in BASIC
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!------------
+USE MODE_FM
+USE MODE_IO_ll
+USE MODE_TIME
+!
+USE MODI_READ_HGRID_n
+USE MODI_READ_VER_GRID
+USE MODI_XYTOLATLON
+USE MODI_HORIBL
+USE MODI_INI_NSV
+USE MODI_CH_INIT_SCHEME_n
+USE MODI_CH_AER_INIT_SOA
+!
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST
+USE MODD_LUNIT
+USE MODD_PARAMETERS
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_DIM_n
+USE MODD_PARAM_n, ONLY : CTURB
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM,LUSECHAQ,LUSECHIC,LCH_PH
+USE MODD_CH_M9_n, ONLY : NEQ , CNAMES
+USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,&
+ JPMODE, LVARSIGI, LVARSIGJ,CAERONAMES
+USE MODD_NSV
+USE MODD_PREP_REAL
+USE MODE_MODELN_HANDLER
+!JUAN REALZ
+USE MODE_MPPDB
+!JUAN REALZ
+USE MODI_CH_OPEN_INPUT
+USE MODE_THERMO
+!
+USE MODD_BLANK
+!
+IMPLICIT NONE
+!
+include 'netcdf.inc'
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+CHARACTER(LEN=28), INTENT(IN) :: HPRE_REAL1 ! name of the PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the GRIB file
+CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! name of the physiographic data file
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+! General purpose variables
+INTEGER :: ILUOUT0 ! Unit used for output msg.
+INTEGER :: IRESP ! Return code of FM-routines
+INTEGER :: IRET ! Return code from subroutines
+INTEGER :: JI,JJ,JK ! Dummy counters
+INTEGER :: JLOOP1 ! |
+INTEGER :: JNCHEM, JNAER ! conters of chemical species in BASIC
+! Variables used by the PGD reader
+CHARACTER(LEN=28) :: YPGD_NAME ! not used - dummy argument
+CHARACTER(LEN=28) :: YPGD_DAD_NAME ! not used - dummy argument
+CHARACTER(LEN=2) :: YPGD_TYPE ! not used - dummy argument
+! PGD Grib definition variables
+INTEGER :: INO ! Number of points of the grid
+INTEGER :: IIU ! Number of points along X
+INTEGER :: IJU ! Number of points along Y
+REAL, DIMENSION(:), ALLOCATABLE :: ZLONOUT ! mapping PGD -> Grib (lon.)
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATOUT ! mapping PGD -> Grib (lat.)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! X of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points
+! Variable involved in the task of reading the netcdf file
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALUE ! Intermediate array
+REAL,DIMENSION(:),ALLOCATABLE :: ZVALUE1D ! Intermediate array
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZOUT ! Intermediate arrays
+REAL,DIMENSION(:),ALLOCATABLE :: ZOUT1D ! Intermediate arrays
+INTEGER :: ind_netcdf ! Indice for netcdf var.
+!chemistry field infile MOZ1.nam
+INTEGER :: ICHANNEL
+CHARACTER(LEN=8) :: YMOZ="MOZ1.nam"
+integer :: IMOZ
+CHARACTER(LEN=68) :: YFORMAT
+CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YSPCMNH
+integer, dimension(:), ALLOCATABLE :: ISPCMOZ
+CHARACTER(LEN=9) :: YA
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZCOEFMOZART
+CHARACTER(LEN=18),dimension(:,:),ALLOCATABLE :: YCHANGE
+type TZMOZ
+real :: ZCOEFMOZ
+character(16) :: YSPCMOZ
+end type TZMOZ
+type(TZMOZ), DIMENSION(:,:),ALLOCATABLE :: TZSTOC
+! model indice
+INTEGER :: IMI
+!
+! For netcdf
+!
+integer :: status, ncid, varid
+integer :: lat_varid, lon_varid, lev_varid, time_varid
+integer :: hyam_varid, hybm_varid, p0_varid, t_varid, q_varid, ps_varid
+integer :: recid, latid, lonid, levid, timeid
+integer :: latlen, lonlen, levlen, nrecs,timelen
+integer :: itimeindex, KILEN, jrec
+CHARACTER(LEN=40) :: recname
+REAL, DIMENSION(:), ALLOCATABLE :: lats
+REAL, DIMENSION(:), ALLOCATABLE :: lons
+REAL, DIMENSION(:), ALLOCATABLE :: levs
+INTEGER, DIMENSION(:), ALLOCATABLE :: count3d, start3d
+INTEGER, DIMENSION(:), ALLOCATABLE :: count2d, start2d
+REAL, DIMENSION(:), ALLOCATABLE :: time, hyam, hybm
+REAL :: p0
+INTEGER, DIMENSION(:), ALLOCATABLE :: kinlo
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3d,vartemp3dbis,vartemp3dter
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3dquater
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCHEMMOZ, TMOZ, QMOZ
+REAL, DIMENSION(:,:), ALLOCATABLE :: PSMOZ
+
+real ::a,b
+
+!----------------------------------------------------------------------
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!* 1. READ PGD FILE
+! -------------
+!
+CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRET)
+CALL READ_HGRID_n(HPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
+!
+! 1.1 Domain restriction
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+INO = IIU * IJU
+!
+!
+! 1.2 Coordinate conversion to lat,lon system
+!
+ALLOCATE (ZXM(IIU,IJU))
+ALLOCATE (ZYM(IIU,IJU))
+ALLOCATE (ZLONM(IIU,IJU))
+ALLOCATE (ZLATM(IIU,IJU))
+ZXM(1:IIU-1,1) = (XXHAT(1:IIU-1) + XXHAT(2:IIU) ) / 2.
+ZXM(IIU,1) = XXHAT(IIU) - XXHAT(IIU-1) + ZXM(IIU-1,1)
+ZXM(:,2:IJU) = SPREAD(ZXM(:,1),2,IJU-1)
+ZYM(1,1:IJU-1) = (XYHAT(1:IJU-1) + XYHAT(2:IJU)) / 2.
+ZYM(1,IJU) = XYHAT(IJU) - XYHAT(IJU-1) + ZYM(1,IJU-1)
+ZYM(2:IIU,:) = SPREAD(ZYM(1,:),1,IIU-1)
+CALL SM_XYTOLATLON_A (XLAT0,XLON0,XRPK,XLATORI,XLONORI,ZXM,ZYM,ZLATM,ZLONM, &
+ IIU,IJU)
+ALLOCATE (ZLONOUT(INO))
+ALLOCATE (ZLATOUT(INO))
+JLOOP1 = 0
+DO JJ = 1, IJU
+ ZLONOUT(JLOOP1+1:JLOOP1+IIU) = ZLONM(1:IIU,JJ)
+ ZLATOUT(JLOOP1+1:JLOOP1+IIU) = ZLATM(1:IIU,JJ)
+ JLOOP1 = JLOOP1 + IIU
+ENDDO
+DEALLOCATE (ZYM)
+DEALLOCATE (ZXM)
+!
+!
+!* 2. READ NETCDF FIELDS
+! ------------------
+!
+! 2.1 Open netcdf files
+!print*,'Open netcdf files:',HFILE
+!
+status = nf_open(HFILE, nf_nowrite, ncid)
+if (status /= nf_noerr) call handle_err(status)
+!
+! 2.2 Read netcdf files
+!
+! get dimension IDs
+!
+!* get dimension ID of unlimited variable in netcdf file
+status = nf_inq_unlimdim(ncid, recid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_dimid(ncid, "lat", latid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_dimid(ncid, "lon", lonid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_dimid(ncid, "lev", levid)
+if (status /= nf_noerr) call handle_err(status)
+!
+! get dimensions
+!
+!* get dimension and name of unlimited variable in netcdf file
+status = nf_inq_dim(ncid, recid, recname, nrecs)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_dimlen(ncid, latid, latlen)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_dimlen(ncid, lonid, lonlen)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_dimlen(ncid, levid, levlen)
+if (status /= nf_noerr) call handle_err(status)
+!print*, latlen, lonlen, levlen, nrecs
+!
+! get variable IDs
+!
+status = nf_inq_varid(ncid, "lat", lat_varid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_varid(ncid, "lon", lon_varid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_varid(ncid, "lev", lev_varid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_varid(ncid, "time", time_varid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_varid(ncid, "P0", p0_varid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_varid(ncid, "hyam", hyam_varid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_varid(ncid, "hybm", hybm_varid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_varid(ncid, "T", t_varid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_varid(ncid, "Q", q_varid)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_inq_varid(ncid, "PS", ps_varid)
+if (status /= nf_noerr) call handle_err(status)
+!
+KILEN = latlen * lonlen
+!
+! 2.3 Read data.
+!
+ALLOCATE (count3d(4))
+ALLOCATE (start3d(4))
+ALLOCATE (count2d(3))
+ALLOCATE (start2d(3))
+ALLOCATE (lats(latlen))
+ALLOCATE (lons(lonlen))
+ALLOCATE (levs(levlen))
+ALLOCATE (time(nrecs))
+ALLOCATE (kinlo(latlen))
+kinlo(:) = lonlen
+ALLOCATE (vartemp3d(lonlen,latlen,levlen))
+ALLOCATE (vartemp3dbis(lonlen,latlen,levlen))
+ALLOCATE (vartemp3dter(lonlen,latlen,levlen))
+ALLOCATE (vartemp3dquater(lonlen,latlen,levlen))
+ALLOCATE (ZCHEMMOZ(lonlen,latlen,levlen))
+ALLOCATE (TMOZ(lonlen,latlen,levlen))
+ALLOCATE (QMOZ(lonlen,latlen,levlen))
+ALLOCATE (PSMOZ(lonlen,latlen))
+ALLOCATE (XA_SV_LS(levlen))
+ALLOCATE (hyam(levlen))
+ALLOCATE (XB_SV_LS(levlen))
+ALLOCATE (hybm(levlen))
+ALLOCATE (XT_SV_LS(IIU,IJU,levlen))
+ALLOCATE (XQ_SV_LS(IIU,IJU,levlen,1))
+ALLOCATE (XPS_SV_LS(IIU,IJU))
+ALLOCATE (XZS_SV_LS(IIU,IJU))
+! take the orography from ECMWF
+XZS_SV_LS(:,:) = XZS_LS(:,:)
+!
+! get values of variables
+!
+status = nf_get_var_double(ncid, lat_varid, lats(:))
+if (status /= nf_noerr) call handle_err(status)
+status = nf_get_var_double(ncid, lon_varid, lons(:))
+if (status /= nf_noerr) call handle_err(status)
+status = nf_get_var_double(ncid, lev_varid, levs(:))
+if (status /= nf_noerr) call handle_err(status)
+status = nf_get_var_double(ncid, time_varid, time(:))
+if (status /= nf_noerr) call handle_err(status)
+status = nf_get_var_double(ncid, hyam_varid, hyam)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_get_var_double(ncid, hybm_varid, hybm)
+if (status /= nf_noerr) call handle_err(status)
+status = nf_get_var_double(ncid, p0_varid, p0)
+if (status /= nf_noerr) call handle_err(status)
+XP00_SV_LS = p0
+!
+! hyam and hybm coefficients for pressure calculations have to be reversed
+! from top-bottom to bottom-up direction
+do JJ = 1, levlen
+ XA_SV_LS(JJ) = hyam(levlen+1-JJ)
+ XB_SV_LS(JJ) = hybm(levlen+1-JJ)
+end do
+!
+!
+! Read 1 record of lon*lat*lev values, starting at the
+! beginning of the record (the (1, 1, 1, rec) element in the netCDF
+! file).
+ count3d(1) = lonlen
+ count3d(2) = latlen
+ count3d(3) = levlen
+ count3d(4) = 1
+ start3d(1) = 1
+ start3d(2) = 1
+ start3d(3) = 1
+! Choose time index according to the chosen time in namelist
+! 1 for 00 - 2 for 06 - 3 for 12 - 4 for 18
+IF (CDUMMY1=="00") THEN
+ itimeindex=1
+ELSEIF (CDUMMY1=="06") THEN
+ itimeindex=2
+ELSEIF (CDUMMY1=="12") THEN
+ itimeindex=3
+ELSEIF (CDUMMY1=="18") THEN
+ itimeindex=4
+ENDIF
+ start3d(4) = itimeindex
+!
+ status = nf_get_vara_double(ncid, t_varid, start3d, count3d, &
+ vartemp3d)
+ if (status /= nf_noerr) call handle_err(status)
+!
+do JJ=1,levlen
+! lev, lat, lon
+ TMOZ(:,:,JJ) = vartemp3d(:,:,levlen+1-JJ)
+enddo
+!
+ status = nf_get_vara_double(ncid, q_varid, start3d, count3d, &
+ vartemp3d)
+ if (status /= nf_noerr) call handle_err(status)
+!
+do JJ=1,levlen
+! lev, lat, lon
+ QMOZ(:,:,JJ) = vartemp3d(:,:,levlen+1-JJ)
+enddo
+!
+ count2d(1) = lonlen
+ count2d(2) = latlen
+ count2d(3) = 1
+ start2d(1) = 1
+ start2d(2) = 1
+ start2d(3) = itimeindex
+ status = nf_get_vara_double(ncid, ps_varid, start2d, count2d, PSMOZ(:,:))
+ if (status /= nf_noerr) call handle_err(status)
+
+
+!------------------------------------------------------------------------
+!* 3 Interpolation of MOZART variable
+!---------------------------------------------------------------------
+ ! Always initialize chemical scheme variables before INI_NSV call !
+ CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT0,KVERB)
+ LUSECHEM = .TRUE.
+ IF (LORILAM) THEN
+ CORGANIC = "MPMPO"
+ LVARSIGI = .TRUE.
+ LVARSIGJ = .TRUE.
+ CALL CH_AER_INIT_SOA(ILUOUT0, KVERB)
+ END IF
+ ! initialise NSV_* variables
+ CALL INI_NSV(1)
+ DEALLOCATE(XSV_LS)
+ ALLOCATE (XSV_LS(IIU,IJU,levlen,NSV))
+ XSV_LS(:,:,:,:) = 0.
+!
+ WRITE (ILUOUT0,'(A,A4,A)') ' | Reading MOZART species (ppp) from ',HFILE,' file'
+
+where (ZLONOUT(:) < 0.) ZLONOUT(:) = ZLONOUT(:) + 360.
+!
+ALLOCATE(ZVALUE(levlen,KILEN))
+ALLOCATE(ZOUT(levlen,INO))
+ALLOCATE(ZVALUE1D(KILEN))
+ALLOCATE(ZOUT1D(INO))
+
+!
+!* 2.6.1 read MOZART species from the file MOZ1.nam
+!
+! open input file
+CALL CH_OPEN_INPUT(YMOZ,"MOZ2MESONH",ICHANNEL,ILUOUT0,KVERB)
+!
+!read number of mocage species to transfer into mesonh
+READ(ICHANNEL, *) IMOZ
+IF (KVERB >= 5) WRITE (ILUOUT0,*) "number of mozart species to transfer into &
+& mesonh : ", IMOZ
+!
+!read data input format
+READ(ICHANNEL,"(A)") YFORMAT
+YFORMAT=UPCASE(YFORMAT)
+IF (KVERB >= 5) WRITE (ILUOUT0,*) "input format is: ", YFORMAT
+!
+!allocate fields
+ALLOCATE(YSPCMNH(IMOZ)) !MESONH species
+ALLOCATE(TZSTOC(IMOZ,4)) !MOZART coefficient and MOZART species associated
+ALLOCATE(ISPCMOZ(IMOZ)) !MOZART species number into MESONH species
+ALLOCATE(ZCOEFMOZART(IMOZ,4))!Coef stoich of each MOZART species
+ALLOCATE(YCHANGE(IMOZ,4)) !MOZART species with _VMR_inst
+!read MESONH variable names and MOZART variable names associated
+DO JI = 1,IMOZ !for every MNH species existing in MOZ1.nam
+ READ(ICHANNEL,YFORMAT) YSPCMNH(JI), ISPCMOZ(JI), TZSTOC(JI,1)%ZCOEFMOZ,& !reading line by line
+ TZSTOC(JI,1)%YSPCMOZ, TZSTOC(JI,2)%ZCOEFMOZ,& !of string
+ TZSTOC(JI,2)%YSPCMOZ, TZSTOC(JI,3)%ZCOEFMOZ,&
+ TZSTOC(JI,3)%YSPCMOZ, TZSTOC(JI,4)%ZCOEFMOZ,&
+ TZSTOC(JI,4)%YSPCMOZ
+ WRITE(ILUOUT0,YFORMAT) YSPCMNH(JI), ISPCMOZ(JI),& !writing in arrays
+ TZSTOC(JI,1)%ZCOEFMOZ, TZSTOC(JI,1)%YSPCMOZ,&
+ TZSTOC(JI,2)%ZCOEFMOZ, TZSTOC(JI,2)%YSPCMOZ,&
+ TZSTOC(JI,3)%ZCOEFMOZ, TZSTOC(JI,3)%YSPCMOZ,&
+ TZSTOC(JI,4)%ZCOEFMOZ, TZSTOC(JI,4)%YSPCMOZ
+!
+ ZCOEFMOZART(JI,1) = (TZSTOC(JI,1)%ZCOEFMOZ) !coef stoich of each MOZART species set into an array
+ ZCOEFMOZART(JI,2) = (TZSTOC(JI,2)%ZCOEFMOZ)
+ ZCOEFMOZART(JI,3) = (TZSTOC(JI,3)%ZCOEFMOZ)
+ ZCOEFMOZART(JI,4) = (TZSTOC(JI,4)%ZCOEFMOZ)
+!
+ YA="_VMR_inst"
+ YCHANGE(JI,1)=trim(TZSTOC(JI,1)%YSPCMOZ)//YA !set into an array MOZART species with _VMR_inst
+ YCHANGE(JI,2)=trim(TZSTOC(JI,2)%YSPCMOZ)//YA
+ YCHANGE(JI,3)=trim(TZSTOC(JI,3)%YSPCMOZ)//YA
+ YCHANGE(JI,4)=trim(TZSTOC(JI,4)%YSPCMOZ)//YA
+!
+!* exchange mozart values onto prognostic variables XSV_LS
+! and convert MOZART fields to 2D for use in horizontal interpolation
+! routine HORIBL.f90
+!
+ DO JNCHEM = NSV_CHEMBEG, NSV_CHEMEND !loop on all MNH species
+ IF (trim(CNAMES(JNCHEM-NSV_CHEMBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species
+ IF (ISPCMOZ(JI)==1) THEN
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3d)
+ if (status /= nf_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==2) THEN
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3d)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dbis)
+ if (status /= nf_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ) + &
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==3) THEN
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3d)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dbis)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dter)
+ if (status /= nf_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==4) THEN
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3d)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dbis)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dter)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,4)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dquater)
+ if (status /= nf_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,4)*vartemp3dquater(:,:,levlen+1-JJ)
+ ENDDO
+ ENDIF
+ DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMMOZ(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1+lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XSV_LS(:,:,JK,JNCHEM) )
+ ENDDO ! levlen
+ ENDIF
+
+ ENDDO ! JNCHEM
+ DO JNAER = NSV_AERBEG, NSV_AEREND
+ IF (trim(CAERONAMES(JNAER-NSV_AERBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species
+ IF (ISPCMOZ(JI)==1) THEN
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3d)
+ if (status /= nf_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==2) THEN
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3d)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dbis)
+ if (status /= nf_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ) + &
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==3) THEN
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3d)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dbis)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dter)
+ if (status /= nf_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==4) THEN
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3d)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dbis)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dter)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_inq_varid(ncid, trim(YCHANGE(JI,4)), ind_netcdf)
+ if (status /= nf_noerr) call handle_err(status)
+ status = nf_get_vara_double(ncid,ind_netcdf, start3d, count3d, &
+ vartemp3dquater)
+ if (status /= nf_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,4)*vartemp3dquater(:,:,levlen+1-JJ)
+ ENDDO
+ ENDIF
+ DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMMOZ(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1+lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XSV_LS(:,:,JK,JNAER) )
+ ENDDO ! levlen
+ ENDIF
+ ENDDO ! JNAER
+ENDDO ! JIDO JNCHEM = NSV_CHEMBEG, NSV_CHEMEND !loop on all MNH species
+DEALLOCATE(YSPCMNH)
+DEALLOCATE(TZSTOC)
+DEALLOCATE(ISPCMOZ)
+DEALLOCATE(ZCOEFMOZART)
+DEALLOCATE(YCHANGE)
+!
+XSV_LS(:,:,:,:) = MAX(XSV_LS(:,:,:,:),0.)
+!
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = TMOZ(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.)
+!
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XT_SV_LS(:,:,JK))
+ENDDO
+XT_SV_LS(:,:,:) = MAX(XT_SV_LS(:,:,:),0.)
+!
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = QMOZ(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.)
+!
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XQ_SV_LS(:,:,JK,1))
+ENDDO
+XQ_SV_LS(:,:,:,1) = MAX(XQ_SV_LS(:,:,:,1),0.)
+!
+JLOOP1 = 0
+DO JJ = 1, latlen
+ ZVALUE1D(JLOOP1+1:JLOOP1+lonlen) = PSMOZ(1:lonlen,JJ)
+ JLOOP1 = JLOOP1 + lonlen
+ENDDO
+CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE1D(:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT1D(:),.FALSE.,PTIME_HORI,.FALSE.)
+!
+CALL ARRAY_1D_TO_2D(INO,ZOUT1D(:),IIU,IJU, &
+ XPS_SV_LS(:,:))
+XPS_SV_LS(:,:) = MAX(XPS_SV_LS(:,:),0.)
+!
+!
+!
+! close the netcdf file
+!nf_close
+status = nf_close(ncid)
+if (status /= nf_noerr) call handle_err(status)
+!
+ DEALLOCATE (ZVALUE)
+ DEALLOCATE (ZOUT)
+ DEALLOCATE (ZVALUE1D)
+ DEALLOCATE (ZOUT1D)
+!!
+
+! close
+! file
+CALL CLOSE_ll(YMOZ,IOSTAT=IRET)
+
+
+!-------------------------------------------------------------
+!
+!* 4. VERTICAL GRID
+!
+!* 4.1 Read VERTICAL GRID
+!
+WRITE (ILUOUT0,'(A)') ' | Reading of vertical grid in progress'
+CALL READ_VER_GRID(HPRE_REAL1)
+!
+!--------------------------------------------------------------
+!
+!* 4.2 Interpolate on Meso-NH VERTICAL GRID
+!
+!* 4.3 Free all temporary allocations
+!
+DEALLOCATE (ZLATOUT)
+DEALLOCATE (ZLONOUT)
+DEALLOCATE (hyam)
+DEALLOCATE (hybm)
+DEALLOCATE (vartemp3d)
+DEALLOCATE (vartemp3dbis)
+DEALLOCATE (vartemp3dter)
+DEALLOCATE (vartemp3dquater)
+!
+WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successfully'
+!
+!
+CONTAINS
+!
+! #############################
+ SUBROUTINE HANDLE_ERR(STATUS)
+! #############################
+ INTEGER STATUS
+ IF (STATUS .NE. NF_NOERR) THEN
+ PRINT *, NF_STRERROR(STATUS)
+ STOP 'Stopped'
+ ENDIF
+ END SUBROUTINE HANDLE_ERR
+!
+!
+! #############################################
+ SUBROUTINE ARRAY_1D_TO_2D (KN1,P1,KL1,KL2,P2)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KN1
+REAL,DIMENSION(KN1), INTENT(IN) :: P1
+INTEGER, INTENT(IN) :: KL1
+INTEGER, INTENT(IN) :: KL2
+REAL,DIMENSION(KL1,KL2),INTENT(OUT) :: P2
+INTEGER :: JLOOP1_A1T2
+INTEGER :: JLOOP2_A1T2
+INTEGER :: JPOS_A1T2
+!
+IF (KN1 < KL1*KL2) THEN
+ WRITE (ILUOUT0,'(A)') ' | Error in "ARRAY_1D_TO_2D", sizes do not match - abort'
+ !callabortstop
+ CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
+ CALL ABORT
+ STOP
+END IF
+JPOS_A1T2 = 1
+DO JLOOP2_A1T2 = 1, KL2
+ DO JLOOP1_A1T2 = 1, KL1
+ P2(JLOOP1_A1T2,JLOOP2_A1T2) = P1(JPOS_A1T2)
+ JPOS_A1T2 = JPOS_A1T2 + 1
+ END DO
+END DO
+END SUBROUTINE ARRAY_1D_TO_2D
+!
+END SUBROUTINE READ_CHEM_DATA_NETCDF_CASE
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index b0d732817e6fe451ad7574e9c370a03f61364056..efe465db675c63adff331be0d8006a939b11a317 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -288,6 +288,8 @@ END MODULE MODI_READ_EXSEG_n
!! Modification 11/2016 (Ph. Wautelet) Allocate/initialise some output/backup structures
!! Modification 03/2017 (JP Chaboureau) Fix the initialization of
!! LUSERx-type variables for LIMA
+!! M.Leriche 06/2017 for spawn and prep_real avoid abort if wet dep for
+!! aerosol and no cloud scheme defined
!!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -329,7 +331,7 @@ USE MODN_PARAM_C1R3, ONLY : NAM_PARAM_C1R3, CPRISTINE_ICE_C1R3, &
CHEVRIMED_ICE_C1R3
USE MODN_PARAM_LIMA, ONLY : FINI_CCN=>HINI_CCN,NAM_PARAM_LIMA,NMOD_CCN,LSCAV, &
CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, NMOD_IFN, &
- LCOLD, LACTI, LNUCL, XALPHAC, XNUC, LMEYERS
+ LCOLD, LACTI, LNUCL, XALPHAC, XNUC, LMEYERS, LHAIL
USE MODN_ELEC
USE MODN_SERIES
USE MODN_SERIES_n
@@ -930,7 +932,7 @@ SELECT CASE ( CCLOUD )
&"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' )
!
LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
- LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
LUSERS=.TRUE. ; LUSERG=.TRUE.
LUSERH=.FALSE.
END IF
@@ -1016,7 +1018,8 @@ SELECT CASE ( CCLOUD )
!
IF (LCOLD) THEN
LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
- LUSERI=.TRUE. ; LUSERS=.TRUE. ; LUSERG=.TRUE. ; LUSERH=.TRUE.
+ LUSERI=.TRUE. ; LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH=LHAIL
END IF
!
IF (LSUBG_COND .AND. LCOLD) THEN
@@ -1617,7 +1620,8 @@ IF (LDUST) THEN
IF (LDEPOS_DST(KMI)) THEN
IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
- .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2')) THEN
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
WRITE(UNIT=ILUOUT,FMT=9003) KMI
WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF DUST IS ONLY CODED FOR THE",/,&
& "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO and C2R2")')
@@ -1698,7 +1702,8 @@ IF (LSALT) THEN
IF (LDEPOS_SLT(KMI)) THEN
IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
- .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2')) THEN
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
WRITE(UNIT=ILUOUT,FMT=9003) KMI
WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF SEA SALT AEROSOLS IS ONLY CODED FOR THE",/,&
& "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO and C2R2")')
@@ -1777,7 +1782,8 @@ IF (LORILAM) THEN
IF (LDEPOS_AER(KMI)) THEN
IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
- .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2')) THEN
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
WRITE(UNIT=ILUOUT,FMT=9003) KMI
WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF ORILAM AEROSOLS IS ONLY CODED FOR THE",/,&
& "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO and C2R2")')
diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90
index 9066a915bb7d53c68f22e1bf89b017f923027dad..bc4029673d605f2d17976bf370a249ef5c767ead 100644
--- a/src/MNH/read_field.f90
+++ b/src/MNH/read_field.f90
@@ -24,6 +24,7 @@ INTERFACE
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, &
PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
+ PTENDUFRC,PTENDVFRC, &
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
@@ -104,6 +105,7 @@ INTEGER, INTENT(IN) :: KFRC ! number of f
TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTFRC ! date of forcing profs.
REAL, DIMENSION(:,:), INTENT(OUT) :: PUFRC,PVFRC,PWFRC ! forcing variables
REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDUFRC,PTENDVFRC
REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC
REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC
@@ -142,6 +144,7 @@ END MODULE MODI_READ_FIELD
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, &
PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
+ PTENDUFRC,PTENDVFRC, &
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
@@ -235,6 +238,7 @@ END MODULE MODI_READ_FIELD
!! Modification 01/2016 (JP Pinty) Add LIMA
!! M. Leriche 02/16 treat gas and aq. chemicals separately
!! C.Lac 10/16 CEN4TH with RKC4 + Correction on RK loop
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -359,6 +363,7 @@ INTEGER, INTENT(IN) :: KFRC ! number of f
TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTFRC ! date of forcing profs.
REAL, DIMENSION(:,:), INTENT(OUT) :: PUFRC,PVFRC,PWFRC ! forcing variables
REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDUFRC,PTENDVFRC
REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC
REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC
@@ -1348,6 +1353,15 @@ IF ( LFORCING ) THEN
TZFIELD%NDIMS = 0
CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PPGROUNDFRC(JT))
!
+ YRECFM='TENDUFRC'//YFRC
+ YDIR='--'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
+ PTENDUFRC(:,JT)=Z1D(:)
+!
+ YRECFM='TENDVFRC'//YFRC
+ YDIR='--'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
+ PTENDVFRC(:,JT)=Z1D(:)
END DO
END IF
!
diff --git a/src/MNH/read_hgrid.f90 b/src/MNH/read_hgrid.f90
index 6814a9495976229e10df1e1f1e803ea4eccc640a..a57ceaa148f819ebdeab695c41e45d4a17b023f3 100644
--- a/src/MNH/read_hgrid.f90
+++ b/src/MNH/read_hgrid.f90
@@ -79,6 +79,7 @@ END MODULE MODI_READ_HGRID
!! -------------
!! Original 26/09/96
!! M.Faivre 2014
+!! G.Delautier 2017 BUG for MNH2LPDM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -127,13 +128,22 @@ TYPE(TFIELDDATA) :: TZFIELD
! KMI may be 0 !
IF (KMI<0 .OR. KMI>JPMODELMAX) CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_HGRID','KMI<0 .OR. KMI>JPMODELMAX')
IF (KMI/=0) THEN
- IMI = GET_CURRENT_MODEL_INDEX()
- CALL GOTO_MODEL(KMI)
- CALL GO_TOMODEL_ll(KMI, IINFO_ll)
- CALL READ_HGRID_n(TPFMFILE,HMY_NAME,HDAD_NAME,HSTORAGE_TYPE)
- CALL GO_TOMODEL_ll(IMI, IINFO_ll)
- CALL GOTO_MODEL(IMI)
- RETURN
+ IF (CPROGRAM/='M2LPDM') THEN
+ IMI = GET_CURRENT_MODEL_INDEX()
+ CALL GOTO_MODEL(KMI)
+ CALL GO_TOMODEL_ll(KMI, IINFO_ll)
+ CALL READ_HGRID_n(TPFMFILE,HMY_NAME,HDAD_NAME,HSTORAGE_TYPE)
+ CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+ CALL GOTO_MODEL(IMI)
+ RETURN
+ ELSE
+ IMI = GET_CURRENT_MODEL_INDEX()
+ CALL GOTO_MODEL(KMI)
+ CALL READ_HGRID_n(TPFMFILE,HMY_NAME,HDAD_NAME,HSTORAGE_TYPE)
+ CALL GOTO_MODEL(IMI)
+ RETURN
+ RETURN
+ END IF
END IF
!
!* 2. READING IN MODD_PGD...
diff --git a/src/MNH/read_precip_field.f90 b/src/MNH/read_precip_field.f90
index b059152380203ffcccd3c1db22a7c8bd7b2eb07b..c56b72cc88e9801c23994c665c7caa486a7266d2 100644
--- a/src/MNH/read_precip_field.f90
+++ b/src/MNH/read_precip_field.f90
@@ -104,6 +104,7 @@ END MODULE MODI_READ_PRECIP_FIELD
USE MODD_IO_ll, ONLY : TFILEDATA
USE MODD_PARAM_ICE, ONLY : LDEPOSC
USE MODD_PARAM_C2R2, ONLY : LDEPOC
+USE MODD_PARAM_LIMA, ONLY : MDEPOC=>LDEPOC
!
USE MODE_FIELD, ONLY : TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
USE MODE_FM
@@ -189,7 +190,7 @@ IF (SIZE(PINPRC) /= 0 ) THEN
END SELECT
END IF
!
-IF (SIZE(PINPRC) /= 0 .AND. (LDEPOSC .OR. LDEPOC) ) THEN
+IF (SIZE(PINPRC) /= 0 .AND. (LDEPOSC .OR. LDEPOC .OR. MDEPOC) ) THEN
SELECT CASE(YGETRCT)
CASE ('READ')
CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP)
diff --git a/src/MNH/read_surf_mnh.f90 b/src/MNH/read_surf_mnh.f90
index 64c407fb486e72fad5ba4004d0418da636c284ce..186aa2e97b714ca769374f1479fdbea920eee97f 100644
--- a/src/MNH/read_surf_mnh.f90
+++ b/src/MNH/read_surf_mnh.f90
@@ -690,7 +690,7 @@ IMPLICIT NONE
CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(IN) :: KL1,KL2 ! number of points
REAL, DIMENSION(KL1,KL2), INTENT(OUT):: PFIELD ! array containing the data field
-LOGICAL,DIMENSION(JPCOVER),INTENT(IN) ::OFLAG ! mask for array filling
+LOGICAL,DIMENSION(JPCOVER),INTENT(IN) :: OFLAG ! mask for array filling
INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears
CHARACTER(LEN=100), INTENT(OUT):: HCOMMENT ! comment
CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index a594acc9ad729e29a5c1596a1a2b0a692e5bcc67..6715b10e1a83a46d928a9b29089ecd97ae47468e 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -963,16 +963,16 @@ SELECT CASE ( HCLOUD )
!
IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PW_ACT, PPABSM, PPABST, &
- PTHM, PRCM, &
+ PRHODREF, PEXNREF, PW_ACT, PPABST, PPABST, &
+ PTHT, PRCM, &
PTHT, PRT, ZSVT, &
PTHS, PRS, ZSVS, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D )
+ PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
!
IF (LCOLD) CALL LIMA_COLD(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_ACT, &
- PTHM, PPABSM, &
+ PTHT, PPABST, &
PTHT, PRT, ZSVT, &
PTHS, PRS, ZSVS, &
PINPRS, PINPRG, PINPRH)
@@ -980,7 +980,7 @@ IF (LCOLD) CALL LIMA_COLD(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
IF (OWARM .AND. LCOLD) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_ACT, &
- PTHM, PPABSM, &
+ PTHT, PPABST, &
PTHT, PRT, ZSVT, &
PTHS, PRS, ZSVS )
!
@@ -989,7 +989,7 @@ IF (OWARM .AND. LCOLD) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
!
CALL LIMA_ADJUST(KRR, KMI, TPFILE, HLUOUT, HRAD, &
HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, &
+ PRHODREF, PRHODJ, PEXNREF, PPABST, PSIGS, PPABST, &
PRT, PRS, ZSVT, ZSVS, &
PTHS, PSRCS, PCLDFR )
!
diff --git a/src/MNH/seriesn.f90 b/src/MNH/seriesn.f90
index 09eecb4d64ca95580c0b8b6558dea6239e104a73..a8ea76a4609991e0917d0f97910174dfbbbad432 100644
--- a/src/MNH/seriesn.f90
+++ b/src/MNH/seriesn.f90
@@ -151,7 +151,6 @@ IF (LSURF) THEN
ZHML(ILOOP,JLOOP)=ZSERIES(ILOOP-1+(IIE-1)*(JLOOP-2),5)
ENDDO
ENDDO
- print*,'seriesn : MINVAL(ZTS)=', MINVAL(ZTS),'MAXVAL(ZTS)=', MAXVAL(ZTS)
IF(NVERB==10) THEN
DO JLOOP=IJB-1,IJE+1
DO ILOOP=IIB-1,IIE+1
diff --git a/src/MNH/set_conc_lima.f90 b/src/MNH/set_conc_lima.f90
index 0a76b46aa020e5bcac20ffacf41f6a5b0faf85cd..54f17c858e74d5ccd7480ffa65d33d837b59c75e 100644
--- a/src/MNH/set_conc_lima.f90
+++ b/src/MNH/set_conc_lima.f90
@@ -79,7 +79,7 @@ END MODULE MODI_SET_CONC_LIMA
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LCOLD, LWARM
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LCOLD, LWARM, LRAIN
USE MODD_PARAM_LIMA_COLD, ONLY : XAI, XBI
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_ACTI, NSV_LIMA_NI, NSV_LIMA_IFN_NUCL
USE MODD_CST, ONLY : XPI, XRHOLW, XRHOLI
@@ -133,6 +133,9 @@ IF (LWARM) THEN
WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The droplet concentration has "
WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
END IF
+END IF
+!
+IF (LWARM .AND. LRAIN) THEN
!
! drops
!
@@ -153,8 +156,7 @@ IF (LWARM) THEN
WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
END IF
END IF
-!
-ENDIF
+END IF
!
IF (LCOLD) THEN
!
diff --git a/src/MNH/set_frc.f90 b/src/MNH/set_frc.f90
index 6541a1ce12444265bff5db1fe902a8fe7bfbcc62..bd40fe80eb43d9d7045afee44fc0d2a8ac9e8754 100644
--- a/src/MNH/set_frc.f90
+++ b/src/MNH/set_frc.f90
@@ -94,6 +94,7 @@ END MODULE MODI_SET_FRC
!! add SST and ground pressure forcing
!! 06/12 (Masson) Removes extrapolations below or above forcing
!! data. Reproduces the same data instead.
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!!
!-------------------------------------------------------------------------------
!
@@ -145,6 +146,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZWF,ZUF,ZVF ! Local variables for
REAL, DIMENSION(:), ALLOCATABLE :: ZTHF,ZRVF ! the data reading
REAL, DIMENSION(:), ALLOCATABLE :: ZGXRF,ZGYRF ! "
REAL, DIMENSION(:), ALLOCATABLE :: ZHEIGHTF ! "
+REAL, DIMENSION(:), ALLOCATABLE :: ZTUF, ZTVF
REAL, DIMENSION(:), ALLOCATABLE :: ZPRESSUF ! "
REAL, DIMENSION(:), ALLOCATABLE :: ZPRESSMF ! "
REAL, DIMENSION(:), ALLOCATABLE :: ZTHVUF ! Thetav at wind levels
@@ -213,6 +215,8 @@ ALLOCATE(XTENDRVFRC(IKU,NFRC))
ALLOCATE(XGXTHFRC(IKU,NFRC))
ALLOCATE(XGYTHFRC(IKU,NFRC))
ALLOCATE(XPGROUNDFRC(NFRC))
+ALLOCATE(XTENDUFRC(IKU,NFRC))
+ALLOCATE(XTENDVFRC(IKU,NFRC))
!
! Reading the forcing sounding written in prep_idea1.nam
!
@@ -240,6 +244,8 @@ DO JKT = 1,NFRC
DEALLOCATE(ZRVF)
DEALLOCATE(ZGXRF)
DEALLOCATE(ZGYRF)
+ DEALLOCATE(ZTUF)
+ DEALLOCATE(ZTVF)
ENDIF
ALLOCATE(ZHEIGHTF(ILEVELF))
ALLOCATE(ZUF(ILEVELF))
@@ -249,11 +255,15 @@ DO JKT = 1,NFRC
ALLOCATE(ZRVF(ILEVELF))
ALLOCATE(ZGXRF(ILEVELF))
ALLOCATE(ZGYRF(ILEVELF))
+ ALLOCATE(ZTUF(ILEVELF))
+ ALLOCATE(ZTVF(ILEVELF))
!
DO JKU =1,ILEVELF
READ(ILUPRE,*) ZHEIGHTF(JKU) &
,ZUF(JKU),ZVF(JKU),ZTHF(JKU),ZRVF(JKU) &
- ,ZWF(JKU),ZGXRF(JKU),ZGYRF(JKU)
+ ,ZWF(JKU),ZGXRF(JKU),ZGYRF(JKU),ZTUF(JKU)&
+ ,ZTVF(JKU)
+
END DO
END IF
!
@@ -386,6 +396,8 @@ DO JKT = 1,NFRC
XRVFRC(JK,JKT) = ZRVF(1)
XTENDTHFRC(JK,JKT) = ZGXRF(1)
XTENDRVFRC(JK,JKT) = ZGYRF(1)
+ XTENDUFRC(JK,JKT) = ZTUF(1)
+ XTENDVFRC(JK,JKT) = ZTVF(1)
ELSE IF (ZZHATM(JK) > ZHEIGHTF(ILEVELF) ) THEN
!
! copy above the last level
@@ -396,6 +408,8 @@ DO JKT = 1,NFRC
XRVFRC(JK,JKT) = ZRVF(ILEVELF)
XTENDTHFRC(JK,JKT)=ZGXRF(ILEVELF)
XTENDRVFRC(JK,JKT)=ZGYRF(ILEVELF)
+ XTENDUFRC(JK,JKT)=ZTUF(ILEVELF)
+ XTENDVFRC(JK,JKT)=ZTVF(ILEVELF)
ELSE
!
! interpolation between first and last levels
@@ -412,6 +426,8 @@ DO JKT = 1,NFRC
XRVFRC(JK,JKT) = ZRVF(JKLEV)*ZDZ2SDH + ZRVF(JKLEV+1)*ZDZ1SDH
XTENDTHFRC(JK,JKT)=ZGXRF(JKLEV)*ZDZ2SDH + ZGXRF(JKLEV+1)*ZDZ1SDH
XTENDRVFRC(JK,JKT)=ZGYRF(JKLEV)*ZDZ2SDH + ZGYRF(JKLEV+1)*ZDZ1SDH
+ XTENDUFRC(JK,JKT)=ZTUF(JKLEV)*ZDZ2SDH + ZTUF(JKLEV+1)*ZDZ1SDH
+ XTENDVFRC(JK,JKT)=ZTVF(JKLEV)*ZDZ2SDH + ZTVF(JKLEV+1)*ZDZ1SDH
END IF
END DO
END IF
@@ -577,6 +593,20 @@ IF (NVERB >= 10) THEN
WRITE(UNIT=ILUOUT,FMT='(I10,99(/8E10.3))') &
JK, (XTENDRVFRC(JK,JL), JL=1, NFRC)
END DO
+!
+ WRITE(UNIT=ILUOUT,FMT='(A)') &
+ "XTENDUFRC : wind advection tendency in X"
+ DO JK = 1, IKU
+ WRITE(UNIT=ILUOUT,FMT='(I10,99(/8E10.3))') &
+ JK, (XTENDUFRC(JK,JL), JL=1, NFRC)
+ END DO
+!
+ WRITE(UNIT=ILUOUT,FMT='(A)') &
+ "XTENDVFRC : wind advection tendency in Y"
+ DO JK = 1, IKU
+ WRITE(UNIT=ILUOUT,FMT='(I10,99(/8E10.3))') &
+ JK, (XTENDVFRC(JK,JL), JL=1, NFRC)
+ END DO
!
WRITE(UNIT=ILUOUT,FMT='(A)') &
"XPGROUNDFRC: SURF PRESSURE FORCING"
diff --git a/src/MNH/set_mass.f90 b/src/MNH/set_mass.f90
index 70b884026c6bc9f8f31248d777a7ac0f64cd1459..b5f9efbaac523855f3fdfa04410fbde2dd92cc75 100644
--- a/src/MNH/set_mass.f90
+++ b/src/MNH/set_mass.f90
@@ -181,9 +181,8 @@ INTEGER :: JI,JK,JJ
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZTHV3D_MX ! virtual potential temperature (mass level)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZTHVREF3D ! virtual potential temperature (mass level)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT),NRR):: ZMR3D_MX ! vapor mixing ratio (mass level)
-REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZUW3D_MX ! zonal wind component (flux level)
-REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZVW3D_MX ! meridian wind component (flux level)
-REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZWW3D_MX ! vertical wind speed (flux level)
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZUW3D_FL ! zonal wind component (flux level)
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZVW3D_FL ! meridian wind component (flux level)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPMHP_MX ! pressure minus hyd. pressure (mass level)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZRHOD_MX ! local rhod (mass level)
REAL,DIMENSION(SIZE(XZHAT)) :: ZRHOD_PROFILE ! local rhod (mass level) at initialization profile column
@@ -255,7 +254,6 @@ DO JI=1,IIU
ZMR3D_MX(JI,JJ,:,1)=PMRM(:)
ENDDO
ENDDO
-ZWW3D_MX(:,:,:)=0.
ZPMHP_MX(:,:,:)=0.
ZMR3D_MX(:,:,:,2:)=0.
IF(PRESENT(PMRCM)) THEN
@@ -287,6 +285,7 @@ ZRHOD_MX(:,:,:)=ZPMASS_MX(:,:,:)/(ZPMASS_MX(:,:,:)/XP00)**(XRD/XCPD) &
XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))/FLOAT(NIMAX_ll*NJMAX_ll)
+
!------------------------------
!* 2.3 Rotate wind in model axis and take into account variations in x,y
! directions on the mixed grid
@@ -377,7 +376,7 @@ ZNFLXZ_TOT_ll=SIGN(1.,ZNFLXZ_TOT_ll)*MAX(ABS(ZNFLXZ_TOT_ll),TINY(ZNFLXZ_TOT_ll))
DO JI=1,IIU
!!$ ZUW3D_MX(JI,:,:)=ZUYZ(:,:)* ( ZNFLX_TOT_ll(KILOC,1)/ZNFLX_TOT_ll(IXOR_ll-1+JI,1) ) ! add () for reproductibility
- ZUW3D_MX(JI,:,:)=ZUYZ(:,:)* ( ZNFLXZ_TOT_ll(KILOC)/ZNFLXZ_TOT_ll(IXOR_ll-1+JI) )
+ ZUW3D_FL(JI,:,:)=ZUYZ(:,:)* ( ZNFLXZ_TOT_ll(KILOC)/ZNFLXZ_TOT_ll(IXOR_ll-1+JI) )
END DO
!!$DEALLOCATE(ZNFLX_TOT_ll)
@@ -426,12 +425,12 @@ ZNFLYZ_TOT_ll=SIGN(1.,ZNFLYZ_TOT_ll)*MAX(ABS(ZNFLYZ_TOT_ll),TINY(ZNFLYZ_TOT_ll))
!
!
DO JJ=1,IJU
-!!$ ZVW3D_MX(:,JJ,:)= ZVXZ(:,:) * ( ZNFLY_TOT_ll(KJLOC,1)/ZNFLY_TOT_ll(IYOR_ll-1+JJ,1) ) ! add () for reproductibility
- ZVW3D_MX(:,JJ,:)= ZVXZ(:,:) * ( ZNFLYZ_TOT_ll(KJLOC)/ZNFLYZ_TOT_ll(IYOR_ll-1+JJ) )
+!!$ ZVW3D_FL(:,JJ,:)= ZVXZ(:,:) * ( ZNFLY_TOT_ll(KJLOC,1)/ZNFLY_TOT_ll(IYOR_ll-1+JJ,1) ) ! add () for reproductibility
+ ZVW3D_FL(:,JJ,:)= ZVXZ(:,:) * ( ZNFLYZ_TOT_ll(KJLOC)/ZNFLYZ_TOT_ll(IYOR_ll-1+JJ) )
END DO
- CALL MPPDB_CHECK3DM("SET_MASS:ZUW3D_MX,ZVW3D_MX",PRECISION,&
- & ZUW3D_MX,ZVW3D_MX )
+ CALL MPPDB_CHECK3DM("SET_MASS:ZUW3D_FL,ZVW3D_FL",PRECISION,&
+ & ZUW3D_FL,ZVW3D_FL )
!!$DEALLOCATE(ZNFLY_TOT_ll)
DEALLOCATE(ZNFLYZ_TOT,ZNFLYZ_TOT_ll)
@@ -442,7 +441,7 @@ DEALLOCATE(ZNFLYZ_TOT,ZNFLYZ_TOT_ll)
!
IF (PRESENT(PCORIOZ)) THEN
- CALL SET_GEOSBAL(ZUW3D_MX,ZVW3D_MX,PTHVM,PMRM, &
+ CALL SET_GEOSBAL(ZUW3D_FL,ZVW3D_FL,PTHVM,PMRM, &
KILOC,KJLOC,OBOUSS,ZTHV3D,PCORIOZ)
CALL COMPUTE_EXNER_FROM_TOP(ZTHV3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
XPABSM(:,:,:)=XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
@@ -479,8 +478,8 @@ CALL CLEANLIST_ll(TZFIELDS_ll)
!
! Interpolation of the wind
!
- ZRHODU_MX=ZUW3D_MX*ZRHOD_MX
- ZRHODV_MX=ZVW3D_MX*ZRHOD_MX
+ ZRHODU_MX=MZF(1,IKU,1,ZUW3D_FL)*ZRHOD_MX
+ ZRHODV_MX=MZF(1,IKU,1,ZVW3D_FL)*ZRHOD_MX
CALL MPPDB_CHECK3DM("SET_MASS:ZRHODU_MX,ZRHODV_MX,PZFLUX_MX,PZMASS_MX",PRECISION,&
& ZRHODU_MX,ZRHODV_MX,PZFLUX_MX,PZMASS_MX )
CALL VER_INT_DYN(OSHIFT,ZRHODU_MX,ZRHODV_MX,PZFLUX_MX,PZMASS_MX,PZS_MX,ZRHODUA,ZRHODVA)
diff --git a/src/MNH/shallow_mf.f90 b/src/MNH/shallow_mf.f90
index 1bf2aaa961252d71523ad6260eafb7f2261b1a54..a294f5859d3a01cb4e82d83379a9a17295dfdd4f 100644
--- a/src/MNH/shallow_mf.f90
+++ b/src/MNH/shallow_mf.f90
@@ -161,7 +161,9 @@ END MODULE MODI_SHALLOW_MF
!! S.Riette DUAL case
!! S. Riette Jan 2012: support for both order of vertical levels
!! R.Honnert 07/2012 : elemnts of Rio according to Bouteloup
-!! R.Honnert 07/2012 : EDKF gray zone
+!! R.Honnert 07/2012 : MF gray zone
+!! R.Honnert 10/2016 : SURF=gray zone initilisation + EDKF
+!! R.Honnert 10/2016 : Update with Arome
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -174,8 +176,10 @@ USE MODD_PARAM_MFSHALL_n
USE MODI_THL_RT_FROM_TH_R_MF
USE MODI_COMPUTE_UPDRAFT
USE MODI_COMPUTE_UPDRAFT_RHCJ10
+USE MODI_COMPUTE_UPDRAFT_RAHA
USE MODI_COMPUTE_UPDRAFT_HRIO
USE MODI_MF_TURB
+USE MODI_MF_TURB_EXPL
USE MODI_MF_TURB_GREYZONE
USE MODI_COMPUTE_MF_CLOUD
USE MODI_COMPUTE_FRAC_ICE
@@ -284,6 +288,8 @@ INTEGER :: IKE ! uppest atmosphere physical index
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF,PTHVREF
REAL, DIMENSION(SIZE(PTHM,1)) :: ZRESOL_NORM, ZRESOL_GRID,& ! normalized grid
ZLUP, ZPLAW
+! Test if the ascent continue, if LCL or ETL is reached
+LOGICAL :: GLMIX
INTEGER :: JI,JJ,JK ! loop counter
!------------------------------------------------------------------------
@@ -294,8 +300,9 @@ IKB=KKA+KKL*JPVEXT
IKE=KKU-KKL*JPVEXT
! updraft governing variables
-IF (HMF_UPDRAFT == 'EDKF'.OR. HMF_UPDRAFT == 'HRIO' .OR. &
- HMF_UPDRAFT == 'RHCJ'.OR. HMF_UPDRAFT == 'BOUT' ) THEN
+IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'HRIO' .OR. &
+ HMF_UPDRAFT == 'RHCJ' .OR. HMF_UPDRAFT == 'BOUT' .OR. &
+ HMF_UPDRAFT == 'SURF' ) THEN
PENTR = 1.E20
PDETR = 1.E20
PEMF = 1.E20
@@ -317,9 +324,9 @@ ZTHVM(:,:) = PTHM(:,:)*((1.+XRV / XRD *PRM(:,:,1))/(1.+ZRTM(:,:)))
!!! 2. Compute updraft
!!! ---------------
!
-IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'BOUT') THEN
+IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'BOUT' .OR. HMF_UPDRAFT == 'SURF') THEN
GENTR_DETR = .TRUE.
- CALL COMPUTE_UPDRAFT(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,&
+ CALL COMPUTE_UPDRAFT(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,HMF_UPDRAFT,GENTR_DETR,OMIXUV,&
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV,PPABSM,PRHODREF, &
@@ -341,6 +348,21 @@ ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN
PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, &
PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,&
PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
+ELSEIF (HMF_UPDRAFT == 'RAHA') THEN
+ CALL COMPUTE_UPDRAFT_RAHA(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE, &
+ GENTR_DETR,OMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PZZ,PDZZ, &
+ PSFTH,PSFRV, &
+ PPABSM,PRHODREF,PUM,PVM,PTKEM, &
+ PEXNM,PTHM,PRM(:,:,1),ZTHLM,ZRTM, &
+ PSVM,PTHL_UP,PRT_UP, &
+ PRV_UP,PRC_UP,PRI_UP, PTHV_UP, &
+ PW_UP, PU_UP, PV_UP, ZSV_UP, &
+ PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP, &
+ PEMF,PDETR,PENTR, &
+ ZBUO_INTEG,KKLCL,KKETL,KKCTL, &
+ ZDEPTH )
ELSEIF (HMF_UPDRAFT == 'DUAL') THEN
!Updraft characteristics are already computed and received by interface
ELSEIF (HMF_UPDRAFT == 'HRIO') THEN
@@ -385,7 +407,9 @@ CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,&
!!! ------------------------------------------------------------------------
!
ZEMF_O_RHODREF=PEMF/PRHODREF
- IF(HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ'.OR. HMF_UPDRAFT == 'BOUT') THEN
+ IF(HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ'.OR. HMF_UPDRAFT == 'BOUT' &
+ .OR. HMF_UPDRAFT == 'SURF') THEN
+ IF ( PIMPL_MF > 1.E-10 ) THEN
CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PIMPL_MF, PTSTEP, &
@@ -396,6 +420,14 @@ ZEMF_O_RHODREF=PEMF/PRHODREF
ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,ZSV_UP,&
PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
ZFLXZSVMF )
+ELSE
+ CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
+ PRHODJ, &
+ ZTHLM,ZTHVM,ZRTM,PUM,PVM, &
+ PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, &
+ ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, &
+ PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF)
+ENDIF
ELSEIF (HMF_UPDRAFT == 'HRIO') THEN
CALL MF_TURB_GREYZONE(KKA, IKB, IKE, KKU, KKL,OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
@@ -421,7 +453,8 @@ ZEMF_O_RHODREF=PEMF/PRHODREF
PTHVREF(:,JK)=RESHAPE(XTHVREF(:,:,JK),(/SIZE(PTHM,1)*SIZE(PTHM,2)/) )
ENDDO
ZG_O_THVREF=XG/PTHVREF
- CALL COMPUTE_BL89_ML(KKA,IKB,IKE,KKU,KKL,PDZZ,PTKEM,ZG_O_THVREF,ZTHVM,IKB,.TRUE.,ZLUP)
+ GLMIX=.TRUE.
+ CALL COMPUTE_BL89_ML(KKA,IKB,IKE,KKU,KKL,PDZZ,PTKEM(:,IKB) ,ZG_O_THVREF(:,IKB),ZTHVM,IKB,GLMIX,.TRUE.,ZLUP)
!! calcul de Dx/(h+hc)
DO JI=1,SIZE(XDXHAT)
DO JJ=1,SIZE(XDYHAT)
diff --git a/src/MNH/shallow_mf_pack.f90 b/src/MNH/shallow_mf_pack.f90
index f8c77d26e8a63eb589963a000983422b9e7d8fdd..a28a591dee6777faa70d633fe11b67face6a4d54 100644
--- a/src/MNH/shallow_mf_pack.f90
+++ b/src/MNH/shallow_mf_pack.f90
@@ -112,6 +112,7 @@ END MODULE MODI_SHALLOW_MF_PACK
!! V.Masson 09/2010
!! Modification R. Honnert 07/2012 : introduction of vertical wind
!! for the height of the thermal
+!! M. Leriche 02/2017 : avoid negative values for sv tendencies
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -358,8 +359,8 @@ PRVS(:,:,:) = PRVS(:,:,:) +MYM( &
DO JSV=1,ISV
IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + &
- PRHODJ(:,:,:)*ZDSVDT(:,:,:,JSV)
+ PRSVS(:,:,:,JSV) = MAX((PRSVS(:,:,:,JSV) + &
+ PRHODJ(:,:,:)*ZDSVDT(:,:,:,JSV)),XSVMIN(JSV))
END DO
!!! 7. call to MesoNH budgets
diff --git a/src/MNH/surf_solar_slopes.f90 b/src/MNH/surf_solar_slopes.f90
index 4c8bb61f1dfaa42013d364a56fbd0421a0a60bf2..9dd3fbe40e653dab6d3ced2f8c4d61a04e70bc3f 100644
--- a/src/MNH/surf_solar_slopes.f90
+++ b/src/MNH/surf_solar_slopes.f90
@@ -75,13 +75,14 @@ END MODULE MODI_SURF_SOLAR_SLOPES
!! Original 15/01/02
!! V. Masson 01/03/03 add multiple wavelengths
!! V. Masson 04/01/11 standard definition of azimuthal angle
+!! J.P. Chaboureau & Juan 21/08/2017 correction for tiny solar zenithal angle in R*4
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XPI
+USE MODD_CST, ONLY : XPI, XMNH_TINY
!
IMPLICIT NONE
!
@@ -173,14 +174,14 @@ DO JT=1,4
!* slope angles
!
ZSLOPANG = ATAN(SQRT(ZDZSDX**2+ZDZSDY**2))
- ZSLOPAZI = - 0.5*XPI - ATAN2( ZDZSDY, ZDZSDX + SIGN(1.E-30,ZDZSDX) )
+ ZSLOPAZI = - 0.5*XPI - ATAN2( ZDZSDY, ZDZSDX + SIGN(XMNH_TINY,ZDZSDX) )
!
!* modification of radiation received by 1 square meter of surface
! (of the triangle) because of its orientation relative to the sun
!
PDIRSWDT(JI,JJ,JT,:) = MAX( 0.0 , PDIRSRFSWD(JI,JJ,:) * ( &
COS(ZSLOPANG) &
- + SIN(ZSLOPANG) * PSINZEN(JI,JJ) / PCOSZEN(JI,JJ) &
+ + SIN(ZSLOPANG) * PSINZEN(JI,JJ) / MAX(PCOSZEN(JI,JJ), XMNH_TINY) &
* COS(PAZIMSOL(JI,JJ)-ZSLOPAZI) ) &
)
!
diff --git a/src/MNH/turb_ver_sv_flux.f90 b/src/MNH/turb_ver_sv_flux.f90
index ff6b4c950c57943fa88be2b80157046961f34c02..e6c58786ab0ff0cef2c04c4a358d06edaec429cd 100644
--- a/src/MNH/turb_ver_sv_flux.f90
+++ b/src/MNH/turb_ver_sv_flux.f90
@@ -266,6 +266,9 @@ END MODULE MODI_TURB_VER_SV_FLUX
!! change of YCOMMENT
!! Feb 2012(Y. Seity) add possibility to run with reversed
!! vertical levels
+!! Feb 2017(M. Leriche) add initialisation of ZSOURCE
+!! to avoid unknwon values outside physical domain
+!! and avoid negative values in sv tendencies
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -277,7 +280,7 @@ USE MODD_IO_ll, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_CONF
-USE MODD_NSV, ONLY : NSV_LGBEG,NSV_LGEND
+USE MODD_NSV, ONLY : XSVMIN,NSV_LGBEG,NSV_LGEND
!
USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_FMWRIT
@@ -391,6 +394,7 @@ DO JSV=1,ISV
ZA(:,:,:) = -PTSTEP*XCHF*PPSI_SV(:,:,:,JSV) * &
ZKEFF * MZM(KKA,KKU,KKL,PRHODJ) / &
PDZZ**2
+ ZSOURCE(:,:,:) = 0.
!
! Compute the sources for the JSVth scalar variable
@@ -417,6 +421,8 @@ DO JSV=1,ISV
! Compute the equivalent tendency for the JSV scalar variable
PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV)+ &
PRHODJ(:,:,:)*(ZRES(:,:,:)-PSVM(:,:,:,JSV))/PTSTEP
+! PRSVS(:,:,:,JSV)= MAX((PRSVS(:,:,:,JSV)+ &
+! PRHODJ(:,:,:)*(ZRES(:,:,:)-PSVM(:,:,:,JSV))/PTSTEP),XSVMIN(JSV))
!
IF ( (OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL ) THEN
! Diagnostic of the cartesian vertical flux
diff --git a/src/MNH/ver_prep_netcdf_case.f90 b/src/MNH/ver_prep_netcdf_case.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1ebc70d519ae3a2b3631161495001ef60fc1bab9
--- /dev/null
+++ b/src/MNH/ver_prep_netcdf_case.f90
@@ -0,0 +1,213 @@
+! ################################
+ MODULE MODI_VER_PREP_NETCDF_CASE
+! ################################
+INTERFACE
+ SUBROUTINE VER_PREP_NETCDF_CASE(PDIAG)
+!
+REAL, INTENT(OUT) :: PDIAG ! diagnostics computing time
+!
+END SUBROUTINE VER_PREP_NETCDF_CASE
+END INTERFACE
+END MODULE MODI_VER_PREP_NETCDF_CASE
+! ####################################################################
+ SUBROUTINE VER_PREP_NETCDF_CASE(PDIAG)
+! ####################################################################
+!
+!!**** *VER_PREP_NETCDF_CASE* - monitors the preparation to orographic change
+!!
+!! PURPOSE
+!! -------
+!! This routine monitors the preparation of variables to future change
+!! of orography, according to the type of input file.
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! function MZF
+!! function FMLOOK :to retrieve a logical unit number associated with a file
+!! routine VER_INTERP_TO_MIXED_GRID
+!! routine CHANGE_GRIBEX_VAR
+!!
+!! module MODI_SHUMAN
+!! module MODI_VER_INTERP_TO_MIXED_GRID
+!! module MODI_CHANGE_GRIBEX_VAR
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF1 : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!! Module MODD_LUNIT : contains logical unit names for all models
+!! CLUOUT0 : name of output-listing
+!! Module MODD_CST : contains physical constants
+!! XRD : gas constant for dry air
+!! XRV : gas constant for vapor
+!! XP00: reference pressure
+!! XCPD: specific heat for dry air
+!! XG : gravity constant
+!! XRADIUS : earth radius
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! V.Masson Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 14/12/94
+!! Jan, 31 1996 (V. Masson) duplication of the routine
+!! to accept different input fields
+!! May, 25 1996 (V. Masson) take into account the upper level
+!! Aug, 20 1996 (V. Masson) correction on theta
+!! Oct, 20 1996 (V. Masson) add deallocations
+!! Dec, 06 1996 (V. Masson) add air temperature at ground
+!! Dec, 12 1996 (V. Masson) add vertical wind velocity
+!! May, 07 1997 (V. Masson) add null tke
+!! Jun, 10 1997 (V. Masson) add null difference between
+!! pressure and hydrostatic pressure
+!! Jul, 11 1997 (V. Masson) add null scalar variables
+!! Nov, 22 2000 (I. Mallet) add scalar variables
+!! Nov, 22 2000 (P. Jabouille) change routine name
+!! May 2006 Remove EPS
+!! Oct 2017 (J.Escobar) minor, missing USE MODI_SECOND_MNH
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_THERMO
+USE MODE_FM
+!
+USE MODI_SHUMAN ! interface modules
+USE MODI_CHANGE_GRIBEX_VAR
+USE MODI_VER_INTERP_TO_MIXED_GRID
+USE MODI_RMS_AT_Z
+USE MODI_COMPUTE_EXNER_FROM_TOP
+USE MODI_WATER_SUM
+USE MODI_SECOND_MNH
+!
+USE MODD_CONF ! declaration modules
+USE MODD_CONF_n
+USE MODD_LUNIT
+USE MODD_CST
+USE MODD_PREP_REAL
+USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+REAL, INTENT(OUT) :: PDIAG ! diagnostics computing time
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+INTEGER :: IRESP, ILUOUT0
+INTEGER :: IIU,IJU,ILU
+REAL :: ZTIME1, ZTIME2
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTH_LS ! potential temperature
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTH_MX ! potential temperature
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZPMASS_MX ! pressure
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZHEXNFLUX_MX ! pressure function
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZHEXNMASS_MX ! pressure function
+!
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZZFLUX_LS
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZZMASS_LS
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZPMHP_LS
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_LS
+REAL,DIMENSION(:,:,:,:),ALLOCATABLE:: ZR_LS
+REAL,DIMENSION(:,:,:,:),ALLOCATABLE:: ZSV_LS
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZHU_LS
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZU_LS
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZV_LS
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZW_LS
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTKE_LS
+INTEGER :: JRR ! loop counter
+INTEGER :: JSV ! loop counter
+INTEGER :: JK ! loop counter
+!-------------------------------------------------------------------------------
+!
+CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
+!
+!* 1. CHANGING OF VARIABLES
+! ---------------------
+!
+ IIU=SIZE(XT_SV_LS,1)
+ IJU=SIZE(XT_SV_LS,2)
+ ILU=SIZE(XT_SV_LS,3)
+!
+!
+ ALLOCATE(XPMASS_SV_LS(IIU,IJU,ILU))
+ ALLOCATE(XZMASS_SV_LS(IIU,IJU,ILU),XZFLUX_SV_LS(IIU,IJU,ILU))
+ ALLOCATE(XTHV_SV_LS(IIU,IJU,ILU),XR_SV_LS(IIU,IJU,ILU,NRR),XHU_SV_LS(IIU,IJU,ILU))
+ CALL CHANGE_GRIBEX_VAR(XA_SV_LS,XB_SV_LS,XP00_SV_LS,XPS_SV_LS,XZS_SV_LS, &
+ XT_SV_LS,XQ_SV_LS,XPMASS_SV_LS,XZFLUX_SV_LS,XZMASS_SV_LS, &
+ XTHV_SV_LS,XR_SV_LS,XHU_SV_LS )
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. INTERPOLATION TO MIXED GRID AND DIAGNOSTIC VARIABLES
+! ----------------------------------------------------
+!* Add extra points below and above grids, in order to use MESONH linear
+! vertical interpolation programs with all ILU physical points
+!
+ALLOCATE(ZZMASS_LS(IIU,IJU,ILU+2*JPVEXT))
+ALLOCATE(ZSV_LS(IIU,IJU,ILU+2*JPVEXT,SIZE(XSV_LS,4)))
+!
+ZZMASS_LS (:,:,JPVEXT+1:JPVEXT+ILU) = XZMASS_SV_LS(:,:,:)
+DO JK=1,JPVEXT
+ ZZMASS_LS(:,:, JK) = XZMASS_SV_LS(:,:,1) - (XZMASS_SV_LS(:,:,2) -XZMASS_SV_LS(:,:,1) )*(JPVEXT+1-JK)
+ ZZMASS_LS(:,:,ILU+JPVEXT+JK) = XZMASS_SV_LS(:,:,ILU) + (XZMASS_SV_LS(:,:,ILU)-XZMASS_SV_LS(:,:,ILU-1))* JK
+END DO
+!
+!ZSV_LS = XUNDEF
+ZSV_LS = -999.
+!
+DO JSV=1,SIZE(XSV_LS,4)
+ ZSV_LS (:,:,JPVEXT+1:JPVEXT+ILU,JSV) = XSV_LS (:,:,:,JSV)
+END DO
+!
+ CALL VER_INTERP_TO_MIXED_GRID('CHEM',.TRUE.,XZS_SV_LS,XZS_SV_LS,&
+ ZZMASS_LS,ZSV_LS )
+!
+DEALLOCATE(ZZMASS_LS)
+DEALLOCATE(ZSV_LS)
+!-------------------------------------------------------------------------------
+!
+!* 3. ERROR CONTROL
+! -------------
+!
+CALL SECOND_MNH(ZTIME1)
+PDIAG = ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. DEALLOCATIONS
+! -------------
+!
+ DEALLOCATE(XA_SV_LS)
+ DEALLOCATE(XB_SV_LS)
+ DEALLOCATE(XT_SV_LS)
+ DEALLOCATE(XQ_SV_LS)
+ DEALLOCATE(XZMASS_SV_LS)
+ DEALLOCATE(XZFLUX_SV_LS)
+ DEALLOCATE(XTHV_SV_LS)
+ DEALLOCATE(XR_SV_LS)
+ DEALLOCATE(XHU_SV_LS)
+ DEALLOCATE(XSV_LS)
+!
+!
+!-------------------------------------------------------------------------------
+!
+WRITE(ILUOUT0,*) 'Routine VER_PREP_NETCDF_CASE completed'
+!
+END SUBROUTINE VER_PREP_NETCDF_CASE
diff --git a/src/MNH/version.f90 b/src/MNH/version.f90
index c54619c640fe85aa45b0e777ecb12e8d02e21f17..e481c29b4c2fdd57c1957fa05b826d62122659c8 100644
--- a/src/MNH/version.f90
+++ b/src/MNH/version.f90
@@ -46,7 +46,7 @@ NMNHVERSION(1)=5
NMNHVERSION(2)=3
NMNHVERSION(3)=0
NMASDEV=53
-NBUGFIX=0
+NBUGFIX=1
CBIBUSER=''
!
END SUBROUTINE VERSION
diff --git a/src/MNH/write_diachro.f90 b/src/MNH/write_diachro.f90
index e0ef36feb4421099a55bf5110ed89466ed3cb6d7..ed97ea0ae9d854a889a11a402a9da8b5d74552ed 100644
--- a/src/MNH/write_diachro.f90
+++ b/src/MNH/write_diachro.f90
@@ -68,7 +68,7 @@
!! add the initialization of the dimensions of
!! MASK array in MASK case with write outside the
!! routine.
-!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
+!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
!! D.Gazen+ G.Delautier 06/2016 modif for ncl files
!! P. Wautelet 09/06/2017: name of the variable added to the name of the written field
!! and better comment (true comment + units)
diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90
index acd050bda3dcec8dfc568e19232ca6f04f20e7b8..c1c3d75a86dc1850efe3ac2b325a68d5f2bcd0bd 100644
--- a/src/MNH/write_lfifm1_for_diag.f90
+++ b/src/MNH/write_lfifm1_for_diag.f90
@@ -142,6 +142,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG
!! D.Ricard 2015 : add THETAES + POVOES (LMOIST_ES=T)
!! Modification 01/2016 (JP Pinty) Add LIMA
!! C.Lac 04/2016 : add visibility and droplet deposition
+!! 10/2017 (G.Delautier) New boundary layer height : replace LBLTOP by CBLTOP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -323,6 +324,14 @@ TYPE(TFIELDDATA),DIMENSION(2) :: TZFIELD2
!
! LIMA LIDAR
REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMP1, ZTMP2, ZTMP3, ZTMP4
+!
+! hauteur couche limite
+REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZZZ_GRID1
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZTHVSOL,ZSHMIX
+REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZZONWIND,ZMERWIND,ZFFWIND2,ZRIB
+
+ !
+
!
!-------------------------------------------------------------------------------
!
@@ -2120,7 +2129,7 @@ END IF
!
!* Virtual potential temperature
!
-IF ( LMOIST_V .OR. LMSLP .OR. LBLTOP ) THEN
+IF ( LMOIST_V .OR. LMSLP .OR. CBLTOP/='NONE' ) THEN
ALLOCATE(ZTHETAV(IIU,IJU,IKU))
!
IF(NRR > 0) THEN
@@ -3183,7 +3192,7 @@ END IF
!
IF(LRADAR .AND. LUSERR) THEN
! CASE PREP_REAL_CASE after arome
- IF (CCLOUD=='NONE') THEN
+ IF (CCLOUD=='NONE' .OR. CCLOUD=='KESS') THEN
DEALLOCATE(XCIT)
ALLOCATE(XCIT(IIU,IJU,IKU))
XCIT(:,:,:)=800.
@@ -3530,12 +3539,81 @@ END IF
!
!* Height of boundary layer
!
-IF (LBLTOP) THEN
- ZGAMREF=3.5E-3 ! K/m
+IF (CBLTOP == 'THETA') THEN
+ !
+ ! méthode de la parcelle
+ !
+ ALLOCATE(ZSHMIX(IIU,IJU))
+
ZWORK31(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU))
ZWORK31(:,:,IKU)=2.*ZWORK31(:,:,IKU-1)-ZWORK31(:,:,IKU-2)
- CALL FREE_ATM_PROFILE(TPFILE,ZTHETAV,ZWORK31,XZS,XZSMT,ZGAMREF,ZWORK32,ZWORK33)
-END IF
+ ZWORK21(:,:) = ZTHETAV(:,:,IKB)+0.5
+ ZSHMIX(:,:) = 0.0
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ DO JK=IKB,IKE
+ IF ( ZTHETAV(JI,JJ,JK).GT.ZWORK21(JI,JJ) ) THEN
+ ZSHMIX(JI,JJ) = ZWORK31(JI,JJ,JK-1) &
+ +( ZWORK31(JI,JJ,JK) - ZWORK31 (JI,JJ,JK-1) ) &
+ /( ZTHETAV(JI,JJ,JK) - ZTHETAV(JI,JJ,JK-1) ) &
+ *( ZWORK21(JI,JJ) - ZTHETAV(JI,JJ,JK-1) )
+ EXIT
+ END IF
+ END DO
+ END DO
+ END DO
+ ZSHMIX(:,:)=ZSHMIX(:,:)-XZS(:,:)
+ ZSHMIX(:,:)=MAX(ZSHMIX(:,:),50.0)
+ YRECFM='HBLTOP'
+ YCOMMENT='Height of Boundary Layer TOP (M)'
+ ILENCH=LEN(YCOMMENT)
+ IGRID=1
+ CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,'XY',ZSHMIX,IGRID,ILENCH,YCOMMENT,IRESP) !
+ DEALLOCATE(ZSHMIX)
+
+ELSEIF (CBLTOP == 'RICHA') THEN
+ !
+ ! méthode du "bulk Richardson number"
+ !
+ ALLOCATE(ZRIB(IIU,IJU,IKU))
+ ALLOCATE(ZSHMIX(IIU,IJU))
+
+ ZWORK31(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU))
+ ZWORK31(:,:,IKU)=2.*ZWORK31(:,:,IKU-1)-ZWORK31(:,:,IKU-2)
+ ZWORK32=MXF(XUT)
+ ZWORK33=MYF(XVT)
+ ZWORK34=ZWORK32**2+ZWORK33**2
+ DO JK=IKB,IKE
+ ZRIB(:,:,JK)=XG*ZWORK31(:,:,JK)*(ZTHETAV(:,:,JK)-ZTHETAV(:,:,IKB))/(ZTHETAV(:,:,IKB)*ZWORK34(:,:,JK))
+ ENDDO
+ ZSHMIX=0.0
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ DO JK=IKB,IKE
+ IF ( ZRIB(JI,JJ,JK).GT.0.25 ) THEN
+ ZSHMIX(JI,JJ) = ZWORK31(JI,JJ,JK-1) &
+ +( ZWORK31(JI,JJ,JK) - ZWORK31(JI,JJ,JK-1) ) &
+ *( 0.25 - ZRIB(JI,JJ,JK-1) ) &
+ /( ZRIB(JI,JJ,JK) - ZRIB(JI,JJ,JK-1) )
+ EXIT
+ END IF
+ END DO
+ END DO
+ END DO
+ ZSHMIX(:,:)=ZSHMIX(:,:)-XZS(:,:)
+ YRECFM='HBLTOP'
+ YCOMMENT='Height of Boundary Layer TOP (M)'
+ ILENCH=LEN(YCOMMENT)
+ IGRID=1
+ CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,'XY',ZSHMIX,IGRID,ILENCH,YCOMMENT,IRESP) !
+ DEALLOCATE(ZRIB,ZSHMIX)
+ENDIF
+ ! used before 5-3-1 version
+ !
+ !ZGAMREF=3.5E-3 ! K/m
+ !ZWORK31(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU))
+ !ZWORK31(:,:,IKU)=2.*ZWORK31(:,:,IKU-1)-ZWORK31(:,:,IKU-2)
+ !CALL FREE_ATM_PROFILE(ZTHETAV,ZWORK31,XZS,XZSMT,ZGAMREF,ZWORK32,ZWORK33)
!
IF (ALLOCATED(ZTHETAV)) DEALLOCATE(ZTHETAV)
!
diff --git a/src/MNH/write_lfifm1_for_diag_supp.f90 b/src/MNH/write_lfifm1_for_diag_supp.f90
index fe6c2dfef8a13a359cfded461900e9f1b2d4c6a4..6ebc210d654333df31de62ec2557bced2190b636 100644
--- a/src/MNH/write_lfifm1_for_diag_supp.f90
+++ b/src/MNH/write_lfifm1_for_diag_supp.f90
@@ -88,6 +88,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
!! J.-P. Chaboureau 31/10/2016 add the call to RTTOV11
!! F. Brosse 10/2016 add chemical production destruction terms outputs
+!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -126,6 +127,7 @@ USE MODD_CH_AEROSOL, ONLY: LORILAM
USE MODD_CH_MNHC_n
USE MODD_CH_BUDGET_n
USE MODD_CH_PRODLOSSTOT_n
+USE MODD_CH_FLX_n, ONLY: XCHFLX
USE MODD_RAD_TRANSF
USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_ZON10M,XCURRENT_MER10M, &
XCURRENT_SFCO2, XCURRENT_SW, XCURRENT_LW
@@ -703,6 +705,22 @@ IF (NRAD_3D >= 1) THEN
END IF
!
!-------------------------------------------------------------------------------
+! Net surface gaseous fluxes
+!print*,'LCHEMDIAG, NSV_CHEMBEG, NSV_CHEMEND=',&
+!LCHEMDIAG, NSV_CHEMBEG, NSV_CHEMEND
+
+IF (LCHEMDIAG) THEN
+ DO JSV = NSV_CHEMBEG, NSV_CHEMEND
+ YRECFM = 'FLX_'//TRIM(CNAMES(JSV-NSV_CHEMBEG+1))
+ WRITE(YCOMMENT,'(A6,A,A26)')'X_Y_Z_',TRIM(CNAMES(JSV-NSV_CHEMBEG+1)), &
+ ' Net chemical flux ppb.m/s'
+ ILENCH = LEN(YCOMMENT)
+ ZWORK21(:,:) = XCHFLX(:,:,JSV-NSV_CHEMBEG+1) * 1E9
+ CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,'XY', ZWORK21(:,:), &
+ IGRID,ILENCH,YCOMMENT,IRESP)
+ END DO
+END IF
+!-------------------------------------------------------------------------------
!
!* Brightness temperatures from the radiatif transfer code (Morcrette, 1991)
!
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index edea3ee06f24c26972fe77d911d3a3750b8fae7a..3b3e802034ca8585a9d0447031cce5ce021d79df 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -1611,6 +1611,22 @@ IF (CPROGRAM /= 'IDEAL') THEN
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRC*1.0E3)
+!
+ ENDIF
+ ENDIF
+!
+ IF (ASSOCIATED(XINDEP)) THEN
+ IF (SIZE(XINDEP) /= 0 ) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP)
+ TZFIELD = TFIELDLIST(IID)
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINDEP*3.6E6)
+!
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACDEP',IID,IRESP)
+ TZFIELD = TFIELDLIST(IID)
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACDEP*1.0E3)
+!
ENDIF
ENDIF
!
@@ -1839,6 +1855,20 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPGROUNDFRC(JT))
+!
+ YRECFM='TENDUFRC'//YFRC
+ YCOMMENT=' '
+ IGRID=1
+ ILENCH=LEN(YCOMMENT)
+ CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,YDIR,XTENDUFRC(:,JT),IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+
+ YRECFM='TENDVFRC'//YFRC
+ YCOMMENT=' '
+ IGRID=1
+ ILENCH=LEN(YCOMMENT)
+ CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,YDIR,XTENDVFRC(:,JT),IGRID,ILENCH, &
+ YCOMMENT,IRESP)
!
END DO
!
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index 139e1730d4318cbf5a3ec9491166cc9f853204da..271135a13c185f89e8cbf5245b6505f86194e1f3 100644
--- a/src/MNH/write_stationn.f90
+++ b/src/MNH/write_stationn.f90
@@ -79,7 +79,7 @@ USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
USE MODD_LG, ONLY: CLGNAMES
USE MODD_DUST, ONLY: CDUSTNAMES, LDUST, NMODE_DST
-USE MODD_SALT, ONLY: CSALTNAMES
+USE MODD_SALT, ONLY: CSALTNAMES, LSALT, NMODE_SLT
USE MODD_NSV
USE MODD_DIAG_IN_RUN
!
@@ -88,6 +88,7 @@ USE MODD_GRID_n
USE MODD_STATION_n
!
USE MODE_DUST_PSD
+USE MODE_SALT_PSD
USE MODE_AERO_PSD
!
USE MODI_WRITE_DIACHRO
@@ -152,11 +153,13 @@ INTEGER :: JSV ! loop counter
IF (TSTATION%X(II)==XUNDEF) RETURN
IF (TSTATION%Y(II)==XUNDEF) RETURN
!
-IPROC = 8 + SIZE(TSTATION%R,3) + SIZE(TSTATION%SV,3)
+IPROC = 8 + SIZE(TSTATION%R,3) + SIZE(TSTATION%SV,3)
+
IF (SIZE(TSTATION%TKE )>0) IPROC = IPROC + 1
IF (LDIAG_IN_RUN) IPROC = IPROC + 13
-IF (LORILAM) IPROC = IPROC + JPMODE*3
+IF (LORILAM) IPROC = IPROC + JPMODE*(3+NSOA+NCARB+NSP)
IF (LDUST) IPROC = IPROC + NMODE_DST*3
+IF (LSALT) IPROC = IPROC + NMODE_SLT*3
IF (SIZE(TSTATION%TSRAD)>0) IPROC = IPROC + 1
IF (SIZE(TSTATION%SFCO2,1)>0) IPROC = IPROC +1
!
@@ -340,6 +343,7 @@ IF (SIZE(TSTATION%TKE,1)>0) THEN
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%TKE(:,II)
END IF
!
+!
IF (SIZE(TSTATION%SV,3)>=1) THEN
! User scalar variables
DO JSV = 1,NSV_USER
@@ -390,6 +394,13 @@ IF (SIZE(TSTATION%SV,3)>=1) THEN
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%SV(:,II,JSV) * 1.E9
END DO
! aerosol scalar variables
+ DO JSV = NSV_AERBEG,NSV_AEREND
+ JPROC = JPROC+1
+ YTITLE(JPROC)= TRIM(CAERONAMES(JSV-NSV_AERBEG+1))
+ YUNIT (JPROC) = 'PPB'
+ YCOMMENT (JPROC) = ' '
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%SV(:,II,JSV) *1.E9
+ END DO
IF ((LORILAM).AND. .NOT.(ANY(TSTATION%P(:,II) == 0.))) THEN
ALLOCATE (ZSV(1,1,SIZE(TSTATION%TIME),NSV_AER))
@@ -475,6 +486,7 @@ IF (SIZE(TSTATION%SV,3)>=1) THEN
WRITE(YCOMMENT,'(A23,I1,A7)')'MASS NH3 AEROSOL MODE ',JSV,'(ug/m3)'
ZWORK6(1,1,1,:,1,JPROC)=ZPTOTA(1,1,:,JP_AER_NH3,JSV)
JPROC = JPROC+1
+ IF (NSOA == 10) THEN
WRITE(YTITLE(JPROC),'(A5,I1)')'MSOA1',JSV
YUNIT (JPROC) = 'ug/m3'
WRITE(YCOMMENT,'(A23,I1,A7)')'MASS SOA1 AEROSOL MODE ',JSV,'(ug/m3)'
@@ -524,6 +536,7 @@ IF (SIZE(TSTATION%SV,3)>=1) THEN
YUNIT (JPROC) = 'ug/m3'
WRITE(YCOMMENT,'(A24,I1,A7)')'MASS SOA10 AEROSOL MODE ',JSV,'(ug/m3)'
ZWORK6(1,1,1,:,1,JPROC)=ZPTOTA(1,1,:,JP_AER_SOA10,JSV)
+ END IF
ENDDO
DEALLOCATE (ZSV,ZRHO)
@@ -590,6 +603,50 @@ IF (SIZE(TSTATION%SV,3)>=1) THEN
END DO
ENDIF
!
+ IF ((LSALT).AND. .NOT.(ANY(TSTATION%P(:,II) == 0.))) THEN
+ ALLOCATE (ZSV(1,1,SIZE(TSTATION%TIME),NSV_SLT))
+ ALLOCATE (ZRHO(1,1,SIZE(TSTATION%TIME)))
+ ALLOCATE (ZN0(1,1,SIZE(TSTATION%TIME),NMODE_SLT))
+ ALLOCATE (ZRG(1,1,SIZE(TSTATION%TIME),NMODE_SLT))
+ ALLOCATE (ZSIG(1,1,SIZE(TSTATION%TIME),NMODE_SLT))
+ ZSV(1,1,:,1:NSV_SLT) = TSTATION%SV(:,II,NSV_SLTBEG:NSV_SLTEND)
+ IF (SIZE(TSTATION%R,3) >0) THEN
+ ZRHO(1,1,:) = 0.
+ DO JRR=1,SIZE(TSTATION%R,3)
+ ZRHO(1,1,:) = ZRHO(1,1,:) + TSTATION%R(:,II,JRR)
+ ENDDO
+ ZRHO(1,1,:) = TSTATION%TH(:,II) * ( 1. + XRV/XRD*TSTATION%R(:,II,1) ) &
+ / ( 1. + ZRHO(1,1,:) )
+ ELSE
+ ZRHO(1,1,:) = TSTATION%TH(:,II)
+ ENDIF
+ ZRHO(1,1,:) = TSTATION%P(:,II) / &
+ (XRD *ZRHO(1,1,:) *((TSTATION%P(:,II)/XP00)**(XRD/XCPD)) )
+ CALL PPP2SALT(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0)
+ DO JSV=1,NMODE_SLT
+ ! mean radius
+ JPROC = JPROC+1
+ WRITE(YTITLE(JPROC),'(A6,I1)')'SLTRGA',JSV
+ YUNIT (JPROC) = 'um'
+ WRITE(YCOMMENT(JPROC),'(A18,I1,A5)')'RG (nb) SALT MODE ',JSV,' (um)'
+ ZWORK6 (1,1,1,:,1,JPROC) = ZRG(1,1,:,JSV)
+ ! standard deviation
+ JPROC = JPROC+1
+ WRITE(YTITLE(JPROC),'(A7,I1)')'SLTSIGA',JSV
+ YUNIT (JPROC) = ' '
+ WRITE(YCOMMENT(JPROC),'(A16,I1)')'SIGMA DUST MODE ',JSV
+ ZWORK6 (1,1,1,:,1,JPROC) = ZSIG(1,1,:,JSV)
+ ! particles number
+ JPROC = JPROC+1
+ WRITE(YTITLE(JPROC),'(A6,I1)')'SLTN0A',JSV
+ YUNIT (JPROC) = ' '
+ WRITE(YCOMMENT(JPROC),'(A13,I1,A6)')'N0 DUST MODE ',JSV,' (1/m3)'
+ ZWORK6 (1,1,1,:,1,JPROC) = ZN0(1,1,:,JSV)
+ ENDDO
+ DEALLOCATE (ZSV,ZRHO)
+ DEALLOCATE (ZN0,ZRG,ZSIG)
+ END IF
+
IF (SIZE(TSTATION%TSRAD,1)>0) THEN
JPROC = JPROC+1
YTITLE (JPROC) = 'Tsrad'
@@ -605,13 +662,13 @@ IF (SIZE(TSTATION%SFCO2,1)>0) THEN
YCOMMENT (JPROC) = 'CO2 Surface Flux'
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%SFCO2(:,II)
END IF
+!
!----------------------------------------------------------------------------
!
!
ALLOCATE (ZW6(1,1,1,SIZE(TSTATION%TIME),1,JPROC))
ZW6 = ZWORK6(:,:,:,:,:,:JPROC)
DEALLOCATE(ZWORK6)
-
!
CALL WRITE_DIACHRO(TPDIAFILE,CLUOUT0,YGROUP,"CART",IGRID, TSTATION%DATIME,&
ZW6,ZTRAJT,YTITLE,YUNIT,YCOMMENT,&
diff --git a/src/Makefile b/src/Makefile
index 86cddd7a19a8231fb5a6637e0361e28749b9430f..4c9ffe28a2dbbe486bb2ce954374bd959250d7d5 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -383,7 +383,7 @@ install : $(patsubst %,%-${ARCH_XYZ},$(PROG_LIST)) install_tools
$(PROG_LIST) : OBJ_PROG=$(shell find $(PROG_DIR) -follow -type f -name "spll_*.f*" \
| xargs grep -l -E -i "^[[:space:]]*program *$@" | sed -e 's/\.f.*/.o/g' | head -1 \
- | xargs basename | xargs -i find $(PROG_DIR) -follow -name {} -print | head -1 )
+ | xargs basename | xargs -I{} find $(PROG_DIR) -follow -name {} -print | head -1 )
$(PROG_LIST) : $(LIB_MNH) $(LIB_GRIBEX)
# echo OBJ_PROG=$(OBJ_PROG)
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index 8cbe5bb7827f1acbd763b2b9e45bd80774e22ab1..9671c06ffa9b00c923c65d8ccc5f289604941534 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -50,7 +50,7 @@ CPPFLAGS += $(CPPFLAGS_MNH)
INC += $(INC_MNH)
ifeq "$(MNH_INT)" "8"
-CPPFLAGS += -DMNH_INT8
+CPPFLAGS += -DMNH_INT=8
endif
#
@@ -65,7 +65,8 @@ OBJS_NOCB += spll_dxf.o spll_dxm.o spll_dyf.o spll_dym.o \
spll_mzm.o spll_mzf4.o spll_mzm4.o \
spll_gx_m_m.o spll_gx_m_u.o spll_gy_m_m.o \
spll_gy_m_v.o spll_gz_m_m.o spll_gz_m_w.o \
- spll_dzf_mf.o spll_dzm_mf.o spll_mzf_mf.o spll_mzm_mf.o
+ spll_dzf_mf.o spll_dzm_mf.o spll_mzf_mf.o spll_mzm_mf.o \
+ spll_modi_gradient_m_d.o
$(OBJS_NOCB) : OPT = $(OPT_NOCB)
@@ -244,7 +245,12 @@ INC_MPI = -I$(B)$(DIR_MPI)
DIR_MASTER += $(DIR_MPI)
OBJS_LISTE_MASTER += mpivide.o
INC += $(INC_MPI)
-mpivide.o : CPPFLAGS += -DFUJI -DMNH_INT=$(MNH_INT)\
+ifneq "$(MNH_REAL)" "R4"
+MNH_REALS=8
+else
+MNH_REALS=4
+endif
+mpivide.o : CPPFLAGS += -DFUJI -DMNH_INT=$(MNH_INT) -DMNH_REALS=$(MNH_REALS) \
-I$(DIR_MPI)/include
VPATH += $(DIR_MPI)
endif
@@ -421,7 +427,7 @@ endif
##########################################################
# NETCDF4 INPUT/OUTPUT in MesoNH
ifdef MNH_IOCDF4
-CPPFLAGS_MNH += -DMNH_IOCDF4
+CPPFLAGS_MNH += -DMNH_IOCDF4=$(MNH_IOCDF4)
endif
#
# NetCDF : AUTO install of netcdf-4.X.X on PC linux to avoid problem with compiler
diff --git a/src/Rules.BGQ.mk b/src/Rules.BGQ.mk
index a1849d2b1a1ba21a72cb574bc8e31417644fe92d..d9d9110bcd4b439e6bd3ceb71e6a5377c6787f58 100644
--- a/src/Rules.BGQ.mk
+++ b/src/Rules.BGQ.mk
@@ -143,7 +143,7 @@ CPP = cpp -P -traditional -Wcomment
#
CPPFLAGS_SURFEX =
#CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_SP4 -DMNH_MPI_ISEND -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
-CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_SP4 -DMNH_MPI_BSEND -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_SP4 -DMNH_MPI_BSEND -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND) -DSNGL=REAL
CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
CPPFLAGS_MNH = -DAMAX1=MAX -DMNH -DSFX_MNH
diff --git a/src/Rules.LXgfortran.mk b/src/Rules.LXgfortran.mk
index edb7d41cc831ba3062d804a26f850dbe8c27c102..dec164ce1795effcc1d1151aa6f6e42b61b20d4c 100644
--- a/src/Rules.LXgfortran.mk
+++ b/src/Rules.LXgfortran.mk
@@ -70,7 +70,7 @@ F77FLAGS = $(OPT)
FX90 = $(F90)
FX90FLAGS = $(OPT)
#
-LDFLAGS = -Wl,-warn-once
+#LDFLAGS = -Wl,-warn-once
#
# preprocessing flags
#
diff --git a/src/Rules.LXifort.mk b/src/Rules.LXifort.mk
index f73545ed7891c1ff06d87a208247baabb5d83ca0..92f8e8b526af6363777f8fe57d1e7683d0daa87b 100644
--- a/src/Rules.LXifort.mk
+++ b/src/Rules.LXifort.mk
@@ -105,7 +105,7 @@ FX90FLAGS = $(OPT)
# -132
#
#LDFLAGS = -Wl,-noinhibit-exec -Wl,-warn-once $(PAR)
-LDFLAGS = -Wl,-warn-once $(PAR) $(OPT_BASE)
+LDFLAGS = -Wl,-warn-once $(PAR) -Wl,-rpath=$(LD_LIBRARY_PATH) $(OPT_BASE)
#
# preprocessing flags
#
diff --git a/src/SURFEX/ch_init_emissionn.F90 b/src/SURFEX/ch_init_emissionn.F90
index fe1a1da8823cc846115dc59554702b57d5d10525..6ff89e7e28da3b0891807d436b29e8c6cf3f5f9a 100644
--- a/src/SURFEX/ch_init_emissionn.F90
+++ b/src/SURFEX/ch_init_emissionn.F90
@@ -29,6 +29,8 @@
!! P.Tulet 01/01/04 introduction of rhodref for externalization
!! M.Leriche 04/2014 change length of CHARACTER for emission 6->12
!! M.Leriche & V. Masson 05/16 bug in write emis fields for nest
+!! J. Pianezze 04/17 wrong length of YCOMMENT (100 instead of 40)
+!! 06/06/17 (V.Masson & M. Leriche) add emission time by species
!-----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -76,7 +78,7 @@ REAL, DIMENSION(:),INTENT(IN) :: PRHOA ! air density
INTEGER :: IRESP ! File
INTEGER :: ILUOUT ! output listing logical unit
CHARACTER (LEN=LEN_HREC) :: YRECFM ! management
- CHARACTER (LEN=100) :: YCOMMENT ! variables
+ CHARACTER (LEN=40) :: YCOMMENT ! variables
INTEGER :: JSPEC ! Loop index for cover data
INTEGER :: IIND1,IIND2 ! Indices counter
!
@@ -138,7 +140,7 @@ ELSE
WRITE(ILUOUT,*) 'CEMIS_NAME already allocated with SIZE :',SIZE(CHE%CEMIS_NAME)
END IF
-IF (.NOT. ASSOCIATED(CHE%CEMIS_AREA)) ALLOCATE(CHE%CEMIS_AREA(CHE%NEMISPEC_NBR))
+IF (.NOT. ASSOCIATED(CHE%NEMIS_NBT)) ALLOCATE(CHE%NEMIS_NBT(CHE%NEMISPEC_NBR))
IF (.NOT. ASSOCIATED(CHE%NEMIS_TIME)) ALLOCATE(CHE%NEMIS_TIME(CHE%NEMIS_NBR))
CHE%NEMIS_TIME(:) = -1
!
@@ -169,9 +171,6 @@ DO JSPEC = 1,CHE%NEMISPEC_NBR ! Loop on the number of species
CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
END IF
- WRITE(YRECFM,'("EMISAREA",I3.3)') JSPEC
- CALL READ_SURF( &
- HPROGRAM,YRECFM,YSURF,IRESP,YCOMMENT)
WRITE(YRECFM,'("EMISNBT",I3.3)') JSPEC
CALL READ_SURF( &
HPROGRAM,YRECFM,INBTS,IRESP,YCOMMENT)
@@ -205,10 +204,9 @@ DO JSPEC = 1,CHE%NEMISPEC_NBR ! Loop on the number of species
!
CHE%NTIME_MAX = MAXVAL(CHE%NEMIS_TIME)
!
-! INBTIMES, CEMIS_AREA and CEMIS_NAME
+! INBTIMES and CEMIS_NAME
! are updated for ALL species
CHE%CEMIS_NAME(JSPEC) = YSPEC_NAME
- CHE%CEMIS_AREA(JSPEC) = YSURF
!
!* 2. Simple reading of emission fields
@@ -223,6 +221,8 @@ DO JSPEC = 1,CHE%NEMISPEC_NBR ! Loop on the number of species
!
END DO
!
+CHE%NEMIS_NBT(:) = INBTIMES(:)
+
WRITE(ILUOUT,*) '---- Nunmer of OFFLINE species = ',INBOFF
WRITE(ILUOUT,*) 'INBTIMES=',INBTIMES
WRITE(ILUOUT,*) 'IOFFNDX=',IOFFNDX
diff --git a/src/SURFEX/get_vegn.F90 b/src/SURFEX/get_vegn.F90
index da43404278db6d1905c415c67c8f2979221d3785..4959d594a056354276e2019476e3d03ed4eff85e 100644
--- a/src/SURFEX/get_vegn.F90
+++ b/src/SURFEX/get_vegn.F90
@@ -69,7 +69,6 @@ REAL, DIMENSION(KI), INTENT(OUT) :: PLAI
!
INTEGER :: JI,JJ ! loop index over tiles
INTEGER :: ILUOUT ! unit numberi
-REAL, DIMENSION(U%NSIZE_FULL) :: ZH_TREE_FULL, ZLAI_FULL
REAL, DIMENSION(U%NSIZE_NATURE) :: ZH_TREE, ZLAI,ZWORK
INTEGER:: IPATCH_TRBE, IPATCH_TRBD, IPATCH_TEBE, IPATCH_TEBD, IPATCH_TENE, &
IPATCH_BOBD, IPATCH_BONE, IPATCH_BOND
@@ -85,10 +84,6 @@ INTEGER:: IPATCH_TRBE, IPATCH_TRBD, IPATCH_TEBE, IPATCH_TEBD, IPATCH_TENE, &
!* 1. Passage dur le masque global
! -------------------------------
-
-ZH_TREE_FULL(:) = 0.
-ZLAI_FULL (:) = XUNDEF
-
IPATCH_TRBE = VEGTYPE_TO_PATCH(NVT_TRBE, I%NPATCH)
IPATCH_TRBD = VEGTYPE_TO_PATCH(NVT_TRBD, I%NPATCH)
IPATCH_TEBE = VEGTYPE_TO_PATCH(NVT_TEBE, I%NPATCH)
@@ -131,38 +126,36 @@ DO JJ=1,U%NSIZE_NATURE
( I%XLAI(JJ,IPATCH_BONE) * I%XVEGTYPE(JJ,NVT_BONE) )+ &
( I%XLAI(JJ,IPATCH_BOND) * I%XVEGTYPE(JJ,NVT_BOND) )
- ZH_TREE_FULL(U%NR_NATURE(JJ)) = ZH_TREE(JJ)
- ZLAI_FULL (U%NR_NATURE(JJ)) = ZLAI(JJ)
!
END IF
!
+ ZLAI(JJ) = U%XNATURE(U%NR_NATURE(JJ)) * ZLAI(JJ)
+ !
END DO
!
-ZLAI_FULL(:) = U%XNATURE(:) * ZLAI_FULL(:)
-!
!* 2. Envoi les variables vers mesonH
! ------------------------------
-IF ( SIZE(PVH) /= SIZE(ZH_TREE_FULL) ) THEN
+IF ( SIZE(PVH) /= SIZE(ZH_TREE) ) THEN
WRITE(ILUOUT,*) 'try to get VH field from atmospheric model, but size is not correct'
WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (PVH) :', SIZE(PVH)
- WRITE(ILUOUT,*) 'size of field inthe surface (XVH) :', SIZE(ZH_TREE_FULL)
+ WRITE(ILUOUT,*) 'size of field inthe surface (XVH) :', SIZE(ZH_TREE)
CALL ABOR1_SFX('GET_VHN: VH SIZE NOT CORRECT')
ELSE
- PVH = ZH_TREE_FULL
+ PVH = ZH_TREE
END IF
!
!==============================================================================
!
!-------------------------------------------------------------------------------
!
-IF ( SIZE(PLAI) /= SIZE(ZLAI_FULL) ) THEN
+IF ( SIZE(PLAI) /= SIZE(ZLAI) ) THEN
WRITE(ILUOUT,*) 'try to get LAI field from atmospheric model, but size is not correct'
WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (PLAI) :', SIZE(PLAI)
- WRITE(ILUOUT,*) 'size of field inthe surface (XLAI) :', SIZE(ZLAI_FULL)
+ WRITE(ILUOUT,*) 'size of field inthe surface (XLAI) :', SIZE(ZLAI)
CALL ABOR1_SFX('GET_LAIN: LAI SIZE NOT CORRECT')
ELSE
- PLAI = ZLAI_FULL
+ PLAI = ZLAI
END IF
!
!==============================================================================
diff --git a/src/SURFEX/init_tebn.F90 b/src/SURFEX/init_tebn.F90
index 88c96c16a5fc5b4e013b546592c107d5ef064a62..4e4481c9388f4c48cd8d665421af13f75416866d 100644
--- a/src/SURFEX/init_tebn.F90
+++ b/src/SURFEX/init_tebn.F90
@@ -44,6 +44,7 @@
!! G. Pigeon 09/2012: add ROUGH_WALL/ROUGH_ROOF/CH_BEM for conv. coef.
!! B. Decharme 04/2013 new coupling variables
!! delete CTOPREG option (never used)
+!! M.Moge 02/2015 MPPDB_CHECK
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -119,6 +120,11 @@ USE MODI_SET_SURFEX_FILEIN
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+#ifdef MNH_PARALLEL
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
+USE MODE_MPPDB
+!
+#endif
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -304,6 +310,9 @@ END SELECT
!
CALL READ_PGD_TEB_n(DTCO, U, TM,GCP, &
HPROGRAM)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(TM%TOP%XCOVER,"INIT_TEB_n after READ_PGD_TEB_n:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TM%TOP%XCOVER,2))
+#endif
!
CALL END_IO_SURF_n(HPROGRAM)
!
@@ -314,6 +323,9 @@ ILU = SIZE(TM%TOP%XCOVER,1)
ALLOCATE(TM%TOP%XTEB_PATCH(ILU,TM%TOP%NTEB_PATCH))
CALL CONVERT_TEB(TM%TOP, &
TM%TOP%XCOVER,TM%TOP%XTEB_PATCH)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(TM%TOP%XCOVER,"INIT_TEB_n after CONVERT_TEB:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TM%TOP%XCOVER,2))
+#endif
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name
CALL INIT_IO_SURF_n(DTCO, DGU, U, &
@@ -680,6 +692,9 @@ DO JPATCH=1,TM%TOP%NTEB_PATCH
CALL DIAG_MISC_TEB_INIT_n(TM%DGCT, TM%DGMT, TM%DGMTO, TM%TOP, &
HPROGRAM,ILU,ISWB)
END DO ! end of loop on patches
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(TM%TOP%XCOVER,"INIT_TEB_n end:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TM%TOP%XCOVER,2))
+#endif
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/interpol_field2d.F90 b/src/SURFEX/interpol_field2d.F90
index ce1ebe678592734ab7cf4a63c2750ecb9795ec7c..96d8b668abed0a607b7f4ccfd07fe2b969985006 100644
--- a/src/SURFEX/interpol_field2d.F90
+++ b/src/SURFEX/interpol_field2d.F90
@@ -33,6 +33,7 @@
!! Modification
!! A. Alias 07/2013 add MODI_ABOR1_SFX
!! A. Alias 05/2016 add MODI_GET_INTERP_HALO
+!! J. Escobar 09/2017 differencied error message :: SFX / NAM_IO_OFFLINE <=> MNH / NAM_PGDFILE
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -144,7 +145,7 @@ IF (IERR1>0 .OR. IERR2>0) THEN
WRITE(KLUOUT,*) ' ----------------------'
WRITE(KLUOUT,*) ' '
WRITE(KLUOUT,*) ' Number of points interpolated with ',INPTS,' nearest points: ', &
- IERR1
+ IERR1,' Total=',U%NDIM_FULL
!
!
IF (IERR2>0) THEN
@@ -164,9 +165,17 @@ END IF
!
IF (IERR2>0) THEN
!
- IF (.NOT.PRESENT(PDEF) .OR. (INEAR_NBR<U%NDIM_FULL .AND. IERR2/=IERR0)) &
- CALL ABOR1_SFX('Some points lack data and are too far away from other points. &
- Please define a higher halo value in NAM_IO_OFFLINE.')
+ IF (.NOT.PRESENT(PDEF) .OR. (INEAR_NBR<U%NDIM_FULL .AND. IERR2/=IERR0)) THEN
+#ifdef MNH
+ WRITE(KLUOUT,*) 'NDIM_FULL=',U%NDIM_FULL,',NHALO=',IHALO,',Pts to interpol=',IERR0 &
+ ,',Pts interpolated=',IERR1,',Pts missing=',IERR2
+ CALL ABOR1_SFX('Some points lack data and are too far away from other points. &
+ Please define a higher halo value in &NAM_PGDFILE NHALO=xxx /')
+#else
+ CALL ABOR1_SFX('Some points lack data and are too far away from other points. &
+ Please define a higher halo value in NAM_IO_OFFLINE.')
+#endif
+ ENDIF
!
ENDIF
!
diff --git a/src/SURFEX/interpol_npts.F90 b/src/SURFEX/interpol_npts.F90
index d368600a8626e25d9d4a091be0b00bd2763a9cc0..bc63cedc9d9018f0e945a1df3ce3a0989cbb62af 100644
--- a/src/SURFEX/interpol_npts.F90
+++ b/src/SURFEX/interpol_npts.F90
@@ -164,6 +164,7 @@ DO JL=1,IL
END IF
INPTS = KNPTS
ISCAN = ISCAN_ALL
+ ICOUNT = ISCAN
IINDEX(:) = IINDEX_ALL(:)
!
ELSE
@@ -178,19 +179,19 @@ DO JL=1,IL
END IF
END DO
!
- !IF (ICOUNT>=1) THEN
- IF (ICOUNT>=KNPTS) THEN
- ISCAN = ICOUNT
- !INPTS = MIN(ICOUNT,KNPTS)
- INPTS = KNPTS
- ELSEIF (KNEAR_NBR>=U%NDIM_FULL .AND. ICOUNT>=1) THEN
- ISCAN = ICOUNT
- INPTS = ICOUNT
- ELSE
- KCODE(JL) = -4
- CYCLE
- END IF
- !
+ ENDIF
+ !
+ !IF (ICOUNT>=1) THEN
+ IF (ICOUNT>=KNPTS) THEN
+ ISCAN = ICOUNT
+ !INPTS = MIN(ICOUNT,KNPTS)
+ INPTS = KNPTS
+ ELSEIF (KNEAR_NBR>=U%NDIM_FULL .AND. ICOUNT>=1) THEN
+ ISCAN = ICOUNT
+ INPTS = ICOUNT
+ ELSE
+ KCODE(JL) = -4
+ CYCLE
END IF
!
DO JS=1,ISCAN
diff --git a/src/SURFEX/modd_ch_emis_fieldn.F90 b/src/SURFEX/modd_ch_emis_fieldn.F90
index 4afe98c79b3172ced1ceb53e223f6aba7c60a44f..daf991dcee06f7fa22a4033778e121c36b4bf28f 100644
--- a/src/SURFEX/modd_ch_emis_fieldn.F90
+++ b/src/SURFEX/modd_ch_emis_fieldn.F90
@@ -30,6 +30,7 @@
!! -------------
!! Original 08/03/2001
!! 01/12/03 (D.Gazen) change emissions handling for surf. externalization
+!! 06/06/17 (V.Masson & M. Leriche) add emission time by species
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -63,6 +64,8 @@ TYPE CH_EMIS_FIELD_t
CHARACTER(LEN=40), DIMENSION(:), POINTER :: CEMIS_COMMENT ! comment
CHARACTER(LEN=40), DIMENSION(:), POINTER :: CEMIS_NAME
! ! name of the chemical pgd fields (emitted species)
+!
+ INTEGER, DIMENSION(:), POINTER :: NEMIS_NBT ! number of emission time by species
!
INTEGER, DIMENSION(:), POINTER :: NEMIS_TIME ! emission time
!
@@ -94,6 +97,7 @@ IF (LHOOK) CALL DR_HOOK("MODD_CH_EMIS_FIELD_N:CH_EMIS_FIELD_INIT",0,ZHOOK_HANDLE
NULLIFY(YCH_EMIS_FIELD%CEMIS_AREA)
NULLIFY(YCH_EMIS_FIELD%CEMIS_COMMENT)
NULLIFY(YCH_EMIS_FIELD%CEMIS_NAME)
+ NULLIFY(YCH_EMIS_FIELD%NEMIS_NBT)
NULLIFY(YCH_EMIS_FIELD%NEMIS_TIME)
NULLIFY(YCH_EMIS_FIELD%XEMIS_FIELDS)
NULLIFY(YCH_EMIS_FIELD%TSEMISS)
diff --git a/src/SURFEX/modd_surf_par.F90 b/src/SURFEX/modd_surf_par.F90
index e191f6426b5bcd8405cceb7199b5c335d898f75a..2947cd3b09848242c0076ed458ca118df77cdd36 100644
--- a/src/SURFEX/modd_surf_par.F90
+++ b/src/SURFEX/modd_surf_par.F90
@@ -28,6 +28,7 @@ MODULE MODD_SURF_PAR
!! -------------
!! Original 02/2004
!! J.Escobar 06/2013 for REAL4/8 add EPSILON management
+!! J.Escobar 06/2017 for REAL4 put greater value for XUNDEF=1.e+9 <-> elsif problem with X/YHAT value == XUNDEF
!
!* 0. DECLARATIONS
! ------------
@@ -45,7 +46,7 @@ REAL, PARAMETER :: XUNDEF = 1.E+20
#ifdef MNH_MPI_DOUBLE_PRECISION
REAL, PARAMETER :: XUNDEF = 1.E+20! HUGE(XUNDEF) ! Z'7FFFFFFFFFFFFFFF' ! undefined value
#else
-REAL, PARAMETER :: XUNDEF = 1.E+6 ! HUGE(XUNDEF) ! Z'7FBFFFFF' ! undefined value
+REAL, PARAMETER :: XUNDEF = 1.E+9 ! HUGE(XUNDEF) ! Z'7FBFFFFF' ! undefined value
#endif
#endif
INTEGER, PARAMETER :: NUNDEF = 1E+9 ! HUGE(NUNDEF) ! undefined value
diff --git a/src/SURFEX/pgd_chemistry.F90 b/src/SURFEX/pgd_chemistry.F90
index 1d073fd886f7d14ee740a07c31153be7579c7cc9..4bd8051b887391af172a471b031764fbe0a0f57f 100644
--- a/src/SURFEX/pgd_chemistry.F90
+++ b/src/SURFEX/pgd_chemistry.F90
@@ -34,6 +34,8 @@
!! ------------
!!
!! Original 10/12/97
+!! (V.Masson & M.Leriche) 06/06/17 add a missed value in NEMISPEC_NBR
+!! to count the number of emitted species in case of writing pgd
!!
!----------------------------------------------------------------------------
!
@@ -152,6 +154,7 @@ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CH_EMIS_PGD)
!* 3. Allocation
! ----------
!
+ CHE%NEMISPEC_NBR = -999 ! will be counted in writesurf_ch_emisn.f90
CHE%NEMIS_NBR = NEMIS_PGD_NBR
!
CALL GET_SURF_SIZE_n(DTCO, U, &
diff --git a/src/SURFEX/pgd_cover.F90 b/src/SURFEX/pgd_cover.F90
index 5f76908c33dfb72fef2acb0389fe3ef158ec654e..3aa1069a4724fd3a669012aa15dc880f9548f9e8 100644
--- a/src/SURFEX/pgd_cover.F90
+++ b/src/SURFEX/pgd_cover.F90
@@ -91,6 +91,10 @@ USE MODD_IO_SURF_LFI, ONLY : CFILEIN_LFI
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+!
+#endif
!
IMPLICIT NONE
!
@@ -286,6 +290,9 @@ ELSE
WRITE(YFIELD,FMT='(A)') 'covers'
CALL INTERPOL_FIELD2D(UG, U, &
HPROGRAM,ILUOUT,NSIZE,U%XCOVER(:,:),YFIELD)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(U%XCOVER,"PGD_COVER:XCOVER",PRECISION,ILUOUT,'FULL',SIZE(U%XCOVER,2))
+#endif
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/pgd_flake.F90 b/src/SURFEX/pgd_flake.F90
index b46ca1363a2129ff5e07dae9e9f9c1f7356536e2..464b352a657db77e3c8b4dc0e349c6eedd3daf85 100644
--- a/src/SURFEX/pgd_flake.F90
+++ b/src/SURFEX/pgd_flake.F90
@@ -35,6 +35,7 @@
!!
!! Original 03/2004
!! 04/2013, P. Le Moigne : allow limitation of lake depth
+!! M. Moge 02/2015 : MPPDB_CHECK
!!
!----------------------------------------------------------------------------
!
@@ -72,6 +73,9 @@ USE MODI_TREAT_GLOBAL_LAKE_DEPTH
!
USE MODE_POS_SURF
!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+#endif
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -201,6 +205,12 @@ ALLOCATE(FG%XMESH_SIZE (FG%NDIM))
FG%CGRID, FG%XGRID_PAR, &
F%LCOVER, F%XCOVER, F%XZS, &
FG%XLAT, FG%XLON, FG%XMESH_SIZE )
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(F%XCOVER,"PGD_FLAKE after PACK_PGD:XCOVER",PRECISION,ILUOUT,'WATER',SIZE(F%XCOVER,2))
+ CALL MPPDB_CHECK_SURFEX2D(FG%XLAT,"PGD_FLAKE after PACK_PGD:XLAT",PRECISION,ILUOUT,'WATER')
+ CALL MPPDB_CHECK_SURFEX2D(FG%XLON,"PGD_FLAKE after PACK_PGD:XLON",PRECISION,ILUOUT,'WATER')
+ CALL MPPDB_CHECK_SURFEX2D(FG%XMESH_SIZE,"PGD_FLAKE after PACK_PGD:XMESH_SIZE",PRECISION,ILUOUT,'WATER')
+#endif
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/pgd_grid.F90 b/src/SURFEX/pgd_grid.F90
index caa68ad37d4c7e480ed24d967435889a291ff705..f4759b145d05d1342295a33b414fb038a7432143 100644
--- a/src/SURFEX/pgd_grid.F90
+++ b/src/SURFEX/pgd_grid.F90
@@ -83,6 +83,9 @@ USE MODI_PGD_GRID_IO_INIT
USE MODE_TOOLS_ll, ONLY : GET_MEAN_OF_COORD_SQRT_ll
!
USE MODI_GET_SIZE_FULL_n
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+#endif
USE MODI_SPLIT_GRID
USE MODD_CONF, ONLY : CPROGRAM
#endif
@@ -314,6 +317,11 @@ ALLOCATE(UG%XLON (U%NSIZE_FULL))
ALLOCATE(UG%XMESH_SIZE (U%NSIZE_FULL))
ALLOCATE(UG%XJPDIR (U%NSIZE_FULL))
CALL LATLON_GRID(CGRID,NGRID_PAR,U%NSIZE_FULL,ILUOUT,XGRID_PAR,UG%XLAT,UG%XLON,UG%XMESH_SIZE,UG%XJPDIR)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX2D(UG%XLAT,"PGD_GRID after LATLON_GRID:XLAT",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(UG%XLON,"PGD_GRID after LATLON_GRID:XLON",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(UG%XMESH_SIZE,"PGD_GRID after LATLON_GRID:XMESH_SIZE",PRECISION,ILUOUT)
+#endif
!
!------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/pgd_isba.F90 b/src/SURFEX/pgd_isba.F90
index dfe376970722bc3a6ec703b8692900e2767336f0..60ca41eca13b71999821c496c6d6966f071ed255 100644
--- a/src/SURFEX/pgd_isba.F90
+++ b/src/SURFEX/pgd_isba.F90
@@ -44,6 +44,7 @@
!! R. Alkama 05/2012 : npatch must be 12 or 19 if CPHOTO/='NON'
!! B. Decharme 11/2013 : groundwater distribution for water table/surface coupling
!! P. Samuelsson 02/2012 : MEB
+!! M. Moge 02/2015 : MPPDB_CHECK
!!
!----------------------------------------------------------------------------
!
@@ -106,6 +107,10 @@ USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+!
+#endif
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -430,6 +435,11 @@ ALLOCATE(I%XZ0EFFJPDIR(ILU))
IG%CGRID, IG%XGRID_PAR, &
I%LCOVER, I%XCOVER, I%XZS, &
IG%XLAT, IG%XLON, IG%XMESH_SIZE, I%XZ0EFFJPDIR )
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX2D(IG%XLAT,"PGD_ISBA after PACK_PGD:XLAT",PRECISION,ILUOUT, 'NATURE')
+ CALL MPPDB_CHECK_SURFEX2D(IG%XLON,"PGD_ISBA after PACK_PGD:XLON",PRECISION,ILUOUT, 'NATURE')
+ CALL MPPDB_CHECK_SURFEX2D(IG%XMESH_SIZE,"PGD_ISBA after PACK_PGD:XMESH_SIZE",PRECISION,ILUOUT, 'NATURE')
+#endif
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/pgd_seaflux.F90 b/src/SURFEX/pgd_seaflux.F90
index e7bd58a16846ad5293b8e9412fd94391bceaea79..310f67f7ff30f92864de8843ea624d57051ff45a 100644
--- a/src/SURFEX/pgd_seaflux.F90
+++ b/src/SURFEX/pgd_seaflux.F90
@@ -35,6 +35,7 @@
!!
!! Original 03/2004
!! Lebeaupin-B C. 01/2008 : include bathymetry
+!! M.Moge 02/2015 check with MPPDB
!!
!----------------------------------------------------------------------------
!
@@ -67,6 +68,11 @@ USE MODI_PGD_SEAFLUX_PAR
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+USE MODI_GET_LUOUT
+!
+#endif
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -88,6 +94,9 @@ TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
! ------------------------------
!
REAL, DIMENSION(NL) :: ZSEABATHY ! bathymetry on all surface points
+#ifdef MNH_PARALLEL
+INTEGER :: ILUOUT
+#endif
!
!* 0.3 Declaration of namelists
! ------------------------
@@ -111,6 +120,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -------------------
!
IF (LHOOK) CALL DR_HOOK('PGD_SEAFLUX',0,ZHOOK_HANDLE)
+#ifdef MNH_PARALLEL
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+#endif
CALL READ_NAM_PGD_SEABATHY(HPROGRAM,YSEABATHY,YSEABATHYFILETYPE,YNCVARNAME,&
XUNIF_SEABATHY)
!
@@ -145,7 +157,12 @@ ALLOCATE(SG%XMESH_SIZE (SG%NDIM))
HPROGRAM, 'SEA ', &
SG%CGRID, SG%XGRID_PAR, &
S%LCOVER, S%XCOVER, S%XZS, &
- SG%XLAT, SG%XLON, SG%XMESH_SIZE )
+ SG%XLAT, SG%XLON, SG%XMESH_SIZE )
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX2D(SG%XLAT,"PGD_SEAFLUX after PACK_PGD:XLAT",PRECISION,ILUOUT,'SEA')
+ CALL MPPDB_CHECK_SURFEX2D(SG%XLON,"PGD_SEAFLUX after PACK_PGD:XLON",PRECISION,ILUOUT,'SEA')
+ CALL MPPDB_CHECK_SURFEX2D(SG%XMESH_SIZE,"PGD_SEAFLUX after PACK_PGD:XMESH_SIZE",PRECISION,ILUOUT,'SEA')
+#endif
!
CALL PACK_PGD_SEAFLUX(DTCO, SG, S, U, &
HPROGRAM, ZSEABATHY)
diff --git a/src/SURFEX/pgd_surf_atm.F90 b/src/SURFEX/pgd_surf_atm.F90
index b328e22c4f27e2cbb06a04d217fa5dfe2837e978..fcca45b8901a76c57cb2bce39db51f61b353c2b4 100644
--- a/src/SURFEX/pgd_surf_atm.F90
+++ b/src/SURFEX/pgd_surf_atm.F90
@@ -37,6 +37,7 @@
!! A. Lemonsu 05/2009 Ajout de la clef LGARDEN pour TEB
!! J. Escobar 11/2013 Add USE MODI_READ_NAM_PGD_CHEMISTRY
!! B. Decharme 02/2014 Add LRM_RIVER
+!! M.Moge 02/2015 check with MPPDB
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -76,6 +77,11 @@ USE MODI_INIT_READ_DATA_COVER
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+USE MODI_READ_NAM_PGD_CHEMISTRY
+#ifdef MNH_PARALLEL
+!
+USE MODE_MPPDB
+#endif
!
IMPLICIT NONE
!
@@ -138,6 +144,11 @@ ALLOCATE(YSC%UG%XMESH_SIZE(YSC%U%NSIZE_FULL))
ALLOCATE(YSC%UG%XJPDIR(YSC%U%NSIZE_FULL))
CALL LATLON_GRID(YSC%UG%CGRID,YSC%UG%NGRID_PAR,YSC%U%NSIZE_FULL,ILUOUT,&
YSC%UG%XGRID_PAR,YSC%UG%XLAT,YSC%UG%XLON,YSC%UG%XMESH_SIZE,YSC%UG%XJPDIR)
+#ifdef MNH_PARALLEL
+! CALL MPPDB_CHECK_SURFEX2D(YSC%UG%XLAT,"PGD_SURF_ATM_n after LATLON_GRID:XLAT",PRECISION,ILUOUT)
+! CALL MPPDB_CHECK_SURFEX2D(YSC%UG%XLON,"PGD_SURF_ATM_n after LATLON_GRID:XLON",PRECISION,ILUOUT)
+! CALL MPPDB_CHECK_SURFEX2D(YSC%UG%XMESH_SIZE,"PGD_SURF_ATM_n after LATLON_GRID:XMESH_SIZE",PRECISION,ILUOUT)
+#endif
!
!
!* 2.3 Stores the grid in the module MODD_PGD_GRID
diff --git a/src/SURFEX/pgd_teb.F90 b/src/SURFEX/pgd_teb.F90
index f0f167d04e8da9c5e3d52dabd6ba61560ac515fc..e3d1e3ee8f13fb99723930b384673b7eb44ff7e0 100644
--- a/src/SURFEX/pgd_teb.F90
+++ b/src/SURFEX/pgd_teb.F90
@@ -36,6 +36,7 @@
!! Original 10/12/97
!! A. Lemonsu 05/2009 Key for garden option
!! G. Pigeon /09/12: WALL, ROOF, FLOOR, MASS LAYER default to 5
+!! M. Moge 02/2015 : MPPDB_CHECK
!!
!----------------------------------------------------------------------------
!
@@ -70,6 +71,10 @@ USE MODI_ABOR1_SFX
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+!
+#endif
USE MODI_WRITE_COVER_TEX_TEB
!
IMPLICIT NONE
@@ -156,7 +161,13 @@ ALLOCATE(TM%TG%XMESH_SIZE (TM%TG%NDIM))
HPROGRAM, 'TOWN ', &
TM%TG%CGRID, TM%TG%XGRID_PAR, &
TM%TOP%LCOVER, TM%TOP%XCOVER, TM%TOP%XZS, &
- TM%TG%XLAT, TM%TG%XLON, TM%TG%XMESH_SIZE )
+ TM%TG%XLAT, TM%TG%XLON, TM%TG%XMESH_SIZE )
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(TM%TOP%XCOVER,"PGD_TEB after PACK_PGD:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TM%TOP%XCOVER,2))
+ CALL MPPDB_CHECK_SURFEX2D(TM%TG%XLAT,"PGD_TEB after PACK_PGD:XLAT",PRECISION,ILUOUT, 'TOWN ')
+ CALL MPPDB_CHECK_SURFEX2D(TM%TG%XLON,"PGD_TEB after PACK_PGD:XLON",PRECISION,ILUOUT, 'TOWN ')
+ CALL MPPDB_CHECK_SURFEX2D(TM%TG%XMESH_SIZE,"PGD_TEB after PACK_PGD:XMESH_SIZE",PRECISION,ILUOUT, 'TOWN ')
+#endif
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_pgd_isban.F90 b/src/SURFEX/read_pgd_isban.F90
index c8d82407ec528f3d7579eb92a52ce7c67458f46a..3efc7093240b0a334b87a9670f5edba7003c94d4 100644
--- a/src/SURFEX/read_pgd_isban.F90
+++ b/src/SURFEX/read_pgd_isban.F90
@@ -42,6 +42,7 @@
!! 11/2013 : same for groundwater distribution
!! 11/2014 : Read XSOILGRID as a series of real
!! P. Samuelsson 10/2014 : MEB
+!! M. Moge 02/2015 READ_SURF // + MPPDB_CHECK
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -91,6 +92,10 @@ USE MODI_GET_LUOUT
USE MODI_PACK_SAME_RANK
USE MODI_GET_SURF_MASK_n
!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+!
+#endif
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -301,6 +306,7 @@ ALLOCATE(I%XCOVER(IG%NDIM,COUNT(I%LCOVER)))
#ifdef MNH_PARALLEL
CALL READ_SURF_COV(&
HPROGRAM,'COVER',I%XCOVER(:,:),I%LCOVER,IRESP,HDIR='H')
+ CALL MPPDB_CHECK_SURFEX3D(I%XCOVER,"READ_PGD_ISBA_n after READ_SURF:XCOVER",PRECISION,ILUOUT,'NATURE',SIZE(I%XCOVER,2))
#else
CALL READ_SURF_COV(&
HPROGRAM,'COVER',I%XCOVER(:,:),I%LCOVER,IRESP)
@@ -324,6 +330,11 @@ ALLOCATE(IG%XMESH_SIZE (IG%NDIM))
ALLOCATE(I%XZ0EFFJPDIR(IG%NDIM))
CALL READ_GRID(&
HPROGRAM,IG%CGRID,IG%XGRID_PAR,IG%XLAT,IG%XLON,IG%XMESH_SIZE,IRESP,I%XZ0EFFJPDIR)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX2D(IG%XLAT,"READ_PGD_ISBA_n after READ_GRID:XLAT",PRECISION,ILUOUT,'NATURE')
+ CALL MPPDB_CHECK_SURFEX2D(IG%XLON,"READ_PGD_ISBA_n after READ_GRID:XLON",PRECISION,ILUOUT,'NATURE')
+ CALL MPPDB_CHECK_SURFEX2D(IG%XMESH_SIZE,"READ_PGD_ISBA_n after READ_GRID:XMESH_SIZE",PRECISION,ILUOUT,'NATURE')
+#endif
!
!* clay fraction : attention, seul un niveau est present dans le fichier
!* on rempli tout les niveaux de XCLAY avec les valeurs du fichiers
diff --git a/src/SURFEX/read_pgd_tebn.F90 b/src/SURFEX/read_pgd_tebn.F90
index 0d0dcddf5213af6bc810c238f99f7cb441eedde0..4cd313dc7dd3d0198827a3c34a0b47045a5c5e4f 100644
--- a/src/SURFEX/read_pgd_tebn.F90
+++ b/src/SURFEX/read_pgd_tebn.F90
@@ -34,7 +34,7 @@
!! MODIFICATIONS
!! -------------
!! Original 01/2003
-!! M. Moge 02/2015 READ_SURF
+!! M. Moge 02/2015 READ_SURF // + MPPDB_CHECK
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -66,6 +66,11 @@ USE MODI_GET_TYPE_DIM_n
!
USE MODI_READ_LECOCLIMAP
!
+#ifdef MNH_PARALLEL
+USE MODI_GET_LUOUT
+USE MODE_MPPDB
+!
+#endif
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -83,6 +88,9 @@ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
! -------------------------------
!
INTEGER :: IRESP ! Error code after redding
+#ifdef MNH_PARALLEL
+INTEGER :: ILUOUT ! output listing logical unit
+#endif
!
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
INTEGER :: IVERSION
@@ -94,6 +102,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1D physical dimension
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_N',0,ZHOOK_HANDLE)
+#ifdef MNH_PARALLEL
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+#endif
YRECFM='SIZE_TOWN'
CALL GET_TYPE_DIM_n(DTCO, U, &
'TOWN ',TM%TG%NDIM)
@@ -208,6 +219,7 @@ ALLOCATE(TM%TOP%XCOVER(TM%TG%NDIM,COUNT(TM%TOP%LCOVER)))
#ifdef MNH_PARALLEL
CALL READ_SURF_COV(&
HPROGRAM,'COVER',TM%TOP%XCOVER(:,:),TM%TOP%LCOVER,IRESP,HDIR='H')
+ CALL MPPDB_CHECK_SURFEX3D(TM%TOP%XCOVER,"READ_PGD_TEB_n after READ_SURF:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TM%TOP%XCOVER,2))
#else
CALL READ_SURF_COV(&
HPROGRAM,'COVER',TM%TOP%XCOVER(:,:),TM%TOP%LCOVER,IRESP)
diff --git a/src/SURFEX/writesurf_ch_emisn.F90 b/src/SURFEX/writesurf_ch_emisn.F90
index d542424409f387c0bb01605eef10cc783e8a270f..bbc577915a578a59b40ab5309440413d70f6c9f6 100644
--- a/src/SURFEX/writesurf_ch_emisn.F90
+++ b/src/SURFEX/writesurf_ch_emisn.F90
@@ -21,6 +21,8 @@
!! -------------
!! Original 03/2004
!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
+!! V.Masson & M. Leriche 06/06/17 do not count emitted species in nest case
+!! do not write CEMIS_AREA no longer used
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -90,6 +92,7 @@ YCOMMENT='Total number of 2D emission files.'
HPROGRAM,YRECFM,CHE%NEMIS_NBR,IRESP,HCOMMENT=YCOMMENT)
!
! count emitted species
+IF (CHE%NEMISPEC_NBR==-999) THEN
IEMISPEC_NBR = 0
DO JI=1,CHE%NEMIS_NBR
YNAME = TRIM(ADJUSTL(CHE%CEMIS_NAME(JI)))
@@ -114,6 +117,25 @@ DO JI=1,CHE%NEMIS_NBR
INBTIMES(JSPEC) = INBTIMES(JSPEC)+1
END IF
END DO
+ELSE
+ IEMISPEC_NBR=CHE%NEMISPEC_NBR
+ INBTIMES(:CHE%NEMISPEC_NBR)=CHE%NEMIS_NBT(:)
+ YEMISPEC_NAMES(:IEMISPEC_NBR) = CHE%CEMIS_NAME(:)
+ IFIRST=1
+ ILAST=0
+ INEXT=0
+ JI=0
+ DO JSPEC=1,IEMISPEC_NBR
+ IF (JSPEC>1) IFIRST(JSPEC)=ILAST(JSPEC-1)+1
+ ILAST(JSPEC) = IFIRST(JSPEC) + INBTIMES(JSPEC) - 1
+ JI=JI+1
+ IF (JSPEC>1) INEXT(ILAST(JSPEC-1))=0
+ DO JT=2,INBTIMES(JSPEC)
+ JI=JI+1
+ INEXT(JI-1) = JI
+ END DO
+ END DO
+END IF
!
YRECFM='EMISPEC_NBR '
YCOMMENT='Number of emitted chemical species.'
@@ -176,18 +198,13 @@ END DO
! Now fill the ZWORK2D array for writing
ZWORK2D(:,:) = CHE%XEMIS_FIELDS(:,IINDEX(:))
!
-! Write NAME of species JSPEC with AREA and number of emission times
+! Write NAME of species JSPEC with number of emission times
! stored in the commentary
WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
-WRITE(YCOMMENT,'(A3,", emission times number:",I5)') CHE%CEMIS_AREA(IINDEX(1)),KSIZE
+YCOMMENT = "Emission species name"
CALL WRITE_SURF(DGU, U, &
HPROGRAM,YRECFM,YEMISPEC_NAMES(JSPEC),IRESP,HCOMMENT=YCOMMENT)
!
-WRITE(YRECFM,'("EMISAREA",I3.3)') JSPEC
-YCOMMENT = "Emission area"
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,CHE%CEMIS_AREA(IINDEX(1)),IRESP,HCOMMENT=YCOMMENT)
-!
WRITE(YRECFM,'("EMISNBT",I3.3)') JSPEC
YCOMMENT = "Emission times number"
CALL WRITE_SURF(DGU, U, &
diff --git a/src/SURFEX/zoom_pgd_cover.F90 b/src/SURFEX/zoom_pgd_cover.F90
index 0207b473436cf07ac2893b9f0075fb37701fb434..f64eff3a72d2248ee11b2340dfc519f16ab16beb 100644
--- a/src/SURFEX/zoom_pgd_cover.F90
+++ b/src/SURFEX/zoom_pgd_cover.F90
@@ -1,345 +1,367 @@
-!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.
-! #########
- SUBROUTINE ZOOM_PGD_COVER (DTCO, UG, U,GCP, &
- HPROGRAM,HINIFILE,HINIFILETYPE,OECOCLIMAP)
-! ###########################################################
-
-!!
-!! PURPOSE
-!! -------
-!! This program prepares the physiographic data fields.
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 13/10/03
-! Modification 17/04/12 M.Tomasini All COVER physiographic fields are now
-!! interpolated for spawning =>
-!! ABOR1_SFX if (.NOT.OECOCLIMAP) in comment
-! Modification 05/02/15 M.Moge : use NSIZE_FULL instead of SIZE(XLAT) (for clarity)
-!! J.Escobar 18/12/2015 : missing interface
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
-!
-USE MODE_READ_SURF_COV, ONLY : READ_SURF_COV
-!
-USE MODI_CONVERT_COVER_FRAC
-USE MODI_OPEN_AUX_IO_SURF
-USE MODI_READ_SURF
-USE MODI_CLOSE_AUX_IO_SURF
-USE MODI_PREP_GRID_EXTERN
-USE MODI_HOR_INTERPOL
-USE MODI_HOR_INTERPOL_1COV
-USE MODI_PREP_OUTPUT_GRID
-USE MODI_OLD_NAME
-USE MODI_SUM_ON_ALL_PROCS
-USE MODI_GET_LUOUT
-USE MODI_CLEAN_PREP_OUTPUT_GRID
-USE MODI_GET_1D_MASK
-USE MODI_READ_LCOVER
-#ifdef SFX_MNH
-USE MODI_READ_SURFX2COV_1COV_MNH
-#endif
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of dummy arguments
-! ------------------------------
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
- CHARACTER(LEN=28), INTENT(IN) :: HINIFILE ! input atmospheric file name
- CHARACTER(LEN=6), INTENT(IN) :: HINIFILETYPE! input atmospheric file type
-LOGICAL, INTENT(OUT) :: OECOCLIMAP ! flag to use ecoclimap
-!
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: ICPT1, ICPT2
-INTEGER :: IRESP
-INTEGER :: ILUOUT
-INTEGER :: INI ! total 1D dimension (input grid)
-INTEGER :: IL ! total 1D dimension (output grid)
-INTEGER :: JCOVER ! loop counter
-INTEGER :: IVERSION ! surface version
-#ifdef MNH_PARALLEL
-REAL, DIMENSION(:), POINTER :: ZCOVER1D
-#endif
-REAL, DIMENSION(:,:), POINTER :: ZCOVER
-REAL, DIMENSION(:,:), POINTER :: ZSEA1, ZWATER1, ZNATURE1, ZTOWN1
-REAL, DIMENSION(:,:), POINTER :: ZSEA2, ZWATER2, ZNATURE2, ZTOWN2
-REAL, DIMENSION(:), ALLOCATABLE :: ZSUM
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=100) :: YCOMMENT
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_COVER',0,ZHOOK_HANDLE)
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
-!
-!* 1. Preparation of IO for reading in the file
-! -----------------------------------------
-!
-!* Note that all points are read, even those without physical meaning.
-! These points will not be used during the horizontal interpolation step.
-! Their value must be defined as XUNDEF.
-!
- CALL OPEN_AUX_IO_SURF(&
- HINIFILE,HINIFILETYPE,'FULL ')
-!
- CALL READ_SURF(&
- HPROGRAM,'ECOCLIMAP',OECOCLIMAP,IRESP)
-!
-!------------------------------------------------------------------------------
-!
-!* 2. Reading of grid
-! ---------------
-!
- CALL PREP_GRID_EXTERN(GCP,&
- HINIFILETYPE,ILUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
-!
- CALL PREP_OUTPUT_GRID(UG, U, &
- ILUOUT,UG%CGRID,UG%XGRID_PAR,UG%XLAT,UG%XLON)
-!
-!------------------------------------------------------------------------------
-!
-!* 3. Reading of cover
-! ----------------
-!
-YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
-!
-ALLOCATE(U%LCOVER(JPCOVER))
-!
-ALLOCATE(ZSEA1 (INI,1))
-ALLOCATE(ZNATURE1(INI,1))
-ALLOCATE(ZWATER1 (INI,1))
-ALLOCATE(ZTOWN1 (INI,1))
-!
-IF (IVERSION>=7) THEN
- CALL READ_SURF(&
- HPROGRAM,'FRAC_SEA ',ZSEA1(:,1), IRESP,HDIR='A')
- CALL READ_SURF(&
- HPROGRAM,'FRAC_NATURE',ZNATURE1(:,1),IRESP,HDIR='A')
- CALL READ_SURF(&
- HPROGRAM,'FRAC_WATER ',ZWATER1(:,1), IRESP,HDIR='A')
- CALL READ_SURF(&
- HPROGRAM,'FRAC_TOWN ',ZTOWN1(:,1), IRESP,HDIR='A')
- CALL OLD_NAME(&
- HPROGRAM,'COVER_LIST ',YRECFM)
- CALL READ_LCOVER(HPROGRAM,U%LCOVER)
-#ifdef MNH_PARALLEL
- ALLOCATE(ZCOVER1D(INI))
-#else
- ALLOCATE(ZCOVER(INI,COUNT(U%LCOVER)))
- CALL READ_SURF_COV(&
- HPROGRAM,YRECFM,ZCOVER(:,:),U%LCOVER,IRESP,HDIR='A')
-
-#endif
-
- !
-ELSE
-#ifdef MNH_PARALLEL
- ! we assume that IVERSION>=7
-#else
- CALL OLD_NAME(&
- HPROGRAM,'COVER_LIST ',YRECFM)
- CALL READ_LCOVER(HPROGRAM,U%LCOVER)
- !
- ALLOCATE(ZCOVER(INI,COUNT(U%LCOVER)))
- CALL READ_SURF_COV(&
- HPROGRAM,YRECFM,ZCOVER(:,:),U%LCOVER,IRESP,HDIR='A')
-
-
- CALL CONVERT_COVER_FRAC(DTCO, &
- ZCOVER,U%LCOVER,ZSEA1(:,1),ZNATURE1(:,1),ZTOWN1(:,1),ZWATER1(:,1))
-#endif
-ENDIF
-!
-! CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
-!------------------------------------------------------------------------------
-!
-!* 4. Reading of cover & Interpolations
-! --------------
-!
-IL = U%NSIZE_FULL
-ALLOCATE(U%XCOVER(IL,COUNT(U%LCOVER)))
-!
-! on lit les cover une apres l'autre, et on appelle hor_interpol sur chaque cover separement
-!
-#ifdef MNH_PARALLEL
-IF ( HPROGRAM == 'MESONH' ) THEN
- ICPT1 = 0
- DO JCOVER=1,JPCOVER
- IF ( U%LCOVER( JCOVER ) ) THEN
- ICPT1 = ICPT1 + 1
- CALL READ_SURFX2COV_1COV_MNH(YRECFM,INI,JCOVER,ZCOVER1D(:),IRESP,YCOMMENT,'A')
- CALL HOR_INTERPOL_1COV(DTCO, U,GCP,ILUOUT,ZCOVER1D,U%XCOVER(:,ICPT1))
- ENDIF
- !
- ENDDO
-ENDIF
-DEALLOCATE(ZCOVER1D)
-#else
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZCOVER,U%XCOVER)
- DEALLOCATE(ZCOVER)
-#endif
-!
-ALLOCATE(ZCOVER(IL,COUNT(U%LCOVER)))
-ICPT1 = 0
-ICPT2 = 0
-DO JCOVER = 1,JPCOVER
- IF (U%LCOVER(JCOVER)) THEN
- ICPT1 = ICPT1 + 1
- IF (ALL(U%XCOVER(:,ICPT1)==0.)) THEN
- U%LCOVER(JCOVER) = .FALSE.
- ELSE
- ICPT2 = ICPT2 + 1
- ZCOVER(:,ICPT2) = U%XCOVER(:,ICPT1)
- ENDIF
- ENDIF
-ENDDO
-!
-DEALLOCATE(U%XCOVER)
-ALLOCATE(U%XCOVER(IL,ICPT2))
-U%XCOVER(:,:) = ZCOVER(:,1:ICPT2)
-DEALLOCATE(ZCOVER)
-!
-CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
-ALLOCATE(ZSEA2 (IL,1))
-ALLOCATE(ZNATURE2(IL,1))
-ALLOCATE(ZWATER2 (IL,1))
-ALLOCATE(ZTOWN2 (IL,1))
-!
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZSEA1,ZSEA2)
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZNATURE1,ZNATURE2)
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZWATER1,ZWATER2)
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZTOWN1,ZTOWN2)
-!
-DEALLOCATE(ZSEA1)
-DEALLOCATE(ZNATURE1)
-DEALLOCATE(ZWATER1)
-DEALLOCATE(ZTOWN1)
-!
-ALLOCATE(U%XSEA (IL))
-ALLOCATE(U%XNATURE(IL))
-ALLOCATE(U%XWATER (IL))
-ALLOCATE(U%XTOWN (IL))
-!
-U%XSEA(:) = ZSEA2 (:,1)
-U%XNATURE(:)= ZNATURE2(:,1)
-U%XWATER(:) = ZWATER2 (:,1)
-U%XTOWN(:) = ZTOWN2 (:,1)
-!
-DEALLOCATE(ZSEA2)
-DEALLOCATE(ZNATURE2)
-DEALLOCATE(ZWATER2)
-DEALLOCATE(ZTOWN2)
-!
- CALL CLEAN_PREP_OUTPUT_GRID
-!------------------------------------------------------------------------------
-!
-!* 5. Coherence check
-! ---------------
-!
-ALLOCATE(ZSUM(IL))
-ZSUM = 0.
-DO JCOVER=1,SIZE(U%XCOVER,2)
- ZSUM(:) = ZSUM(:) + U%XCOVER(:,JCOVER)
-END DO
-!
-DO JCOVER=1,SIZE(U%XCOVER,2)
- WHERE(ZSUM(:)/=0.) U%XCOVER(:,JCOVER) = U%XCOVER(:,JCOVER)/ZSUM(:)
-END DO
-!
-DO JCOVER=1,SIZE(U%XCOVER,2)
- IF (ALL(U%XCOVER(:,JCOVER)==0.)) U%LCOVER(JCOVER) = .FALSE.
-END DO
-!------------------------------------------------------------------------------
-!
-!* 6. Fractions
-! ---------
-!
-! When the model runs in multiproc, NSIZE* represents the number of points
-! on a proc, and NDIM* the total number of points on all procs.
-! The following definition of NDIM* won't be correct any more when the PGD
-! runs in multiproc.
-!
-U%NSIZE_NATURE = COUNT(U%XNATURE(:) > 0.0)
-U%NSIZE_WATER = COUNT(U%XWATER (:) > 0.0)
-U%NSIZE_SEA = COUNT(U%XSEA (:) > 0.0)
-U%NSIZE_TOWN = COUNT(U%XTOWN (:) > 0.0)
-U%NSIZE_FULL = IL
-!
-U%NDIM_NATURE = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,U%XNATURE(:) > 0., 'DIM')
-U%NDIM_WATER = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,U%XWATER (:) > 0., 'DIM')
-U%NDIM_SEA = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,U%XSEA (:) > 0., 'DIM')
-U%NDIM_TOWN = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,U%XTOWN (:) > 0., 'DIM')
-ZSUM=1.
-U%NDIM_FULL = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,ZSUM (:) ==1., 'DIM')
-DEALLOCATE(ZSUM)
-!
-ALLOCATE(U%NR_NATURE (U%NSIZE_NATURE))
-ALLOCATE(U%NR_TOWN (U%NSIZE_TOWN ))
-ALLOCATE(U%NR_WATER (U%NSIZE_WATER ))
-ALLOCATE(U%NR_SEA (U%NSIZE_SEA ))
-!
-IF (U%NSIZE_SEA >0)CALL GET_1D_MASK( U%NSIZE_SEA, U%NSIZE_FULL, U%XSEA , U%NR_SEA )
-IF (U%NSIZE_WATER >0)CALL GET_1D_MASK( U%NSIZE_WATER, U%NSIZE_FULL, U%XWATER , U%NR_WATER )
-IF (U%NSIZE_TOWN >0)CALL GET_1D_MASK( U%NSIZE_TOWN, U%NSIZE_FULL, U%XTOWN , U%NR_TOWN )
-IF (U%NSIZE_NATURE>0)CALL GET_1D_MASK( U%NSIZE_NATURE, U%NSIZE_FULL, U%XNATURE, U%NR_NATURE)
-IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_COVER',1,ZHOOK_HANDLE)
-
-!_______________________________________________________________________________
-!
-END SUBROUTINE ZOOM_PGD_COVER
+!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.
+! #########
+ SUBROUTINE ZOOM_PGD_COVER (DTCO, UG, U,GCP, &
+ HPROGRAM,HINIFILE,HINIFILETYPE,OECOCLIMAP)
+! ###########################################################
+
+!!
+!! PURPOSE
+!! -------
+!! This program prepares the physiographic data fields.
+!!
+!! METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 13/10/03
+! Modification 17/04/12 M.Tomasini All COVER physiographic fields are now
+!! interpolated for spawning =>
+!! ABOR1_SFX if (.NOT.OECOCLIMAP) in comment
+! Modification 05/02/15 M.Moge : MPPDB_CHECK + use NSIZE_FULL instead of SIZE(XLAT) (for clarity)
+!! J.Escobar 18/12/2015 : missing interface
+!! J.Escobar 12/06/2017 : Bug in SPAWNING in // , compute/update LCOVER in // with SUM_ON_ALL_PROCS
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+!
+!
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
+!
+USE MODE_READ_SURF_COV, ONLY : READ_SURF_COV
+!
+USE MODI_CONVERT_COVER_FRAC
+USE MODI_OPEN_AUX_IO_SURF
+USE MODI_READ_SURF
+USE MODI_CLOSE_AUX_IO_SURF
+USE MODI_PREP_GRID_EXTERN
+USE MODI_HOR_INTERPOL
+USE MODI_HOR_INTERPOL_1COV
+USE MODI_PREP_OUTPUT_GRID
+USE MODI_OLD_NAME
+USE MODI_SUM_ON_ALL_PROCS
+USE MODI_GET_LUOUT
+USE MODI_CLEAN_PREP_OUTPUT_GRID
+USE MODI_GET_1D_MASK
+USE MODI_READ_LCOVER
+#ifdef SFX_MNH
+USE MODI_READ_SURFX2COV_1COV_MNH
+#endif
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+!
+#endif
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+! ------------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+ CHARACTER(LEN=28), INTENT(IN) :: HINIFILE ! input atmospheric file name
+ CHARACTER(LEN=6), INTENT(IN) :: HINIFILETYPE! input atmospheric file type
+LOGICAL, INTENT(OUT) :: OECOCLIMAP ! flag to use ecoclimap
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: ICPT1, ICPT2
+INTEGER :: IRESP
+INTEGER :: ILUOUT
+INTEGER :: INI ! total 1D dimension (input grid)
+INTEGER :: IL ! total 1D dimension (output grid)
+INTEGER :: JCOVER ! loop counter
+INTEGER :: IVERSION ! surface version
+#ifdef MNH_PARALLEL
+REAL, DIMENSION(:), POINTER :: ZCOVER1D
+#endif
+REAL, DIMENSION(:,:), POINTER :: ZCOVER
+REAL, DIMENSION(:,:), POINTER :: ZSEA1, ZWATER1, ZNATURE1, ZTOWN1
+REAL, DIMENSION(:,:), POINTER :: ZSEA2, ZWATER2, ZNATURE2, ZTOWN2
+REAL, DIMENSION(:), ALLOCATABLE :: ZSUM
+ CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=100) :: YCOMMENT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_COVER',0,ZHOOK_HANDLE)
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+!
+!* 1. Preparation of IO for reading in the file
+! -----------------------------------------
+!
+!* Note that all points are read, even those without physical meaning.
+! These points will not be used during the horizontal interpolation step.
+! Their value must be defined as XUNDEF.
+!
+ CALL OPEN_AUX_IO_SURF(&
+ HINIFILE,HINIFILETYPE,'FULL ')
+!
+ CALL READ_SURF(&
+ HPROGRAM,'ECOCLIMAP',OECOCLIMAP,IRESP)
+!
+!------------------------------------------------------------------------------
+!
+!* 2. Reading of grid
+! ---------------
+!
+ CALL PREP_GRID_EXTERN(GCP,&
+ HINIFILETYPE,ILUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+!
+ CALL PREP_OUTPUT_GRID(UG, U, &
+ ILUOUT,UG%CGRID,UG%XGRID_PAR,UG%XLAT,UG%XLON)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX2D(UG%XLAT,"ZOOM_PGD_COVER:XLAT",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(UG%XLON,"ZOOM_PGD_COVER:XLON",PRECISION,ILUOUT)
+#endif
+!
+!------------------------------------------------------------------------------
+!
+!* 3. Reading of cover
+! ----------------
+!
+YRECFM='VERSION'
+ CALL READ_SURF(&
+ HPROGRAM,YRECFM,IVERSION,IRESP)
+!
+ALLOCATE(U%LCOVER(JPCOVER))
+!
+ALLOCATE(ZSEA1 (INI,1))
+ALLOCATE(ZNATURE1(INI,1))
+ALLOCATE(ZWATER1 (INI,1))
+ALLOCATE(ZTOWN1 (INI,1))
+!
+IF (IVERSION>=7) THEN
+ CALL READ_SURF(&
+ HPROGRAM,'FRAC_SEA ',ZSEA1(:,1), IRESP,HDIR='A')
+ CALL READ_SURF(&
+ HPROGRAM,'FRAC_NATURE',ZNATURE1(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(&
+ HPROGRAM,'FRAC_WATER ',ZWATER1(:,1), IRESP,HDIR='A')
+ CALL READ_SURF(&
+ HPROGRAM,'FRAC_TOWN ',ZTOWN1(:,1), IRESP,HDIR='A')
+ CALL OLD_NAME(&
+ HPROGRAM,'COVER_LIST ',YRECFM)
+ CALL READ_LCOVER(HPROGRAM,U%LCOVER)
+#ifdef MNH_PARALLEL
+ ALLOCATE(ZCOVER1D(INI))
+#else
+ ALLOCATE(ZCOVER(INI,COUNT(U%LCOVER)))
+ CALL READ_SURF_COV(&
+ HPROGRAM,YRECFM,ZCOVER(:,:),U%LCOVER,IRESP,HDIR='A')
+
+#endif
+
+ !
+ELSE
+#ifdef MNH_PARALLEL
+ ! we assume that IVERSION>=7
+#else
+ CALL OLD_NAME(&
+ HPROGRAM,'COVER_LIST ',YRECFM)
+ CALL READ_LCOVER(HPROGRAM,U%LCOVER)
+ !
+ ALLOCATE(ZCOVER(INI,COUNT(U%LCOVER)))
+ CALL READ_SURF_COV(&
+ HPROGRAM,YRECFM,ZCOVER(:,:),U%LCOVER,IRESP,HDIR='A')
+
+
+ CALL CONVERT_COVER_FRAC(DTCO, &
+ ZCOVER,U%LCOVER,ZSEA1(:,1),ZNATURE1(:,1),ZTOWN1(:,1),ZWATER1(:,1))
+#endif
+ENDIF
+!
+! CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
+!------------------------------------------------------------------------------
+!
+!* 4. Reading of cover & Interpolations
+! --------------
+!
+IL = U%NSIZE_FULL
+ALLOCATE(U%XCOVER(IL,COUNT(U%LCOVER)))
+!
+! on lit les cover une apres l'autre, et on appelle hor_interpol sur chaque cover separement
+!
+#ifdef MNH_PARALLEL
+IF ( HPROGRAM == 'MESONH' ) THEN
+ ICPT1 = 0
+ DO JCOVER=1,JPCOVER
+ IF ( U%LCOVER( JCOVER ) ) THEN
+ ICPT1 = ICPT1 + 1
+ CALL READ_SURFX2COV_1COV_MNH(YRECFM,INI,JCOVER,ZCOVER1D(:),IRESP,YCOMMENT,'A')
+ CALL HOR_INTERPOL_1COV(DTCO, U,GCP,ILUOUT,ZCOVER1D,U%XCOVER(:,ICPT1))
+
+ ENDIF
+ !
+ ENDDO
+ CALL MPPDB_CHECK_SURFEX3D(U%XCOVER,"ZOOM_PGD_COVER:XCOVER",PRECISION,ILUOUT,'FULL',SIZE(U%XCOVER,2))
+ENDIF
+DEALLOCATE(ZCOVER1D)
+#else
+ CALL HOR_INTERPOL(DTCO, U,GCP, &
+ ILUOUT,ZCOVER,U%XCOVER)
+ DEALLOCATE(ZCOVER)
+#endif
+!
+ALLOCATE(ZCOVER(IL,COUNT(U%LCOVER)))
+ICPT1 = 0
+ICPT2 = 0
+DO JCOVER = 1,JPCOVER
+ IF (U%LCOVER(JCOVER)) THEN
+ ICPT1 = ICPT1 + 1
+ IF ( SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,U%XCOVER(:,ICPT1)/=0., 'COV') == 0 ) THEN
+ U%LCOVER(JCOVER) = .FALSE.
+ ELSE
+ ICPT2 = ICPT2 + 1
+ ZCOVER(:,ICPT2) = U%XCOVER(:,ICPT1)
+ ENDIF
+ ENDIF
+ENDDO
+!
+DEALLOCATE(U%XCOVER)
+ALLOCATE(U%XCOVER(IL,ICPT2))
+U%XCOVER(:,:) = ZCOVER(:,1:ICPT2)
+DEALLOCATE(ZCOVER)
+!
+CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
+ALLOCATE(ZSEA2 (IL,1))
+ALLOCATE(ZNATURE2(IL,1))
+ALLOCATE(ZWATER2 (IL,1))
+ALLOCATE(ZTOWN2 (IL,1))
+!
+ CALL HOR_INTERPOL(DTCO, U,GCP, &
+ ILUOUT,ZSEA1,ZSEA2)
+ CALL HOR_INTERPOL(DTCO, U,GCP, &
+ ILUOUT,ZNATURE1,ZNATURE2)
+ CALL HOR_INTERPOL(DTCO, U,GCP, &
+ ILUOUT,ZWATER1,ZWATER2)
+ CALL HOR_INTERPOL(DTCO, U,GCP, &
+ ILUOUT,ZTOWN1,ZTOWN2)
+!
+DEALLOCATE(ZSEA1)
+DEALLOCATE(ZNATURE1)
+DEALLOCATE(ZWATER1)
+DEALLOCATE(ZTOWN1)
+!
+ALLOCATE(U%XSEA (IL))
+ALLOCATE(U%XNATURE(IL))
+ALLOCATE(U%XWATER (IL))
+ALLOCATE(U%XTOWN (IL))
+!
+U%XSEA(:) = ZSEA2 (:,1)
+U%XNATURE(:)= ZNATURE2(:,1)
+U%XWATER(:) = ZWATER2 (:,1)
+U%XTOWN(:) = ZTOWN2 (:,1)
+!
+DEALLOCATE(ZSEA2)
+DEALLOCATE(ZNATURE2)
+DEALLOCATE(ZWATER2)
+DEALLOCATE(ZTOWN2)
+!
+ CALL CLEAN_PREP_OUTPUT_GRID
+!------------------------------------------------------------------------------
+!
+!* 5. Coherence check
+! ---------------
+!
+ALLOCATE(ZSUM(IL))
+ZSUM = 0.
+DO JCOVER=1,SIZE(U%XCOVER,2)
+ ZSUM(:) = ZSUM(:) + U%XCOVER(:,JCOVER)
+END DO
+#ifdef MNH_PARALLEL
+CALL MPPDB_CHECK_SURFEX2D(ZSUM,"ZOOM_PGD_COVER:ZSUM",PRECISION,ILUOUT)
+#endif
+!
+DO JCOVER=1,SIZE(U%XCOVER,2)
+ WHERE(ZSUM(:)/=0.) U%XCOVER(:,JCOVER) = U%XCOVER(:,JCOVER)/ZSUM(:)
+END DO
+!
+DO JCOVER=1,SIZE(U%XCOVER,2)
+ IF ( SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,U%XCOVER(:,JCOVER)/=0., 'COV') == 0 ) THEN
+ U%LCOVER(JCOVER) = .FALSE.
+ END IF
+END DO
+!------------------------------------------------------------------------------
+!
+!* 6. Fractions
+! ---------
+!
+! When the model runs in multiproc, NSIZE* represents the number of points
+! on a proc, and NDIM* the total number of points on all procs.
+! The following definition of NDIM* won't be correct any more when the PGD
+! runs in multiproc.
+!
+U%NSIZE_NATURE = COUNT(U%XNATURE(:) > 0.0)
+U%NSIZE_WATER = COUNT(U%XWATER (:) > 0.0)
+U%NSIZE_SEA = COUNT(U%XSEA (:) > 0.0)
+U%NSIZE_TOWN = COUNT(U%XTOWN (:) > 0.0)
+U%NSIZE_FULL = IL
+!
+U%NDIM_NATURE = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,U%XNATURE(:) > 0., 'DIM')
+U%NDIM_WATER = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,U%XWATER (:) > 0., 'DIM')
+U%NDIM_SEA = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,U%XSEA (:) > 0., 'DIM')
+U%NDIM_TOWN = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,U%XTOWN (:) > 0., 'DIM')
+ZSUM=1.
+U%NDIM_FULL = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,ZSUM (:) ==1., 'DIM')
+DEALLOCATE(ZSUM)
+!
+ALLOCATE(U%NR_NATURE (U%NSIZE_NATURE))
+ALLOCATE(U%NR_TOWN (U%NSIZE_TOWN ))
+ALLOCATE(U%NR_WATER (U%NSIZE_WATER ))
+ALLOCATE(U%NR_SEA (U%NSIZE_SEA ))
+!
+IF (U%NSIZE_SEA >0)CALL GET_1D_MASK( U%NSIZE_SEA, U%NSIZE_FULL, U%XSEA , U%NR_SEA )
+IF (U%NSIZE_WATER >0)CALL GET_1D_MASK( U%NSIZE_WATER, U%NSIZE_FULL, U%XWATER , U%NR_WATER )
+IF (U%NSIZE_TOWN >0)CALL GET_1D_MASK( U%NSIZE_TOWN, U%NSIZE_FULL, U%XTOWN , U%NR_TOWN )
+IF (U%NSIZE_NATURE>0)CALL GET_1D_MASK( U%NSIZE_NATURE, U%NSIZE_FULL, U%XNATURE, U%NR_NATURE)
+#ifdef MNH_PARALLEL
+CALL MPPDB_CHECK_SURFEX2D(U%XSEA,"ZOOM_PGD_COVER:XSEA",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(U%XWATER,"ZOOM_PGD_COVER:XWATER",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(U%XTOWN,"ZOOM_PGD_COVER:XTOWN",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(U%XNATURE,"ZOOM_PGD_COVER:XNATURE",PRECISION,ILUOUT)
+#endif
+IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_COVER',1,ZHOOK_HANDLE)
+
+!_______________________________________________________________________________
+!
+END SUBROUTINE ZOOM_PGD_COVER
diff --git a/src/SURFEX/zoom_pgd_isba.F90 b/src/SURFEX/zoom_pgd_isba.F90
index fa209759cb432b23f351c1112cde40ad0cfce215..190416efce9ff9dd50892f3092693855d12ff0e3 100644
--- a/src/SURFEX/zoom_pgd_isba.F90
+++ b/src/SURFEX/zoom_pgd_isba.F90
@@ -37,6 +37,7 @@
!! Original 13/10/03
!! B. Decharme 2008 XWDRAIN
!! M.Tomasini 17/04/12 Add interpolation for ISBA variables (MODD_DATA_ISBA_n)
+! M.Moge 05/02/15 MPPDB_CHECK
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -76,6 +77,10 @@ USE MODI_PACK_PGD_ISBA
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+!
+#endif
IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
@@ -238,7 +243,14 @@ ALLOCATE(I%XZ0EFFJPDIR(ILU))
HPROGRAM, 'NATURE', &
IG%CGRID, IG%XGRID_PAR, &
I%LCOVER, I%XCOVER, I%XZS, &
- IG%XLAT, IG%XLON, IG%XMESH_SIZE, I%XZ0EFFJPDIR )
+ IG%XLAT, IG%XLON, IG%XMESH_SIZE, I%XZ0EFFJPDIR )
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(I%XCOVER,"ZOOM_PGD_ISBA:XCOVER",PRECISION,ILUOUT,'NATURE',SIZE(I%XCOVER,2))
+ CALL MPPDB_CHECK_SURFEX2D(IG%XLAT,"ZOOM_PGD_ISBA:XLAT",PRECISION,ILUOUT,'NATURE')
+ CALL MPPDB_CHECK_SURFEX2D(IG%XLON,"ZOOM_PGD_ISBA:XLON",PRECISION,ILUOUT,'NATURE')
+ CALL MPPDB_CHECK_SURFEX2D(IG%XMESH_SIZE,"ZOOM_PGD_ISBA:XMESH_SIZE",PRECISION,ILUOUT,'NATURE')
+ CALL MPPDB_CHECK_SURFEX2D(I%XZ0EFFJPDIR,"ZOOM_PGD_ISBA:XZ0EFFJPDIR",PRECISION,ILUOUT,'NATURE')
+#endif
!
!------------------------------------------------------------------------------
!
@@ -251,6 +263,12 @@ ALLOCATE(I%XRUNOFFB(ILU))
ALLOCATE(I%XWDRAIN (ILU))
CALL ZOOM_PGD_ISBA_FULL(CHI, DTCO, DTI, IG, I, UG, U, GCP,&
HPROGRAM,HINIFILE,HINIFILETYPE)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(I%XSAND,"ZOOM_PGD_ISBA:XSAND",PRECISION,ILUOUT,'NATURE',I%NGROUND_LAYER)
+ CALL MPPDB_CHECK_SURFEX3D(I%XCLAY,"ZOOM_PGD_ISBA:XCLAY",PRECISION,ILUOUT,'NATURE',I%NGROUND_LAYER)
+ CALL MPPDB_CHECK_SURFEX2D(I%XRUNOFFB,"ZOOM_PGD_ISBA:XRUNOFFB",PRECISION,ILUOUT,'NATURE')
+ CALL MPPDB_CHECK_SURFEX2D(I%XWDRAIN,"ZOOM_PGD_ISBA:XWDRAIN",PRECISION,ILUOUT,'NATURE')
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -280,6 +298,17 @@ ALLOCATE(ZSSO_SLOPE(IL))
ZAOSIP, ZAOSIM, ZAOSJP, ZAOSJM, &
ZHO2IP, ZHO2IM, ZHO2JP, ZHO2JM, &
ZSSO_SLOPE )
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX2D(ZAOSIP,"ZOOM_PGD_ISBA:ZAOSIP",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(ZAOSIM,"ZOOM_PGD_ISBA:ZAOSIM",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(ZAOSJP,"ZOOM_PGD_ISBA:ZAOSJP",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(ZAOSJM,"ZOOM_PGD_ISBA:ZAOSJM",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(ZHO2IP,"ZOOM_PGD_ISBA:ZHO2IP",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(ZHO2IM,"ZOOM_PGD_ISBA:ZHO2IM",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(ZHO2JP,"ZOOM_PGD_ISBA:ZHO2JP",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(ZHO2JM,"ZOOM_PGD_ISBA:ZHO2JM",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(ZSSO_SLOPE,"ZOOM_PGD_ISBA:ZSSO_SLOPE",PRECISION,ILUOUT)
+#endif
!
DEALLOCATE(ZAOSIP)
DEALLOCATE(ZAOSIM)
diff --git a/src/SURFEX/zoom_pgd_orography.F90 b/src/SURFEX/zoom_pgd_orography.F90
index 6f21dd21b7b9fe21cd49291b3889d7ffa35a2faa..e24b8aa260eb390472b81f031c0f7f91f83a03df 100644
--- a/src/SURFEX/zoom_pgd_orography.F90
+++ b/src/SURFEX/zoom_pgd_orography.F90
@@ -70,6 +70,11 @@ USE PARKIND1 ,ONLY : JPRB
USE MODI_CLEAN_PREP_OUTPUT_GRID
!
USE MODI_GET_LUOUT
+!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+!
+#endif
IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
@@ -144,6 +149,10 @@ IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_OROGRAPHY',0,ZHOOK_HANDLE)
!
CALL PREP_OUTPUT_GRID(UG, U, &
ILUOUT,UG%CGRID,UG%XGRID_PAR,UG%XLAT,UG%XLON)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX2D(UG%XLAT,"ZOOM_PGD_OROGRAPHY:XLAT",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(UG%XLON,"ZOOM_PGD_OROGRAPHY:XLON",PRECISION,ILUOUT)
+#endif
!
!------------------------------------------------------------------------------
!
@@ -316,6 +325,26 @@ WHERE (PWATER(:)==1.)
USS%XAOSJP(:) = 0.
USS%XAOSJM(:) = 0.
END WHERE
+#ifdef MNH_PARALLEL
+CALL MPPDB_CHECK_SURFEX2D(U%XZS,"ZOOM_PGD_OROGRAPHY:XZS",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XAVG_ZS,"ZOOM_PGD_OROGRAPHY:XAVG_ZS",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XSIL_ZS,"ZOOM_PGD_OROGRAPHY:XSIL_ZS",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XSSO_STDEV,"ZOOM_PGD_OROGRAPHY:XSSO_STDEV",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XMIN_ZS,"ZOOM_PGD_OROGRAPHY:XMIN_ZS",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XMAX_ZS,"ZOOM_PGD_OROGRAPHY:XMAX_ZS",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XSSO_ANIS,"ZOOM_PGD_OROGRAPHY:XSSO_ANIS",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XSSO_DIR,"ZOOM_PGD_OROGRAPHY:XSSO_DIR",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XSSO_SLOPE,"ZOOM_PGD_OROGRAPHY:XSSO_SLOPE",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XAOSIP,"ZOOM_PGD_OROGRAPHY:XAOSIP",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XAOSIM,"ZOOM_PGD_OROGRAPHY:XAOSIM",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XAOSJP,"ZOOM_PGD_OROGRAPHY:XAOSJP",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XAOSJM,"ZOOM_PGD_OROGRAPHY:XAOSJM",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XHO2IP,"ZOOM_PGD_OROGRAPHY:XHO2IP",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XHO2IM,"ZOOM_PGD_OROGRAPHY:XHO2IM",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XHO2JP,"ZOOM_PGD_OROGRAPHY:XHO2JP",PRECISION,ILUOUT)
+CALL MPPDB_CHECK_SURFEX2D(USS%XHO2JM,"ZOOM_PGD_OROGRAPHY:XHO2JM",PRECISION,ILUOUT)
+!
+#endif
! go back to child model
CALL GOTO_MODEL_MNH(U,HPROGRAM, 2, IINFO_ll)
!_______________________________________________________________________________
diff --git a/src/SURFEX/zoom_pgd_seaflux.F90 b/src/SURFEX/zoom_pgd_seaflux.F90
index 05a68fd64c098867a52a3fad0c0b92b07eed2195..4333401839fe54fe4409dc8033f07d3dcef3e850 100644
--- a/src/SURFEX/zoom_pgd_seaflux.F90
+++ b/src/SURFEX/zoom_pgd_seaflux.F90
@@ -36,6 +36,7 @@
!! Original 09/2008
!! G. TANGUY 03/2009 : add reading and interpolation of XDATA_SST and
!! TDATA_SST in the case LDATA_SST=T
+! Modification 05/02/15 M.Moge : MPPDB_CHECK
!!
!----------------------------------------------------------------------------
!
@@ -73,6 +74,10 @@ USE MODI_CLEAN_PREP_OUTPUT_GRID
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+!
+#endif
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -142,7 +147,12 @@ ALLOCATE(SG%XMESH_SIZE (SG%NDIM))
HPROGRAM, 'SEA ', &
SG%CGRID, SG%XGRID_PAR, S%LCOVER, &
S%XCOVER, S%XZS, &
- SG%XLAT, SG%XLON, SG%XMESH_SIZE )
+ SG%XLAT, SG%XLON, SG%XMESH_SIZE )
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(S%XCOVER,"ZOOM_PGD_SEAFLUX:XCOVER",PRECISION,ILUOUT, 'SEA',SIZE(S%XCOVER,2))
+ CALL MPPDB_CHECK_SURFEX2D(SG%XMESH_SIZE,"ZOOM_PGD_SEAFLUX:XMESH_SIZE",PRECISION,ILUOUT, 'SEA')
+ CALL MPPDB_CHECK_SURFEX2D(S%XZS,"ZOOM_PGD_SEAFLUX:XZS",PRECISION,ILUOUT, 'SEA')
+#endif
!
!------------------------------------------------------------------------------
!
@@ -154,6 +164,10 @@ ALLOCATE(SG%XMESH_SIZE (SG%NDIM))
!
CALL PREP_OUTPUT_GRID(UG, U, &
ILUOUT,SG%CGRID,SG%XGRID_PAR,SG%XLAT,SG%XLON)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX2D(SG%XLAT,"ZOOM_PGD_SEAFLUX:XLAT",PRECISION,ILUOUT, 'SEA')
+ CALL MPPDB_CHECK_SURFEX2D(SG%XLON,"ZOOM_PGD_SEAFLUX:XLON",PRECISION,ILUOUT, 'SEA')
+#endif
!
!* mask where interpolations must be done
!
diff --git a/src/SURFEX/zoom_pgd_teb.F90 b/src/SURFEX/zoom_pgd_teb.F90
index 43271ee5777e3b9487f394601e3765e955bb1e46..b7ba4f748cf3645a84228fadb954c5204aca4677 100644
--- a/src/SURFEX/zoom_pgd_teb.F90
+++ b/src/SURFEX/zoom_pgd_teb.F90
@@ -37,6 +37,7 @@
!! ------------
!!
!! Original 13/10/03
+! Modification 05/02/15 M.Moge : MPPDB_CHECK
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -87,6 +88,9 @@ USE MODI_GOTO_WRAPPER_TEB_PATCH
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+#endif
!
IMPLICIT NONE
!
@@ -181,7 +185,14 @@ ALLOCATE(TG%XMESH_SIZE (ILU))
HPROGRAM, 'TOWN ', &
TG%CGRID, TG%XGRID_PAR, &
TOP%LCOVER, TOP%XCOVER, TOP%XZS, &
- TG%XLAT, TG%XLON, TG%XMESH_SIZE )
+ TG%XLAT, TG%XLON, TG%XMESH_SIZE )
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(TOP%XCOVER,"ZOOM_PGD_TEB:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TOP%XCOVER,2))
+ CALL MPPDB_CHECK_SURFEX2D(TG%XLAT,"ZOOM_PGD_TEB:XLAT",PRECISION,ILUOUT, 'TOWN ')
+ CALL MPPDB_CHECK_SURFEX2D(TG%XLON,"ZOOM_PGD_TEB:XLON",PRECISION,ILUOUT, 'TOWN ')
+ CALL MPPDB_CHECK_SURFEX2D(TG%XMESH_SIZE,"ZOOM_PGD_TEB:XMESH_SIZE",PRECISION,ILUOUT, 'TOWN ')
+ CALL MPPDB_CHECK_SURFEX2D(TOP%XZS,"ZOOM_PGD_TEB:XZS",PRECISION,ILUOUT, 'TOWN ')
+#endif
!
TG%NDIM = ILU
!
@@ -200,6 +211,10 @@ TG%NDIM = ILU
!
CALL PREP_OUTPUT_GRID(UG, U, &
ILUOUT,TG%CGRID,TG%XGRID_PAR,TG%XLAT,TG%XLON)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX2D(TG%XLAT,"ZOOM_PGD_TEB:XLAT",PRECISION,ILUOUT, 'TOWN ')
+ CALL MPPDB_CHECK_SURFEX2D(TG%XLON,"ZOOM_PGD_TEB:XLON",PRECISION,ILUOUT, 'TOWN ')
+#endif
!
!
!------------------------------------------------------------------------------
@@ -317,6 +332,9 @@ END DO
ALLOCATE(TGDP%XSAND(ILU,TGDO%NGROUND_LAYER))
CALL HOR_INTERPOL(DTCO, U,GCP, &
ILUOUT,ZIN,TGDP%XSAND)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(TGDP%XSAND,"ZOOM_PGD_TEB_GARDEB:XSAND",PRECISION,ILUOUT, 'TOWN ',TGDO%NGROUND_LAYER)
+#endif
DEALLOCATE(ZIN)
!
!* clay
@@ -332,6 +350,9 @@ END DO
ALLOCATE(TGDP%XCLAY(ILU,TGDO%NGROUND_LAYER))
CALL HOR_INTERPOL(DTCO, U,GCP, &
ILUOUT,ZIN,TGDP%XCLAY)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(TGDP%XCLAY,"ZOOM_PGD_TEB_GARDEB:XCLAY",PRECISION,ILUOUT, 'TOWN ',TGDO%NGROUND_LAYER)
+#endif
DEALLOCATE(ZIN)
!
!* runoff & drainage
@@ -345,6 +366,9 @@ ZIN(:,1) = ZFIELD(:)
ALLOCATE(TGDP%XRUNOFFB(ILU))
CALL HOR_INTERPOL(DTCO, U,GCP, &
ILUOUT,ZIN,ZOUT)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(ZOUT,"ZOOM_PGD_TEB_GARDEB:ZOUT",PRECISION,ILUOUT, 'TOWN ',1)
+#endif
TGDP%XRUNOFFB(:) = ZOUT(:,1)
!
IF (IVERSION<=3) THEN
@@ -358,6 +382,9 @@ ELSE
ALLOCATE(TGDP%XWDRAIN(ILU))
CALL HOR_INTERPOL(DTCO, U,GCP, &
ILUOUT,ZIN,ZOUT)
+#ifdef MNH_PARALLEL
+ CALL MPPDB_CHECK_SURFEX3D(ZOUT,"ZOOM_PGD_TEB_GARDEB:ZOUT",PRECISION,ILUOUT, 'TOWN ',1)
+#endif
TGDP%XWDRAIN(:) = ZOUT(:,1)
ENDIF
!
diff --git a/src/configure b/src/configure
index cb9feedf79b593e1dd2a5afb962d6c680f74e33a..573a10979dc0166d265356a331fe641f969d203c 100755
--- a/src/configure
+++ b/src/configure
@@ -9,9 +9,9 @@ if [ "x$XYZ" = "x" ]
then
#
export VERSION_MASTER=${VERSION_MASTER:-MNH-V5-3}
-export VERSION_BUG=${VERSION_BUG:-0}
+export VERSION_BUG=${VERSION_BUG:-1}
export VERSION_XYZ=${VERSION_XYZ:-${VERSION_MASTER}-${VERSION_BUG}${VER_OASIS:+-${VER_OASIS}}}
-export VERSION_DATE=${VERSION_DATE:-"15/12/2016"}
+export VERSION_DATE=${VERSION_DATE:-"25/09/2017"}
export VERSION_CDF=${VERSION_CDF:-"4.1.3"}
export VERSION_HDF=${VERSION_HDF:-"1.8.9"}
export VERSION_GRIBAPI=${VERSION_GRIBAPI:-"1.13.1"}
@@ -44,7 +44,7 @@ case "$TARG" in
export MNHENV=${MNHENV:-"
ulimit -s unlimited
module purge
-module load intel/17.0 intelmpi/2017.0.098
+module load intel/17.0 intelmpi/2017.2.174
export SLURM_CPU_BIND=none
export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
"}
@@ -87,6 +87,9 @@ export MPI_DSM_CPULIST=0-7:allhosts
export OPTLEVEL=${OPTLEVEL:-O2}
export MVWORK=${MVWORK:-NO}
export VER_CDF=${VER_CDF:-CDFAUTO}
+ export MNHENV=${MNHENV:-"
+module load ncl_ncarg/6.3.0
+"}
;;
'Linux beaufix'*|'Linux prolix'*)
export ARCH=${ARCH:-LXifort}
@@ -215,7 +218,7 @@ export LIB_GRIBAPI='${GRIB_API_LIB}'
then
export MNHENV=${MNHENV:-"
. /opt/modules/default/init/bash
-module rm grib_api
+module rm grib_api eccodes
module rm craype-broadwell
export CRAY_CPU_TARGET=ivybridge
module swap cdt/1.15_8.2.7
@@ -226,10 +229,10 @@ module use /opt/cray/craype/default/modulefiles
then
export MNHENV=${MNHENV:-"
. /opt/modules/default/init/bash
-module rm grib_api
+module rm grib_api eccodes
prgenvswitchto intel
module rm intel
-module load intel/16.0.3.210
+module load intel/17.0.3.053
"}
fi
fi
@@ -257,13 +260,13 @@ module load intel/16.0.3.210
'Linux nuwa'*)
export ARCH=${ARCH:-LXifort}
export VER_MPI=${VER_MPI:-MPIAUTO}
- export OPTLEVEL=${OPTLEVEL:-DEBUG}
+ export OPTLEVEL=${OPTLEVEL:-O2}
export MVWORK=${MVWORK:-NO}
export VER_CDF=${VER_CDF:-CDFAUTO}
export NEED_NCARG=${NEED_NCARG:-YES}
export MNHENV=${MNHENV:-"
-. /home/tools/intel/composer_xe_2013_sp1.1.106/bin/ifortvars.sh intel64
-export MPI_ROOT=/usr/local/OpenMPI/1.6.3/ifort13.0.0.079/
+. /home/tools/intel/psxe2017/bin/ifortvars.sh intel64
+export MPI_ROOT=/usr/local/openmpi/1.6.5/ifort17.0.1.132
export PATH=\$MPI_ROOT/bin:\$PATH
export LD_LIBRARY_PATH=\$MPI_ROOT/lib64:\$LD_LIBRARY_PATH
export MANPATH=\$MPI_ROOT/share/man:\$MANPATH
@@ -275,6 +278,8 @@ export MANPATH=\$MPI_ROOT/share/man:\$MANPATH
export OPTLEVEL=${OPTLEVEL:-O2}
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
+module purge
+module load intel/17.0.4 intelmpi/2017.3.196 ncl/6.2.0
export SLURM_CPU_BIND=none
export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
"}
diff --git a/src/include/isrpia.inc b/src/include/isrpia.inc
index 5c6c1ba60e5351ee8f63ea4678ca009a110ca59e..8bf43f8bd87bf444b33a72eabeaeab82252525a5 100644
--- a/src/include/isrpia.inc
+++ b/src/include/isrpia.inc
@@ -7,10 +7,11 @@ C AND VARIABLES.
C
C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
C *** WRITTEN BY ATHANASIOS NENES
+C J.Escobar : 10/2017 , for real*4 replace DOUBLE => REAL
C
C=======================================================================
C
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+ IMPLICIT REAL (A-H,O-Z)
PARAMETER (NCOMP=5,NIONS=7,NGASAQ=3,NSLDS=9,NPAIR=13,NZSR=100,
& NERRMX=25)
C
@@ -39,7 +40,7 @@ C
C
C *** VARIABLES FOR LIQUID AEROSOL PHASE *******************************
C
- DOUBLE PRECISION MOLAL, MOLALR, M0
+ REAL MOLAL, MOLALR, M0
REAL IONIC
LOGICAL CALAOU, CALAIN, FRST, DRYF
COMMON /IONS/ MOLAL(NIONS), MOLALR(NPAIR), GAMA(NPAIR), ZZ(NPAIR),
@@ -66,7 +67,7 @@ C
C
C *** MOLECULAR WEIGHTS ************************************************
C
- DOUBLE PRECISION IMW
+ REAL IMW
COMMON /OTHR/ R, IMW(NIONS), WMW(NCOMP), SMW(NPAIR)
C
C *** SOLUTION/INFO VARIABLES ******************************************
diff --git a/src/job_make_examples_BG b/src/job_make_examples_BG
index 2e9ed9bd10c8bc83e9d7bebb59f65519414b5210..087160994f454d02bbf50f58c38311cf064a60f4 100755
--- a/src/job_make_examples_BG
+++ b/src/job_make_examples_BG
@@ -18,7 +18,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BGI4-MNH-V5-3-0-MPIAUTO-O2
+. ../conf/profile_mesonh-BGI4-MNH-V5-3-1-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 f54d4f975d14b42e162b3d0c8071ce1c34aa2efe..b13b19fce1a278e5ae1e0840241a299062307896 100755
--- a/src/job_make_examples_BGQ
+++ b/src/job_make_examples_BGQ
@@ -18,7 +18,7 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BGQI4-MNH-V5-3-0-MPIAUTO-O2NAN
+. ../conf/profile_mesonh-BGQI4-MNH-V5-3-1-MPIAUTO-O2NAN
set -x
diff --git a/src/job_make_examples_BullX b/src/job_make_examples_BullX
index 081edd17b997dc921067c9e7a9f8895de65a5439..55ff4e051a82913e58f4737bec36912f61c05703 100755
--- a/src/job_make_examples_BullX
+++ b/src/job_make_examples_BullX
@@ -11,17 +11,17 @@
#SBATCH -t 01:00:00 # time limit
#SBATCH --export=NONE
-# Echo des commandes
ulimit -c 0
ulimit -s unlimited
-# Arrete du job des la premiere erreur
+# Arret du job des la premiere erreur
set -e
# Nom de la machine
hostname
+# Echo des commandes
-. ../conf/profile_mesonh-LXifortI4-MNH-V5-3-0-MPIINTEL-O3
-export MONORUN="mpirun -np 1 "
-export MPIRUN="mpirun -np 2 "
+. ../conf/profile_mesonh-LXifortI4-MNH-V5-3-1-MPIINTEL-O3
+export MONORUN="Mpirun -np 1 "
+export MPIRUN="Mpirun -np 2 "
export POSTRUN="time "
cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
diff --git a/src/job_make_examples_BullX_eos b/src/job_make_examples_BullX_eos
index 98e4ca1fb5b202aba9680390e7c7b9110aad1ef8..3245993d4c0008f9055ee2c87b462841870023f3 100755
--- a/src/job_make_examples_BullX_eos
+++ b/src/job_make_examples_BullX_eos
@@ -17,7 +17,7 @@ set -x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifortI4-MNH-V5-3-0-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifortI4-MNH-V5-3-1-MPIINTEL-O2
export MONORUN="mpirun -prepend-rank -np 1 "
export MPIRUN="mpirun -prepend-rank -np 4 "
export POSTRUN="time "
@@ -56,4 +56,9 @@ make -k << EOF
EOF
#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/014_LIMA
+make -k
diff --git a/src/job_make_examples_BullX_occigen b/src/job_make_examples_BullX_occigen
new file mode 100755
index 0000000000000000000000000000000000000000..4450321fa4eae7f2e39597e4328393ffb182ed8e
--- /dev/null
+++ b/src/job_make_examples_BullX_occigen
@@ -0,0 +1,65 @@
+#!/bin/bash
+#SBATCH -J Examples
+#SBATCH -N 2 # nodes number
+#SBATCH -n 4 # CPUs number (on all nodes)
+#SBATCH --constraint BDW28 # HSW24 or BDW28 architecture
+#SBATCH --exclusive
+#SBATCH -o Examples.eo%j #
+#SBATCH -e Examples.eo%j #
+#SBATCH -t 01:00:00 # time limit
+#SBATCH --export=NONE
+
+# Echo des commandes
+ulimit -c 0
+ulimit -s unlimited
+# Arrete du job des la premiere erreur
+#set -e
+set -x
+# Nom de la machine
+hostname
+
+. ../conf/profile_mesonh-LXifortI4-MNH-V5-3-1-MPIINTEL-O2
+export MONORUN="Mpirun -prepend-rank -np 1 "
+export MPIRUN="Mpirun -prepend-rank -np 4 "
+export POSTRUN="time "
+
+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
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/014_LIMA
+make -k
+
diff --git a/src/job_make_examples_CRAY_cca b/src/job_make_examples_CRAY_cca
index e4419e39232e058c4c03ad716065218ac18f009e..e0f0f624a06600123001710f2236587baf324adf 100755
--- a/src/job_make_examples_CRAY_cca
+++ b/src/job_make_examples_CRAY_cca
@@ -20,6 +20,7 @@ ulimit -a
#ulimit -s unlimited
# Arrete du job des la premiere erreur
set -e
+set -x
# Nom de la machine
hostname
@@ -27,7 +28,7 @@ cd ${PBS_O_WORKDIR}
ARCH=LXifort
#ARCH=LXcray
-. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-3-0-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-3-1-MPICRAY-O2
export MONORUN="aprun -n 1 "
@@ -72,4 +73,9 @@ make -k << EOF
EOF
#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/014_LIMA
+make -k
diff --git a/src/job_make_examples_IBM_ada b/src/job_make_examples_IBM_ada
index efe0cc0faa684ec494a80e5cb38909162bd33f2b..cf6307fbfe0b57147c680780940d2003026e8750 100755
--- a/src/job_make_examples_IBM_ada
+++ b/src/job_make_examples_IBM_ada
@@ -19,7 +19,7 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-LXifortI4-MNH-V5-3-0-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifortI4-MNH-V5-3-1-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 00c01b2361b1249d90f14363d1f1abade194b57c..68ff3bf5f06beccf89dbd290ae6dd82095dfdd37 100755
--- a/src/job_make_examples_IBM_sp6_vargas
+++ b/src/job_make_examples_IBM_sp6_vargas
@@ -24,7 +24,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-MNH-V5-3-0-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-MNH-V5-3-1-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 9779a0dc908aeb0220cdb058747f71431cad60da..1d346f595cd2d3d0b2c94dc662a2f88999eb8277 100755
--- a/src/job_make_examples_NEC_SX8
+++ b/src/job_make_examples_NEC_SX8
@@ -18,7 +18,7 @@ hostname
[ -d $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
#
-. ../conf/profile_mesonh-SX8I4-MNH-V5-3-0-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8I4-MNH-V5-3-1-MPIAUTO-O4
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
diff --git a/src/job_make_examples_SX8 b/src/job_make_examples_SX8
index 6898238171464eaf875400f162ab81edf629097b..9285303aa1ea24ca22b6577b2302135f497f0a8f 100755
--- a/src/job_make_examples_SX8
+++ b/src/job_make_examples_SX8
@@ -19,7 +19,7 @@ hostname
[ -d $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
#
-. ../conf/profile_mesonh-SX8I4-MNH-V5-3-0-MPIAUTO-O2
+. ../conf/profile_mesonh-SX8I4-MNH-V5-3-1-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 b37498a28e0f571c6d3cdc195161af19c7f20c65..598e3bb48433463bcb3fe10354fc45e0587a9217 100755
--- a/src/job_make_examples_cxa
+++ b/src/job_make_examples_cxa
@@ -34,7 +34,7 @@ echo SHELL=$SHELL
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64I4-MNH-V5-3-0-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64I4-MNH-V5-3-1-MPIAUTO-O2
ulimit -c 0 # pas de core
diff --git a/src/job_make_mesonh_BG b/src/job_make_mesonh_BG
index a3cff93000a45a033b85384136f02c638234b8fc..e36de00b41ae96f2da9d00e4b5bf190f5ed8c1d8 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-BGI4-MNH-V5-3-0-MPIAUTO-O2
+. ../conf/profile_mesonh-BGI4-MNH-V5-3-1-MPIAUTO-O2
#time gmake
time gmake -r -j8
diff --git a/src/job_make_mesonh_BGQ b/src/job_make_mesonh_BGQ
index 3e64b821292e56cd68ccc242940b663c5188f3f5..858fcd81fbea06b348716ae131852ad1be34ac36 100755
--- a/src/job_make_mesonh_BGQ
+++ b/src/job_make_mesonh_BGQ
@@ -34,7 +34,7 @@ set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BGQI4-MNH-V5-3-0-MPIAUTO-O2NAN
+. ../conf/profile_mesonh-BGQI4-MNH-V5-3-1-MPIAUTO-O2NAN
case $LOADL_STEP_NAME in
diff --git a/src/job_make_mesonh_BullX b/src/job_make_mesonh_BullX
index eb5445b67a71a6df1be67ded03c40a4eb2bb9c0d..ebd24bd43de60ee858448ae6e3b51bfc0edf981a 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-LXifortI4-MNH-V5-3-0-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifortI4-MNH-V5-3-1-MPIINTEL-O3
time gmake -j 4
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_CRAY_cca b/src/job_make_mesonh_CRAY_cca
index f990b49859156d7b8d93784bf42f6bc9e20bf44c..b09164a217382a76afe3a899a7b523e6405d0c50 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}I4-MNH-V5-3-0-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-3-1-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_IBM_ada b/src/job_make_mesonh_IBM_ada
index 242bfeffec52b5721387a4c76489c398d9297ea0..6877a607f6e1a711e51b380fda936a7d934e77e8 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-LXifortI4-MNH-V5-3-0-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifortI4-MNH-V5-3-1-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 e512f326b2efef15d5c7cf5b37dda9a1d35614ae..5564f5e7bdf91944866ccf1c18fec5776e615aa0 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-AIX64I4-MNH-V5-3-0-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64I4-MNH-V5-3-1-MPIAUTO-O2
time gmake -j1 gribapi
time gmake -r -j8
diff --git a/src/job_make_mesonh_MFSX8 b/src/job_make_mesonh_MFSX8
index 9714a4a646e10cff7190ff55e00124ab8b23b9a0..3b46451a0620acd7cb4e98d538d40dfabb1aed3f 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-SX8I4-MNH-V5-3-0-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8I4-MNH-V5-3-1-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 2a65c5b62f3a393830ffff89251c2035dc23d3db..bf37d27e7a7fd0458186f04b7fb5c90ee837d068 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-SX8I4-MNH-V5-3-0-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8I4-MNH-V5-3-1-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 95b68b849ed8a109345dd9442bd27ded03dfc38e..e7ef6e99d3b8ba3c01a3f7bc1a9af8818ec70cfe 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-AIX64I4-MNH-V5-3-0-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64I4-MNH-V5-3-1-MPIAUTO-O2
time gmake -r -j1
time gmake installmaster
diff --git a/src/job_make_mesonh_user_BullX b/src/job_make_mesonh_user_BullX
index 0f7eae055fcdd16d90fd788d3cee2678ccff81bb..2614c0dfafea7e93788df05d11ce6933b2a4d048 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-LXifortI4-MNH-V5-3-0-${VER_USER}-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifortI4-MNH-V5-3-1-${VER_USER}-MPIINTEL-O3
time gmake user
time gmake -j 1 installuser
diff --git a/src/job_make_mesonh_user_MFSX8 b/src/job_make_mesonh_user_MFSX8
index 773599f8fe2e43659179ddf46cd53821e25dd5ef..f1bcda4a7f8546a075b5035c19ae32eaa713955e 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-SX8I4-MNH-V5-3-0-${VER_USER}-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8I4-MNH-V5-3-1-${VER_USER}-MPIAUTO-O4
time gmake user
time gmake -j 1 installuser