diff --git a/A-INSTALL b/A-INSTALL
index 5d1cae4c7e1a0c2ee01ac98bb5fe92a7b1f3c428..14ef158756ed91d741f6384f049c749be1b371b5 100644
--- a/A-INSTALL
+++ b/A-INSTALL
@@ -1,8 +1,8 @@
#
# Version of PACKAGE MESONH "Open distribution"
-# PACK-MNH-V5-6-0
-# DATE : 08/03/2023
-# VERSION : MESONH MASDEV5_6 + BUG-0
+# PACK-MNH-V5-6-1
+# DATE : 25/09/2023
+# VERSION : MESONH MASDEV5_6 + BUG-1
#
# MAP
#
@@ -84,14 +84,14 @@
#
# or directly
#
-# http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-6-0.tar.gz
+# http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-6-1.tar.gz
#
-# Then untar the file "MNH-V5-6-0.tar.gz" where you want to.
+# Then untar the file "MNH-V5-6-1.tar.gz" where you want to.
# For example, in your home directory:
#
cd ~
-tar xvfz MNH-V5-6-0.tar.gz
+tar xvfz MNH-V5-6-1.tar.gz
#
# Process now to the chapter to configure the MesoNH package.
@@ -171,10 +171,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-56-branch MNH-V5-6-0
+git lfs clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MNH-56-branch MNH-V5-6-1
#
-# that will create the MNH-V5-6-0 directory containing a clone (copy) of the
+# that will create the MNH-V5-6-1 directory containing a clone (copy) of the
# Meso-NH package on the remote developpement branch MNH-56-branch
#
#
@@ -184,16 +184,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-56-branch development branch ).
#
-# To create your local branch corresponding to the V5-6-0 version, type:
+# To create your local branch corresponding to the V5-6-1 version, type:
#
-cd MNH-V5-6-0
-git checkout -b MYB-MNH-V5-6-0 PACK-MNH-V5-6-0
+cd MNH-V5-6-1
+git checkout -b MYB-MNH-V5-6-1 PACK-MNH-V5-6-1
#
-# MYB-MNH-V5-6-0 is the name of the local branch you created
+# MYB-MNH-V5-6-1 is the name of the local branch you created
# and
-# PACK-MNH-V5-6-0 is the remote/origin tag on which it is based.
+# PACK-MNH-V5-6-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
@@ -257,7 +257,7 @@ git clone anongit@anongit_mesonh:/gitrepos/MNH-DOC.git
# use the "./configure" script like this
#
-cd ~/MNH-V5-6-0/src
+cd ~/MNH-V5-6-1/src
./configure
. ../conf/profile_mesonh
@@ -308,7 +308,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-6-0.MPIAUTO.O2
+. ../conf/profile_mesonh.LXifort.MNH-V5-6-1.MPIAUTO.O2
#
# REM:
@@ -333,7 +333,7 @@ export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less
# go to the directory "src"
#
-cd ~/MNH-V5-6-0/src
+cd ~/MNH-V5-6-1/src
#
# if you have not already configured your MESONH environment
@@ -562,7 +562,7 @@ make examples
#
cd $WORKDIR
-cd MNH-V5-6-0/src
+cd MNH-V5-6-1/src
./configure
@@ -576,8 +576,8 @@ cd MNH-V5-6-0/src
# - On JEAN-ZAY ( HPE ) the compilation is in interactive :
-cd MNH-V5-6-0/src
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIINTEL-O2
+cd MNH-V5-6-1/src
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIINTEL-O2
make -j16 |& tee error$XYZ
make installmaster
@@ -609,26 +609,58 @@ sbatch job_make_examples_BullX_occigen
# At TGCC , you have two architectures accessible throw 2 differents frontals
# but with a commun disk space , connect to :
#
-# - ssh irene-fr : for Intel SkyLake/KNL processors
-# On Intel processors the MPI use is OPENMPI/2.0.4
+# - ssh irene-fr : for Intel SkyLake processors
+# On Intel processors the MPI use is OPENMPI/4.1.4
# the configure will generate a
-# profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIAUTO-O2
+# profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIAUTO-O2
#
# - ssh irene-amd : for AMD , processors
-# On AMD processors the MPI use is OPENMPI/4.02
+# On AMD processors the MPI use is OPENMPI/4.1.4
# the configure will generate a
-# profile_mesonh-LXifort-R8I4-MNH-V5-6-0-AMD-MPIAUTO-O2
+# profile_mesonh-LXifort-R8I4-MNH-V5-6-1-AMD-MPIAUTO-O2
#
-# - install the PACKAGE in your $CCCHOME ( default 20Go of quota )
-# - Compile in interactive mode ( see IDRIS )
#
+# At TGCC they use 'one login' for multi-project allocation .
+# This induce 'strange' problem with the installation of eccodes
+# resulting in file with the wrong default group and 'disk quota excedeed' error
+#
+# You could get your different project info by 'ccc_myproject'
+#
+# I recommand you first, supposing that the "Genci Allocation" you want to use
+# as for projet group "genXXXX"
+#
+# 1) to add in your "~/.bash_profile"
+#
+module switch dfldatadir dfldatadir/genXXXX
+newgrp genXXXX
+
+# 2) "logout & login" again
+# and check that you have now the good default group
+#
+id -ng
+--> genXXXX
+echo $CCCHOME
+--> /ccc/.../home/genXXXX/{your_login}
+
+# If all is OK , you could install the code in interactive as usally
+#
+# - install the PACKAGE in your ${CCCHOME} ( default 20Go of quota )
+# for example on Intel frontal
+cd ${CCCHOME}
+cd MNH-V5-6-1/src
+./configure
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIAUTO-O2
+make -j16 |& tee error$XYZ
+make installmaster
+
+# REM: The eccode lib will be installed in your ${CCCWORKDIR}
+# also for the quota problem ...
+#
# - to run the test case examples run
#
# On intel Skylake
ccc_msub job_make_examples_BullX_irene
-# On intel Knl
-ccc_msub -q knl job_make_examples_BullX_irene
# On intel AMD
ccc_msub job_make_examples_BullX_irene_AMD
@@ -657,14 +689,14 @@ sbatch job_make_examples_Atos_HPCF
# - At Meteo-France DSI on belenos
#
# to install the whole package on your "$HOME" directory
-# untar the file "MNH-V5-6-0.tar.gz" from its location :
+# untar the file "MNH-V5-6-1.tar.gz" from its location :
cd ~
-tar xvf $MESONH/MNH-V5-6-0.tar.gz
+tar xvf $MESONH/MNH-V5-6-1.tar.gz
# run the "./configure" command :
-cd MNH-V5-6-0/src
+cd MNH-V5-6-1/src
./configure
#
@@ -763,7 +795,7 @@ scandollar
## OUTPUT ::
-># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-6-0/conf/post/confdollar_aeropc_default
+># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-6-1/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
@@ -785,7 +817,7 @@ scandollar 0*
## OUTPUT ::
>#
-># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-6-0/conf/post/confdollar_aeropc_default
+># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-6-1/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
@@ -859,22 +891,22 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use this "profile_mesonh" :
-. /home/rech/mnh/rmnh007/DEV/MNH-V5-6-0/conf/profile_mesonh-SX8-MNH-V5-6-0-MPIAUTO-O4
+. /home/rech/mnh/rmnh007/DEV/MNH-V5-6-1/conf/profile_mesonh-SX8-MNH-V5-6-1-MPIAUTO-O4
# And the examples are here ( link to my $WORKDIR in actually )
-/home/rech/mnh/rmnh007/DEV/MNH-V5-6-0/MY_RUN/KTEST/007_16janvier_scandollar
+/home/rech/mnh/rmnh007/DEV/MNH-V5-6-1/MY_RUN/KTEST/007_16janvier_scandollar
#
# On vargas
# ---------
# use this "profile_mesonh" :
-. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-6-0/conf/profile_mesonh-AIX64-MNH-V5-6-0-MPIAUTO-O2
+. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-6-1/conf/profile_mesonh-AIX64-MNH-V5-6-1-MPIAUTO-O2
# and examples here :
-/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-6-0/MY_RUN/KTEST/007_16janvier_scandollar
+/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-6-1/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At CINES on JADE :
@@ -882,11 +914,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
-. /work/escobar/DEV/MNH-V5-6-0/conf/profile_mesonh-LXifort-MNH-V5-6-0-MPIICE-O2
+. /work/escobar/DEV/MNH-V5-6-1/conf/profile_mesonh-LXifort-MNH-V5-6-1-MPIICE-O2
# and the exemples
-/work/escobar/DEV/MNH-V5-6-0/MY_RUN/KTEST/007_16janvier_scandollar
+/work/escobar/DEV/MNH-V5-6-1/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At ECMWF on cxa :
@@ -894,11 +926,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
-. /c1a/ms_perm/au5/MNH-V5-6-0/conf/profile_mesonh-AIX64-MNH-V5-6-0-MPIAUTO-O2
+. /c1a/ms_perm/au5/MNH-V5-6-1/conf/profile_mesonh-AIX64-MNH-V5-6-1-MPIAUTO-O2
# and the examples
-/c1a/ms_perm/au5/MNH-V5-6-0/MY_RUN/KTEST/007_16janvier_scandollar
+/c1a/ms_perm/au5/MNH-V5-6-1/MY_RUN/KTEST/007_16janvier_scandollar
#
diff --git a/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90 b/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
index 80463b15e853a44ca9c31fc0498d1e628980113e..904898810bf8d5521d21c3769d90c19cf545d252 100644
--- a/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
+++ b/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
@@ -570,7 +570,6 @@ END DO
tpreclist(ji)%TFIELD%NTYPE = tpreclist(idx_var)%TFIELD%NTYPE
tpreclist(ji)%TFIELD%NDIMS = tpreclist(idx_var)%TFIELD%NDIMS
#if 0
-!PW: TODO?
tpreclist(ji)%TFIELD%NFILLVALUE
tpreclist(ji)%TFIELD%XFILLVALUE
tpreclist(ji)%TFIELD%NVALIDMIN
@@ -1427,7 +1426,6 @@ END DO
ISTATUS = NF90_GET_ATT(IFILE_ID, KVAR_ID, 'split_nblocks', iblocks)
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_GET_ATT', 'split_nblocks' )
-!PW: todo:check tfiles_ioz exist
IFILE_ID = TPFILE%TFILES_IOZ(1)%TFILE%NNCID
istatus = NF90_INQ_VARID(IFILE_ID,trim(TPREC%NAME)//'0001',ivar_id)
diff --git a/conf/profile_mesonh.ihm b/conf/profile_mesonh.ihm
index 5dd42a093c608bc654d32f9a8003c1edd6de8f16..2dd85d9d8a42475a13ed31dc447a849bf0970364 100755
--- a/conf/profile_mesonh.ihm
+++ b/conf/profile_mesonh.ihm
@@ -148,6 +148,7 @@ fi
##########################################################
#
export XYZ="-\${ARCH}-R\${MNH_REAL}I\${MNH_INT}-\${VERSION_XYZ}\${MNH_ECRAD:+-ECRAD${VER_ECRAD}}\${MNH_FOREFIRE:+-FF}\${VER_USER:+-\${VER_USER}}-\${VER_MPI}-\${OPTLEVEL}"
+export XYZM="-\${ARCH}-R\${MNH_REAL}I\${MNH_INT}-\${VERSION_XYZ}\${MNH_ECRAD:+-ECRAD${VER_ECRAD}}\${MNH_FOREFIRE:+-FF}-\${VER_MPI}-\${OPTLEVEL}"
#[ "x\${VER_USER}" != "x" ] && export XYZ="\${XYZ}-\${VER_USER}"
# PATH to find tools like "makegen, etc ..."
export BIN_TOOLS=${BIN_TOOLS}
diff --git a/src/ARCH_SRC/MNHZ/prep_ideal_case.f90 b/src/ARCH_SRC/MNHZ/prep_ideal_case.f90
index 6609c859788cc41565186a5f39ca44d6e12ebd05..a1ee5ec177fa4765aa0805452083832d8a29a851 100644
--- a/src/ARCH_SRC/MNHZ/prep_ideal_case.f90
+++ b/src/ARCH_SRC/MNHZ/prep_ideal_case.f90
@@ -594,22 +594,22 @@ CALL OPEN_ll(UNIT=NLUPRE,FILE=CEXPRE,IOSTAT=NRESP,ACTION='READ', &
!* 3.2 read in NLUPRE the namelist informations
!
WRITE(NLUOUT,FMT=*) 'attempt to read ',TRIM(CEXPRE),' file'
-CALL POSNAM(NLUPRE,'NAM_REAL_PGD',GFOUND,NLUOUT)
+CALL POSNAM(NLUPRE,'NAM_REAL_PGD',GFOUND)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_REAL_PGD)
!
!
-CALL POSNAM(NLUPRE,'NAM_CONF_PRE',GFOUND,NLUOUT)
+CALL POSNAM(NLUPRE,'NAM_CONF_PRE',GFOUND)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONF_PRE)
-CALL POSNAM(NLUPRE,'NAM_GRID_PRE',GFOUND,NLUOUT)
+CALL POSNAM(NLUPRE,'NAM_GRID_PRE',GFOUND)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRID_PRE)
-CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND,NLUOUT)
+CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRIDH_PRE)
-CALL POSNAM(NLUPRE,'NAM_VPROF_PRE',GFOUND,NLUOUT)
+CALL POSNAM(NLUPRE,'NAM_VPROF_PRE',GFOUND)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_VPROF_PRE)
-CALL POSNAM(NLUPRE,'NAM_BLANK',GFOUND,NLUOUT)
+CALL POSNAM(NLUPRE,'NAM_BLANK',GFOUND)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_BLANK)
CALL READ_PRE_IDEA_NAM_n(NLUPRE,NLUOUT)
-CALL POSNAM(NLUPRE,'NAM_DUST_PRE',GFOUND,NLUOUT)
+CALL POSNAM(NLUPRE,'NAM_DUST_PRE',GFOUND)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_DUST_PRE)
!
!
diff --git a/src/ARCH_SRC/bug_pgi/open_nestpgd_files.f90 b/src/ARCH_SRC/bug_pgi/open_nestpgd_files.f90
index dc7e466ef4abd8b692eba85401657477c46d6630..7b19b2eb3bc28943afeda488d414fc893be395b6 100644
--- a/src/ARCH_SRC/bug_pgi/open_nestpgd_files.f90
+++ b/src/ARCH_SRC/bug_pgi/open_nestpgd_files.f90
@@ -251,7 +251,7 @@ END DO
!* 5. NAMES OF OUTPUT PGD FILES
! -------------------------
!
-CALL POSNAM(IPRE_NEST_PGD,'NAM_NEST_PGD',GFOUND,ILUOUT0)
+CALL POSNAM(IPRE_NEST_PGD,'NAM_NEST_PGD',GFOUND)
IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_NEST_PGD)
HNESTPGD(:) = ' '
!
diff --git a/src/LIB/SURCOUCHE/src/modd_var_ll.f90 b/src/LIB/SURCOUCHE/src/modd_var_ll.f90
index cffb275aa3389461dd575d1c32ea877980898af4..3be23f351c721ff1c93cbd428ff4e0e8dcdeaf6e 100644
--- a/src/LIB/SURCOUCHE/src/modd_var_ll.f90
+++ b/src/LIB/SURCOUCHE/src/modd_var_ll.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1999-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1999-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -110,8 +110,6 @@ INTEGER,SAVE :: NZ_PROC_ll = 0 ! Number of proc to use in the Z splitting
! DIMX = NIMAX + 2*JPHEXT ...
!
INTEGER :: DIMX,DIMY,DIMZ
-!
- INTEGER, PARAMETER :: NTMAX = 100
!
! maximum size of 2D and 3D buffers
!
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index 5ed1db232c6ecdba5f40fdf3c74fed0c6d303d30..c024a4390e288c382dda7fe0d2d32f42ad5b711e 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -789,8 +789,6 @@ call Add_field2list( TFIELDDATA( &
CSTDNAME = 'projection_x_coordinate', &
CLONGNAME = 'XHAT_ll', &
CUNITS = 'm', &
-!PW:BUG?: CDIR=XX => correct? variable is NOT distributed (same value on all processes) (see alse YHAT_ll...)
-!PW:BUG?: NGRID=2 => correct? variable is NOT distributed (same value on all processes)
!PW:TODO?: create a new field to say if the variable is distributed? and how (X,Y,XY...)?
CDIR = 'XX', &
CCOMMENT = 'Position x in the conformal or cartesian plane (all domain)', &
@@ -3162,7 +3160,6 @@ call Add_field2list( TFIELDDATA( &
CMNHNAME = 'RTHS_EDDY_FLUX', &
CSTDNAME = '', &
CLONGNAME = 'RTHS_EDDY_FLUX', &
-!TODO PW: units?
CUNITS = '', &
CDIR = 'XY', &
CCOMMENT = '', &
@@ -3187,7 +3184,6 @@ call Add_field2list( TFIELDDATA( &
CMNHNAME = 'RVS_EDDY_FLUX', &
CSTDNAME = '', &
CLONGNAME = 'RVS_EDDY_FLUX', &
-!TODO PW: units?
CUNITS = '', &
CDIR = 'XY', &
CCOMMENT = '', &
@@ -3211,7 +3207,6 @@ call Add_field2list( TFIELDDATA( &
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
IF (TRIM(CPROGRAM)=='REAL' .OR. TRIM(CPROGRAM) == 'LFICDF') THEN
-!PW: not yet known: IF (LFILTERING) THEN
!
call Add_field2list( TFIELDDATA( &
CMNHNAME = 'UT15', &
@@ -3467,9 +3462,6 @@ INTEGER,SAVE :: IFIRSTGUESS=1 !Store first field to test
CHARACTER(LEN=64) :: YMSG
LOGICAL :: GNOWARNING
!
-!PW: TODO: possible optimizations:
-! * Classement alphanumerique + index vers 1er champ commencant par caractere
-! * Classement dans l'ordre des ecritures + stockage dernier hit + reboucler depuis le debut => DONE
!
IF (.NOT.LFIELDLIST_ISINIT) THEN
CALL PRINT_MSG(NVERB_FATAL,'GEN','FIND_FIELD_ID_FROM_MNHNAME','TFIELDLIST not yet initialized')
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index 5a387ac24a205b5977d6801463847c8e880b7ca1..6eed332ee4b291acf9485c31723b3f889631e74e 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -3050,7 +3050,6 @@ end subroutine IO_Ndimlist_reduce
!
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
-!PW: transferer ce traitement LFI dans les subroutines LFI (en creer 1 pour les HFIELD)
IF(GLFI) THEN
ILE=LEN(HFIELD)
IP=SIZE(HFIELD)
@@ -4087,7 +4086,6 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
': CLBTYPE/=NONE not (yet) allowed for 3D real fields' )
- !PW: TODO?: add missing field in TFIELDLIST?
!CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA)
END IF
!
@@ -4107,7 +4105,6 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
': CLBTYPE/=NONE not (yet) allowed for 3D integer fields' )
- !PW: TODO?: add missing field in TFIELDLIST?
!CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_N3D(IMI)%DATA)
END IF
!
@@ -4139,7 +4136,6 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
': CLBTYPE/=NONE not (yet) allowed for 4D real fields' )
- !PW: TODO?: add missing field in TFIELDLIST?
!CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X4D(IMI)%DATA)
END IF
!
@@ -4171,7 +4167,6 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
': CLBTYPE/=NONE not (yet) allowed for 5D real fields' )
- !PW: TODO?: add missing field in TFIELDLIST?
!CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X5D(IMI)%DATA)
END IF
!
@@ -4203,7 +4198,6 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
ELSE
call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
': CLBTYPE/=NONE not (yet) allowed for 6D real fields' )
- !PW: TODO?: add missing field in TFIELDLIST?
!CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X6D(IMI)%DATA)
END IF
!
diff --git a/src/LIB/SURCOUCHE/src/mode_io_file.f90 b/src/LIB/SURCOUCHE/src/mode_io_file.f90
index 663059f07193f44eb708c9ee48604c4460cddd2c..90577037162b814a2e1b1943e5c4206640b06dcc 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_file.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_file.f90
@@ -593,6 +593,7 @@ SELECT CASE(TPFILE%CTYPE)
#ifdef MNH_IOCDF4
!Remark: IO_Coordvar_write_nc4 disabled (for the moment) for Z-split files
! because it introduce a serialization due to MPI communications inside the call
+! WARNING: if uncommented, please modify IO_Coordvar_write_nc4 to enable block concerning gdealloc
! !Write coordinates variables in netCDF file
! IF (TZFILE_IOZ%CMODE == 'WRITE' .AND. (TZFILE_IOZ%CFORMAT=='NETCDF4' .OR. TZFILE_IOZ%CFORMAT=='LFICDF4')) THEN
! CALL IO_Coordvar_write_nc4(TZFILE_IOZ,HPROGRAM_ORIG=HPROGRAM_ORIG)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90 b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
index 3174a29479d4e91b6db75697d80a5e850237eeb2..c3bd1d774d73533d6f45f1fbb2fc1a58dfac9f24 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
@@ -396,7 +396,6 @@ SUBROUTINE IO_SYNC_MODELS_FLOAT(KNUMB,PTIMES)
!Value is rounded to nearest timestep
PTIMES(IMI,JOUT) = NINT(PTIMES(IMI,JOUT)/DYN_MODEL(IMI)%XTSTEP) * DYN_MODEL(IMI)%XTSTEP
!Output/backup time is propagated to nested models (with higher numbers)
- !PW: TODO: BUG?: what happens if 2 dissociated models? Use NSON(:) array?
DO JKLOOP = IMI+1,NMODEL
IDX = 1
CALL FIND_NEXT_AVAIL_SLOT_FLOAT(PTIMES(JKLOOP,:),IDX)
@@ -419,7 +418,6 @@ SUBROUTINE IO_SYNC_MODELS_INT(KNUMB,KSTEPS)
IF (KSTEPS(IMI,JOUT) > 0) THEN
KNUMB = KNUMB + 1
!Output/backup time is propagated to nested models (with higher numbers)
- !PW: TODO: BUG?: what happens if 2 dissociated models? Use NSON(:) array?
DO JKLOOP = IMI+1,NMODEL
IDX = 1
CALL FIND_NEXT_AVAIL_SLOT_INT(KSTEPS(JKLOOP,:),IDX)
@@ -587,7 +585,6 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN,K
CALL PRINT_MSG(NVERB_FATAL,'IO','POPULATE_STRUCT','unknown filetype ('//TRIM(HFILETYPE)//')')
ENDIF
TPBAKOUTN(IPOS)%TFILE%NLFITYPE=1 !1: to be transferred
-!PW: TODO: set NLFIVERB only when useful (only if LFI file...)
TPBAKOUTN(IPOS)%TFILE%NLFIVERB=NVERB
IF (LIOCDF4) THEN
IF (.NOT.LLFIOUT) THEN
@@ -635,7 +632,6 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN,K
TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%NNCCOMPRESS_LEVEL = NOUT_COMPRESS_LEVEL(IMI)
END IF
TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%NLFITYPE=1 !1: to be transferred
-!PW: TODO: set NLFIVERB only when useful (only if LFI file...)
TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%NLFIVERB=NVERB
IF (LIOCDF4) THEN
IF (.NOT.LLFIOUT) THEN
diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
index f91733cddbe8dd78fce9e7f7af08cc3648080449..9559f6b17ca0dcaa3816b5dcb764b2db48b8a678 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
@@ -1612,6 +1612,8 @@ call Write_hor_coord1d( tzdim_ni_v, 'x-dimension of the grid at v location', &
call Write_hor_coord1d( tzdim_nj_v, 'y-dimension of the grid at v location', &
trim(ystdnameprefix)//'_y_coordinate_at_v_location', 'Y', -0.5, jphext, 0, zyhat_glob )
+!Warning: the following block has to be reenabled if IO_Coordvar_write_nc4 is again called for Z-split files
+#if 0
!Deallocate only if it is a non Z-split file or the last Z-split subfile
gdealloc = .false.
if ( Associated( tpfile%tmainfile ) ) then
@@ -1619,6 +1621,9 @@ if ( Associated( tpfile%tmainfile ) ) then
else if ( tpfile%nsubfiles_ioz == 0 .and. .not. Associated( tpfile%tmainfile ) ) then
gdealloc = .true.
end if
+#else
+gdealloc = .true.
+#endif
if ( .not. lcartesian ) then
!Compute latitude/longitude for the Arakawa points
@@ -1939,7 +1944,6 @@ subroutine Gather_hor_coord1d( haxis, pcoords_loc, pcoords_glob )
endif
!If the file has Z-split subfiles, broadcast the coordinates to all processes
- !PW: TODO: broadcast only to subfile writers
if ( tpfile%nsubfiles_ioz > 0 ) &
call MPI_BCAST( pcoords_glob, size( pcoords_glob ), MNHREAL_MPI, tpfile%nmaster_rank - 1, tpfile%nmpicomm, ierr )
@@ -1989,7 +1993,6 @@ subroutine Gather_hor_coord2d( px, py, plat_glob, plon_glob )
endif
!If the file has Z-split subfiles, broadcast the coordinates to all processes
- !PW: TODO: broadcast only to subfile writers
if ( tpfile%nsubfiles_ioz > 0 ) then
call MPI_BCAST( plat_glob, size( plat_glob ), MNHREAL_MPI, tpfile%nmaster_rank - 1, tpfile%nmpicomm, ierr )
call MPI_BCAST( plon_glob, size( plon_glob ), MNHREAL_MPI, tpfile%nmaster_rank - 1, tpfile%nmpicomm, ierr )
@@ -2298,7 +2301,9 @@ subroutine Write_flyer_time_coord( tpflyer )
type(tdimnc), pointer :: tzdim
!Do it only if correct model level and has really flown
- if ( tpflyer%nmodel == imi .and. Count( tpflyer%xx /= XUNDEF) > 1 ) then
+ if ( tpflyer%nmodel == imi ) then
+ ! Do the second if only if the first one is OK (if not, xx may be not allocated)
+ if ( Count( tpflyer%xx /= XUNDEF) > 1 ) then
Allocate( tzdim )
istatus = NF90_INQ_NCID( tpfile%nncid, 'Flyers', icatid )
@@ -2315,16 +2320,16 @@ subroutine Write_flyer_time_coord( tpflyer )
Trim( tpfile%cname ) // ': group ' // Trim( ytype_clean ) // ' not found' )
end if
- istatus = NF90_INQ_NCID( isubcatid, Trim( tpflyer%ctitle ), incid )
+ istatus = NF90_INQ_NCID( isubcatid, Trim( tpflyer%cname ), incid )
if ( istatus /= NF90_NOERR ) then
call Print_msg( NVERB_ERROR, 'IO', 'Write_flyer_time_coord', &
- Trim( tpfile%cname ) // ': group '// Trim( tpflyer%ctitle ) // ' not found' )
+ Trim( tpfile%cname ) // ': group '// Trim( tpflyer%cname ) // ' not found' )
end if
istatus = NF90_INQ_DIMID( incid, 'time_flyer', idimid )
if ( istatus /= NF90_NOERR ) then
call Print_msg( NVERB_ERROR, 'IO', 'Write_flyer_time_coord', &
- Trim( tpfile%cname ) // ': group ' // Trim( tpflyer%ctitle ) // ' time_flyer dimension not found' )
+ Trim( tpfile%cname ) // ': group ' // Trim( tpflyer%cname ) // ' time_flyer dimension not found' )
end if
tzdim%cname = 'time_flyer'
@@ -2339,6 +2344,7 @@ subroutine Write_flyer_time_coord( tpflyer )
!Restore file identifier to root group
incid = tpfile%nncid
end if
+ end if
end subroutine Write_flyer_time_coord
diff --git a/src/LIB/SURCOUCHE/src/mode_msg.f90 b/src/LIB/SURCOUCHE/src/mode_msg.f90
index ac78920fae6da2b112c7c296f9a9d30829c4b6e6..272868b6c9cf23ed78181077ecacf7617724abbd 100644
--- a/src/LIB/SURCOUCHE/src/mode_msg.f90
+++ b/src/LIB/SURCOUCHE/src/mode_msg.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2017-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2017-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -65,7 +65,7 @@ subroutine Print_msg_multi_cmnhmsg( kverb, hdomain, hsubr, olocal )
ilines = ilines - 1
end do
- call Print_msg_multi( kverb, hdomain, hsubr, cmnhmsg(1 : ilines) )
+ call Print_msg_multi( kverb, hdomain, hsubr, cmnhmsg(1 : ilines), olocal )
!Empty the message buffer
!This is necessary especially if the next call contain a shorter message
@@ -129,7 +129,6 @@ IF (ASSOCIATED(TFILE_OUTPUTLISTING)) THEN
IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'TFILE_OUTPUTLISTING not opened'
END IF
ELSE
-!PW: TODO?: temporary to detect non-initialisation
! should disappear except at the beginning of a run
GWRITE_OUTLST = .FALSE.
IF (GWRITE_STDOUT .AND. CPROGRAM/='LFICDF') WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'TFILE_OUTPUTLISTING not associated'
diff --git a/src/MNH/aer_clim_surf.f90 b/src/MNH/aer_clim_surf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fc6af75afd9161afa3aa13837be8b4c9b700e258
--- /dev/null
+++ b/src/MNH/aer_clim_surf.f90
@@ -0,0 +1,182 @@
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_AER_CLIM_SURF
+! ##########################
+!
+INTERFACE
+!
+ SUBROUTINE AER_CLIM_SURF( PLAT, PLON, PAESEA, PAELAN, PAEURB, PAEDES )
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON ! arrays of latitude-longitude
+!
+REAL, DIMENSION (:), INTENT(OUT) :: PAESEA, PAELAN, PAEURB, PAEDES
+!
+END SUBROUTINE AER_CLIM_SURF
+!
+END INTERFACE
+!
+END MODULE MODI_AER_CLIM_SURF
+!
+!
+! ###################################################################
+ SUBROUTINE AER_CLIM_SURF(PLAT, PLON, PAESEA, PAELAN, PAEURB, PAEDES )
+! ###################################################################
+!
+!!**** *INI_RADIATIONS * - initialisation for ECMWF radiation scheme in the MesoNH framework
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson : extract the Aerosol initialization by surface types from ini_radiation_ecmwf.f90 routine
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 03/2023
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!MESO-NH modules
+!
+USE MODE_ll
+USE MODD_CONF, ONLY : LCARTESIAN
+USE MODD_PARAM_n, ONLY : CSURF
+!
+USE MODI_MNHGET_SURF_PARAM_n
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON ! arrays of latitude-longitude
+!
+REAL, DIMENSION (:), INTENT(OUT) :: PAESEA, PAELAN, PAEURB, PAEDES
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JI, JJ, IIJ ! loop index
+!
+INTEGER :: IIB ! I index value of the first inner mass point
+INTEGER :: IJB ! J index value of the first inner mass point
+INTEGER :: IIE ! I index value of the last inner mass point
+INTEGER :: IJE ! J index value of the last inner mass point
+INTEGER :: IIU ! array size for the first index
+INTEGER :: IJU ! array size for the second index
+!
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZLON ! longitude
+!
+! Variables for aerosols and ozone climatologies set up
+LOGICAL, DIMENSION (:,:),ALLOCATABLE :: GAFRICA, GASIA, GAUSTRALIA
+REAL, DIMENSION (:,:), ALLOCATABLE :: ZDESERT ! desert fraction
+REAL, DIMENSION (:,:), ALLOCATABLE :: ZSEA ! sea fraction
+REAL, DIMENSION (:,:), ALLOCATABLE :: ZTOWN ! town fraction
+REAL, DIMENSION (:,:), ALLOCATABLE :: ZBARE ! bare soil fraction
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+!* 0.1 INITIALIZATIONS
+!
+!
+!* 0.2 COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
+!
+CALL GET_DIM_EXT_ll ('B',IIU,IJU)
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. INITIALIZES THE ECMWF RADIATION PACKAGE
+! ------------------------------------------------
+!
+! AEROSOLS from SURFACE FRACTIONS
+!
+ !* deserts are only considered over Africa, southern Asia, Australia
+ !* longitude between -180 and 180 for geographical tests
+ ! Only bare soil fractions larger than 0.5 are supposed to contribute to
+ ! desert aerosols
+ !
+ ALLOCATE(ZSEA (IIU,IJU))
+ ALLOCATE(ZTOWN (IIU,IJU))
+ ALLOCATE(ZBARE (IIU,IJU))
+ IF (CSURF=='EXTE') THEN
+ CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
+ ELSE
+ ZSEA (:,:) = 1.
+ ZTOWN(:,:) = 0.
+ ZBARE(:,:) = 0.
+ END IF
+
+
+ ALLOCATE(ZDESERT (IIU,IJU))
+ ZDESERT(:,:) = 0.
+
+ IF (.NOT.LCARTESIAN) THEN
+ !* deserts are only considered over Africa, southern Asia, Australia
+ ALLOCATE(ZLON (IIU,IJU))
+ ALLOCATE(GAFRICA (IIU,IJU))
+ ALLOCATE(GASIA (IIU,IJU))
+ ALLOCATE(GAUSTRALIA(IIU,IJU))
+ !* longitude between -180 and 180 for geographical tests
+ ZLON = PLON(:,:) - NINT(PLON/360.)*360.
+ GAFRICA (:,:) = PLAT(:,:) > -36.086389 .AND. PLAT(:,:) < 36.010556 &
+ .AND. ZLON(:,:) > -73.18 .AND. ZLON(:,:) < 34.158611
+ GASIA (:,:) = PLAT(:,:) > 4.358056 .AND. PLAT(:,:) < 55.335278 &
+ .AND. ZLON(:,:) > -123.157778 .AND. ZLON(:,:) <-34.285556
+ GAUSTRALIA(:,:) = PLAT(:,:) > -39.561389 .AND. PLAT(:,:) < -10.251667 &
+ .AND. ZLON(:,:) > -155.041944 .AND. ZLON(:,:) < -111.405556
+ !
+ ! Only bare soil fractions larger than 0.5 are supposed to contribute to
+ ! desert aerosols
+ !
+ WHERE (GAFRICA(:,:) .OR. GASIA(:,:) .OR. GAUSTRALIA(:,:)) &
+ ZDESERT(:,:) = MAX( 2.*(ZBARE(:,:)-0.5) , 0.)
+ !
+ !
+ ELSE
+ !
+ ZDESERT(:,:) = MAX( 2.*(ZBARE(:,:)-0.5) , 0.)
+ !
+ ENDIF
+ !
+ !* fills sea, town, desert and land surface covers for aerosols distributions
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ PAESEA(IIJ) = ZSEA(JI,JJ)
+ PAEURB(IIJ) = ZTOWN(JI,JJ)
+ PAEDES(IIJ) = ZDESERT(JI,JJ)
+ PAELAN(IIJ) = MAX( 1.- PAESEA(IIJ) - PAEURB(IIJ) - PAEDES(IIJ) , 0.)
+ END DO
+ END DO
+ IF (ALLOCATED(ZLON)) DEALLOCATE(ZLON)
+ IF (ALLOCATED(GAFRICA)) DEALLOCATE(GAFRICA)
+ IF (ALLOCATED(GASIA)) DEALLOCATE(GASIA)
+ IF (ALLOCATED(GAUSTRALIA)) DEALLOCATE(GAUSTRALIA)
+ IF (ALLOCATED(ZDESERT)) DEALLOCATE(ZDESERT)
+
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE AER_CLIM_SURF
diff --git a/src/MNH/aer_monitorn.f90 b/src/MNH/aer_monitorn.f90
index 22d5f69a9b8e052d1f28a46fe8a2d524a9e5913c..ec800306eab3ece233568cc174bb489d21e5799f 100644
--- a/src/MNH/aer_monitorn.f90
+++ b/src/MNH/aer_monitorn.f90
@@ -347,8 +347,6 @@ SELECT CASE (CCLOUD)
XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,2), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,3), &
- ZRCS(IIB:IIE,IJB:IJE,IKB:IKE), &
- ZRRS(IIB:IIE,IJB:IJE,IKB:IKE), &
ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
XTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
XPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
@@ -366,8 +364,6 @@ SELECT CASE (CCLOUD)
XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,2), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,3), &
- ZRCS(IIB:IIE,IJB:IJE,IKB:IKE), &
- ZRRS(IIB:IIE,IJB:IJE,IKB:IKE), &
ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
XTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
XPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
@@ -385,8 +381,6 @@ CASE ('LIMA')
XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,2), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,3), &
- ZRCS(IIB:IIE,IJB:IJE,IKB:IKE), &
- ZRRS(IIB:IIE,IJB:IJE,IKB:IKE), &
ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
XTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
XPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
@@ -537,8 +531,6 @@ SELECT CASE (CCLOUD)
XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,2), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,3), &
- ZRCS(IIB:IIE,IJB:IJE,IKB:IKE), &
- ZRRS(IIB:IIE,IJB:IJE,IKB:IKE), &
ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
XTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
XPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
@@ -556,8 +548,6 @@ SELECT CASE (CCLOUD)
XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,2), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,3), &
- ZRCS(IIB:IIE,IJB:IJE,IKB:IKE), &
- ZRRS(IIB:IIE,IJB:IJE,IKB:IKE), &
ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
XTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
XPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
@@ -574,8 +564,6 @@ SELECT CASE (CCLOUD)
XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,2), &
XRT(IIB:IIE,IJB:IJE,IKB:IKE,3), &
- ZRCS(IIB:IIE,IJB:IJE,IKB:IKE), &
- ZRRS(IIB:IIE,IJB:IJE,IKB:IKE), &
ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
XTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
XPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
diff --git a/src/MNH/aer_wet_dep_kmt_warm.f90 b/src/MNH/aer_wet_dep_kmt_warm.f90
index 40083c0c1e3c9336156114b3148db8d5f8f99354..d0ebbdfff6edd447323c9d85a65c73b6aad43aef 100644
--- a/src/MNH/aer_wet_dep_kmt_warm.f90
+++ b/src/MNH/aer_wet_dep_kmt_warm.f90
@@ -12,7 +12,7 @@ INTERFACE
!!
SUBROUTINE AER_WET_DEP_KMT_WARM(KSPLITR, PTSTEP, PZZ, PRHODREF, &
PRCT, PRRT, &
- PRCS, PRRS, PSVT, PTHT, &
+ PSVT, PTHT, &
PPABST, PRGAER, PEVAP3D, KMODE, &
PDENSITY_AER, PMASSMIN, PSEA, PTOWN, &
PCCT, PCRT )
@@ -30,8 +30,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Tracer m.r. at t
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! Cloud water conc derived from source term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water conc derifed from source term
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEVAP3D ! Instantaneous 3D Rain Evaporation flux (KG/KG/S)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !Potential temp
@@ -53,7 +51,7 @@ END MODULE MODI_AER_WET_DEP_KMT_WARM
! ###############################################################
SUBROUTINE AER_WET_DEP_KMT_WARM (KSPLITR, PTSTEP, PZZ, &
PRHODREF, PRCT, PRRT, &
- PRCS, PRRS, PSVT, PTHT, &
+ PSVT, PTHT, &
PPABST, PRGAER, PEVAP3D, KMODE, &
PDENSITY_AER, PMASSMIN, PSEA, PTOWN, &
PCCT, PCRT )
@@ -123,14 +121,16 @@ END MODULE MODI_AER_WET_DEP_KMT_WARM
! ------------
!
USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
+USE MODD_RAIN_ICE_PARAM, ONLY : YEXCACCR=>XEXCACCR, XFSEDC, XFCACCR,&
+ XEXSEDR, XCRIAUTC, XFSEDR, XTIMAUTC,&
+ YFCACCR => XFCACCR
!++th++ 10/05/17
USE MODD_RAIN_ICE_DESCR, ONLY : YRTMIN => XRTMIN, YCEXVT => XCEXVT, &
XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
XNUC2, XALPHAC2, XNUC, XALPHAC, &
YLBC => XLBC, XLBEXC, &
XCCR, &
- YLBR => XLBR, YLBEXR => XLBEXR
+ YLBR => XLBR, YLBEXR => XLBEXR
!--th--
USE MODD_PRECIP_n
USE MODI_AER_VELGRAV
@@ -145,7 +145,8 @@ USE MODD_PARAM_LIMA_WARM, ONLY : WLBR => XLBR, WLBEXR => XLBEXR, & ! fo
WLBC => XLBC, &
XACCR1, XACCR2, XACCR3, XACCR4, XACCR5, & ! for
XACCR_RLARGE1, XACCR_RLARGE2, & ! accr.
- XACCR_RSMALL1, XACCR_RSMALL2
+ XACCR_RSMALL1, XACCR_RSMALL2, &
+ WEXCACCR=>XEXCACCR, WFCACCR=>XFCACCR
USE MODD_PARAM_n, ONLY: CCLOUD
!--th--
@@ -165,8 +166,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Tracer m.r. at t
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! Cloud water m.r. from source term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. from source term
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEVAP3D ! Instantaneous 3D Rain Evaporation flux (KG/KG/S)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Potential temp
@@ -263,7 +262,7 @@ INTEGER :: IKE
REAL, DIMENSION(:), ALLOCATABLE :: KRTMIN
REAL :: KCEXVT, KLBR, KLBEXR, KLBC, ZLBEXC
REAL, DIMENSION(2) :: ZXLBC
-REAL :: ZEXSEDR, ZDR
+REAL :: ZEXSEDR, ZDR, ZEXCACCR, ZFCACCR
!
!-------------------------------------------------------------------------------
!
@@ -282,6 +281,8 @@ CASE('ICE3')
KLBEXR = YLBEXR
ZXLBC(:) = YLBC(:)
ZLBEXC = XLBEXC
+ ZEXCACCR = YEXCACCR
+ ZFCACCR = YFCACCR
CASE('LIMA')
ALLOCATE(KRTMIN(SIZE(WRTMIN)))
KRTMIN = WRTMIN
@@ -291,6 +292,8 @@ CASE('LIMA')
KLBC = WLBC
ZLBEXC = 1.0 / 3.0
ZDR = 0.8
+ ZEXCACCR = WEXCACCR
+ ZFCACCR = WFCACCR
END SELECT
!--cb--
!
@@ -361,9 +364,7 @@ CALL AER_WET_DEP_KMT_ICE_WARM
!
CALL AER_WET_DEP_KMT_EVAP
!
-!++cb++
DEALLOCATE(KRTMIN)
-!--cb--
!
!-------------------------------------------------------------------------------
!
@@ -396,12 +397,10 @@ INTEGER :: JKAQ ! counter for chemistry
GCLOUD(:,:,:) = .FALSE.
!
IF (PRESENT(PCCT)) THEN ! case KHKO, C2R2, C3R5, LIMA (2-moment schemes)
- GCLOUD(:,:,:) = PRCS(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2)
+ GCLOUD(:,:,:) = PRCT(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2)
ELSE ! Case ICE3, REVE, KESS, ... (1-moment schemes)
- GCLOUD(:,:,:) = PRCS(:,:,:) > KRTMIN(2)
+ GCLOUD(:,:,:) = PRCT(:,:,:) > KRTMIN(2)
END IF
-!--cb--
-!--th--
ICLOUD = COUNTJV( GCLOUD(:,:,:),I1C(:),I2C(:),I3C(:))
IF( ICLOUD >= 1 ) THEN
@@ -437,7 +436,7 @@ IF( ICLOUD >= 1 ) THEN
ZTHT(JL) = PTHT(I1C(JL),I2C(JL),I3C(JL))
ZRC(JL) = ZRAY(I1C(JL),I2C(JL),I3C(JL))
ZPABST(JL) = PPABST(I1C(JL),I2C(JL),I3C(JL))
- ZRCT(JL) = PRCS(I1C(JL),I2C(JL),I3C(JL))
+ ZRCT(JL) = PRCT(I1C(JL),I2C(JL),I3C(JL))
ZRHODREF(JL) = PRHODREF(I1C(JL),I2C(JL),I3C(JL))
ZMASSMIN(JL,:) = PMASSMIN(I1C(JL),I2C(JL),I3C(JL),:)
ZWLBDC(JL) = ZLBC(I1C(JL),I2C(JL),I3C(JL))
@@ -711,7 +710,7 @@ DO JN = 1 , KSPLITR
ZSVT(JL,KMODE*2+JKAQ) = PSVT(IR1(JL),IR2(JL),IR3(JL),KMODE*2+JKAQ)
END DO
!
- IF (PRESENT(PCRT)) ZCRT(JL) = PCRT(IR1(JL),IR2(JL),IR2(JL))
+ IF (PRESENT(PCRT)) ZCRT(JL) = PCRT(IR1(JL),IR2(JL),IR3(JL))
ZRRT(JL) = PRRT(IR1(JL),IR2(JL),IR3(JL))
ZRHODREF(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
ENDDO
@@ -803,10 +802,12 @@ ZZRCT(:,:,:) = MAX(ZZRCT(:,:,:), KRTMIN(2)/2.)
IF (PRESENT(PCRT)) THEN ! 2-moment schemes
!
! from lima_warm_coal.f90 (AUTO)
- ZLBDC3(:,:,:) = XMNH_HUGE
+ ZLBDC3(:,:,:) = 1E40
+ ! ZLBDC3(:,:,:) = XMNH_HUGE
ZLBDC(:,:,:) = 1.E15
WHERE (ZZRCT(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2))
- ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / PRCT(:,:,:)
+ ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / ZZRCT(:,:,:)
+ ! ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / PRCT(:,:,:)
ZLBDC(:,:,:) = ZLBDC3(:,:,:)**ZLBEXC
END WHERE
!
@@ -814,14 +815,14 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
WHERE (ZZRCT(:,:,:) > KRTMIN(2))
ZZW3(:,:,:) = MAX(0.0, XLAUTR*PRHODREF(:,:,:)*ZZRCT(:,:,:)* &
(XAUTO1/ZLBDC3(:,:,:)**4-XLAUTR_THRESHOLD)) ! L
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), MAX(0.0, XITAUTR*ZZW3(:,:,:)*ZZRCT(:,:,:)* &
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), MAX(0.0, XITAUTR*ZZW3(:,:,:)*ZZRCT(:,:,:)* &
(XAUTO2/ZLBDC3(:,:,:)-XITAUTR_THRESHOLD))) ! L/tau
END WHERE
!
ELSE ! 1-moment scheme
!
- WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRCS(:,:,:) > 0.0))
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XTIMAUTC* &
+ WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRCT(:,:,:) > 0.0))
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), XTIMAUTC* &
MAX((ZZRCT(:,:,:)-XCRIAUTC/PRHODREF(:,:,:)), 0.0))
END WHERE
!
@@ -853,12 +854,14 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
! from lima_warm_coal.f90 (ACCR)
ZLBDR3(:,:,:) = 1.E30
ZLBDR(:,:,:) = 1.E10
+
+
WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3))
ZLBDAR(:,:,:) = KLBR * (PRHODREF(:,:,:) * PRRT(:,:,:))**KLBEXR
ZLBDR3(:,:,:) = KLBR * PCRT(:,:,:) / PRRT(:,:,:)
ZLBDR(:,:,:) = ZLBDR3(:,:,:)**KLBEXR
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XFCACCR * ZZRCT(:,:,:) &
- * ZLBDAR(:,:,:)**XEXCACCR &
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), ZFCACCR * ZZRCT(:,:,:) &
+ * ZLBDAR(:,:,:)**ZEXCACCR &
* PRHODREF(:,:,:)**(-KCEXVT) )
ZDIM(:,:,:) = XACCR1 / ZLBDAR(:,:,:)
END WHERE
@@ -871,7 +874,7 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
ZZW5(:,:,:) = ZLBDC3(:,:,:) / ZLBDR3(:,:,:)
ZZW1(:,:,:) = (PCCT(:,:,:) * PCRT(:,:,:) / ZLBDC3(:,:,:)**2) * PRHODREF(:,:,:)
ZZW4(:,:,:) = MIN(ZZW1(:,:,:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW5(:,:,:)), &
- PRCS(:,:,:))
+ PRCT(:,:,:))
END WHERE
! Accretion for D < 100 10-6 m
WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3) .AND. &
@@ -881,17 +884,17 @@ IF (PRESENT(PCRT)) THEN ! 2-moment schemes
ZZW5(:,:,:) = (ZLBDC3(:,:,:) / ZLBDR3(:,:,:))**2
ZZW1(:,:,:) = (PCCT(:,:,:) * PCRT(:,:,:) / ZLBDC3(:,:,:)**3) * PRHODREF(:,:,:)
ZZW4(:,:,:) = MIN(ZZW1(:,:,:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW5(:,:,:)), &
- PRCS(:,:,:))
+ PRCT(:,:,:))
END WHERE
!
ELSE ! 1-moment schemes
!
ZLBDR(:,:,:) = 0.0
WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRRT(:,:,:) > KRTMIN(3)) &
- .AND. (PRCS(:,:,:) > 0.0))
+ .AND. (PRCT(:,:,:) > 0.0))
ZLBDR(:,:,:) = KLBR * (PRHODREF(:,:,:) * PRRT(:,:,:))**KLBEXR
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XFCACCR * ZZRCT(:,:,:) &
- * ZLBDR(:,:,:)**XEXCACCR &
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), ZFCACCR * ZZRCT(:,:,:) &
+ * ZLBDR(:,:,:)**ZEXCACCR &
* PRHODREF(:,:,:)**(-KCEXVT) )
END WHERE
END IF
@@ -960,7 +963,7 @@ ZWEVAP(:,:,:) = MAX(ZWEVAP(:,:,:), 0.0)
! no partial cloud evaporation at this stage
!
ZMASK(:,:,:) = 0.
-WHERE(PRCS(:,:,:) .LT. KRTMIN(2))
+WHERE(PRCT(:,:,:) .LT. KRTMIN(2))
ZMASK(:,:,:) = 1.
END WHERE
!
diff --git a/src/MNH/aerocamsn.f90 b/src/MNH/aerocamsn.f90
index b3ceb1d48989bf77722b0996b3845d3735e14c80..3b7dc1cd7e87b856e1ff4401412e68b43ee00074 100644
--- a/src/MNH/aerocamsn.f90
+++ b/src/MNH/aerocamsn.f90
@@ -52,6 +52,7 @@ END MODULE MODI_AEROCAMS_n
!!
USE MODE_AERO_PSD
+USE MODD_CH_AEROSOL
!!
IMPLICIT NONE
!!
@@ -72,7 +73,14 @@ INTEGER :: JN
DO JN =1,SIZE(PSV, 4)
PSV(:,:,:,JN) = PSV(:,:,:,JN) * 1E9 / PRHODREF(:,:,:)
+ !print*, CAERONAMES(JN),' =',MINVAL(PSV(:,:,:,JN)), MAXVAL(PSV(:,:,:,JN))
ENDDO
+PSV(:,:,:,JP_CH_BCi) = MAX(PSV(:,:,:,JP_CH_BCi), 1E-4)
+PSV(:,:,:,JP_CH_BCj) = MAX(PSV(:,:,:,JP_CH_BCj), 1E-3)
+PSV(:,:,:,JP_CH_OCi) = MAX(PSV(:,:,:,JP_CH_OCi), 1E-4)
+PSV(:,:,:,JP_CH_OCj) = MAX(PSV(:,:,:,JP_CH_OCj), 1E-3)
+PSV(:,:,:,JP_CH_DSTi) = MAX(PSV(:,:,:,JP_CH_DSTi), 1E-4)
+PSV(:,:,:,JP_CH_DSTj) = MAX(PSV(:,:,:,JP_CH_DSTj), 1E-3)
! Compute moment from aerosol mass and conversion SV aerosols variables into ppv
diff --git a/src/MNH/aeroopt_get.f90 b/src/MNH/aeroopt_get.f90
index d8ec58193f7c308daba8bf8ad069ab21f2e7a976..994608c3da4bbb2bcab4f8ad5382131f9e67adc8 100644
--- a/src/MNH/aeroopt_get.f90
+++ b/src/MNH/aeroopt_get.f90
@@ -132,8 +132,9 @@
REAL, DIMENSION(size(ZMASS,1),size(ZMASS,2),size(ZMASS,3)) :: VEXTR
COMPLEX, DIMENSION(size(ZMASS,1),size(ZMASS,2),size(ZMASS,3),6)::Req ! Equivalent refractive index
REAL, PARAMETER :: EPSILON=1.d-8 ![um] a small number used to avoid zero
-
- INTEGER ::JJJ, JI, JSV
+ REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC
+ REAL,DIMENSION(NSP+NCARB+NSOA) :: ZRHOI
+ INTEGER ::JJJ, JI, JSV, JJ
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
@@ -212,25 +213,33 @@ NMODE_AER=JPMODE ! in case of ORILAM
! VDDST(:,:,:)=0.
! ENDIF
-
- VOC(:,:,:)=(ZMASS(:,:,:,JP_AER_OC,JMDE))/XFAC(JP_AER_OC)
- VH2O(:,:,:)=(ZMASS(:,:,:,JP_AER_H2O,JMDE))/XFAC(JP_AER_H2O)
- VAM(:,:,:)=(ZMASS(:,:,:,JP_AER_NH3,JMDE))/XFAC(JP_AER_NH3)
- VSU(:,:,:)=(ZMASS(:,:,:,JP_AER_SO4,JMDE))/XFAC(JP_AER_SO4)
- VNI(:,:,:)=(ZMASS(:,:,:,JP_AER_NO3,JMDE))/XFAC(JP_AER_NO3)
- VBC(:,:,:)=(ZMASS(:,:,:,JP_AER_BC,JMDE))/XFAC(JP_AER_BC)
- VDDST(:,:,:)=(ZMASS(:,:,:,JP_AER_DST,JMDE))/XFAC(JP_AER_DST)
+! Cf Ackermann (all to black carbon except water)
+!Set molecular weightn g/mol
+ZRHOI(:) = 1.8e3
+ZRHOI(JP_AER_H2O) = 1.0e3 ! water
+ZRHOI(JP_AER_DST) = XDENSITY_DUST ! dusts
+DO JJ=1,NSP+NCARB+NSOA
+ ZFAC(JJ)=(4./3.)*XPI*ZRHOI(JJ)*1.e-9
+ENDDO
+
+ VOC(:,:,:)=(ZMASS(:,:,:,JP_AER_OC,JMDE))/ZFAC(JP_AER_OC)
+ VH2O(:,:,:)=(ZMASS(:,:,:,JP_AER_H2O,JMDE))/ZFAC(JP_AER_H2O)
+ VAM(:,:,:)=(ZMASS(:,:,:,JP_AER_NH3,JMDE))/ZFAC(JP_AER_NH3)
+ VSU(:,:,:)=(ZMASS(:,:,:,JP_AER_SO4,JMDE))/ZFAC(JP_AER_SO4)
+ VNI(:,:,:)=(ZMASS(:,:,:,JP_AER_NO3,JMDE))/ZFAC(JP_AER_NO3)
+ VBC(:,:,:)=(ZMASS(:,:,:,JP_AER_BC,JMDE))/ZFAC(JP_AER_BC)
+ VDDST(:,:,:)=(ZMASS(:,:,:,JP_AER_DST,JMDE))/ZFAC(JP_AER_DST)
IF (NSOA .EQ. 10) THEN
- VSOA1(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA1,JMDE))/XFAC(JP_AER_SOA1)
- VSOA2(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA2,JMDE))/XFAC(JP_AER_SOA2)
- VSOA3(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA3,JMDE))/XFAC(JP_AER_SOA3)
- VSOA4(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA4,JMDE))/XFAC(JP_AER_SOA4)
- VSOA5(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA5,JMDE))/XFAC(JP_AER_SOA5)
- VSOA6(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA6,JMDE))/XFAC(JP_AER_SOA6)
- VSOA7(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA7,JMDE))/XFAC(JP_AER_SOA7)
- VSOA8(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA8,JMDE))/XFAC(JP_AER_SOA8)
- VSOA9(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA9,JMDE))/XFAC(JP_AER_SOA9)
- VSOA10(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA10,JMDE))/XFAC(JP_AER_SOA10)
+ VSOA1(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA1,JMDE))/ZFAC(JP_AER_SOA1)
+ VSOA2(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA2,JMDE))/ZFAC(JP_AER_SOA2)
+ VSOA3(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA3,JMDE))/ZFAC(JP_AER_SOA3)
+ VSOA4(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA4,JMDE))/ZFAC(JP_AER_SOA4)
+ VSOA5(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA5,JMDE))/ZFAC(JP_AER_SOA5)
+ VSOA6(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA6,JMDE))/ZFAC(JP_AER_SOA6)
+ VSOA7(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA7,JMDE))/ZFAC(JP_AER_SOA7)
+ VSOA8(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA8,JMDE))/ZFAC(JP_AER_SOA8)
+ VSOA9(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA9,JMDE))/ZFAC(JP_AER_SOA9)
+ VSOA10(:,:,:)=(ZMASS(:,:,:,JP_AER_SOA10,JMDE))/ZFAC(JP_AER_SOA10)
VSOA(:,:,:)=VSOA1(:,:,:)+VSOA2(:,:,:)+VSOA3(:,:,:)+VSOA4(:,:,:)+&
VSOA5(:,:,:)+VSOA6(:,:,:)+VSOA7(:,:,:)+VSOA8(:,:,:)+&
VSOA9(:,:,:)+VSOA10(:,:,:)
diff --git a/src/MNH/aerozon.f90 b/src/MNH/aerozon.f90
index b2e6b6c9f9ee75dcde79d6a0e985c75c1a35b0d8..899da024a9c03abead81a9be0afbd17cf4848c02 100644
--- a/src/MNH/aerozon.f90
+++ b/src/MNH/aerozon.f90
@@ -167,6 +167,7 @@ USE MODE_ll
USE MODI_SHUMAN
USE MODI_INI_RADCONF
USE MODI_INI_HOR_AERCLIM
+USE MODI_AER_CLIM_SURF
USE MODI_SUECOZC
USE MODI_RADOZC
USE MODI_SUAERV
@@ -232,7 +233,7 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZEXNT ! Exner functio
!
! Variables for aerosols and ozone climatologies set up
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZPAVE, ZWORK_GRID
+REAL, DIMENSION (:,:), ALLOCATABLE :: ZWORK_GRID
REAL, DIMENSION (:), ALLOCATABLE :: ZAESEA, ZAELAN, ZAEURB, ZAEDES
!
REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZT_HL
@@ -326,7 +327,6 @@ PCORSOL = 1.00011+0.034221*COS(ZAD) +0.001280*SIN(ZAD) &
!* 8.1 set up for grid dependant quantitites (from initial state)
!
ALLOCATE (ZPRES_HL(KDLON,KFLEV+1))
-ALLOCATE (ZPAVE(KDLON,KFLEV))
ALLOCATE (ZETAH(KDLON,KFLEV+1))
ALLOCATE (ZT_HL(KDLON,KFLEV+1))
ALLOCATE (ZGEMU(KDLON))
@@ -381,10 +381,6 @@ DO JKRAD=1, KFLEV+1
END DO
DEALLOCATE(ZWORK_GRID)
!
-DO JKRAD=1,KFLEV
- ZPAVE(:,JKRAD)=0.5*(ZPRES_HL(:,JKRAD)+ZPRES_HL(:,JKRAD+1))
-END DO
-!
!coo geographique
!
IF(.NOT.LCARTESIAN) THEN
@@ -440,11 +436,16 @@ IF(HAER /= 'NONE') THEN
!
! AEROSOLS ECMWF climatologies
!
- IF ( HAER == 'TEGE' ) THEN
+ IF ( HAER == 'TEGE' .OR. HAER=='TANR' ) THEN
CALL INI_HOR_AERCLIM (HAER,IIB,IIE,IJB,IJE,KDLON,ZYMD,ZHOURS, &
PLAT,PLON,ZAESEA,ZAELAN,ZAEURB,ZAEDES )
END IF
+ !
+ IF( HAER =='SURF') THEN
!
+ CALL AER_CLIM_SURF(PLAT, PLON, ZAESEA, ZAELAN, ZAEURB, ZAEDES )
+ END IF
+ !
!
! 8.3.2 vertical ditributions (standard profiles derived from Tanre)
!
@@ -468,6 +469,18 @@ IF(HAER /= 'NONE') THEN
! modification of initial ECMWF maximum optical thickness
! for aerosols classes in case of HAER=SURF
! note : these variables belongs to yoeaerd module
+!
+! modification of initial ECMWF maximum optical thickness
+! for aerosols classes in case of HAER=SURF
+! note : these variables belongs to yoeaerd module
+!
+ IF ( HAER =='SURF') THEN
+ RCAEOPS = 0.001 ! Sea instead 0.02 to agree with TEGEN
+ RCAEOPL = 0.05 ! Land (continental)
+ RCAEOPU = 0.3 ! Urban zone
+ RCAEOPD = 0.5 ! Desert
+ END IF
+
!
! final aerosol profiles on mnh grid
!
@@ -516,9 +529,7 @@ DO JJ=IJB,IJE
END DO
!
!
-!
DEALLOCATE (ZPRES_HL)
-DEALLOCATE (ZPAVE)
DEALLOCATE (ZT_HL)
DEALLOCATE (ZETAH)
DEALLOCATE (ZGEMU)
diff --git a/src/MNH/aircraft_balloon.f90 b/src/MNH/aircraft_balloon.f90
index 2d58999df0e449a194c7fafb503b842cb405d63c..6af5edcf4611a9706b64fddc4499ebfdf73f4080 100644
--- a/src/MNH/aircraft_balloon.f90
+++ b/src/MNH/aircraft_balloon.f90
@@ -25,20 +25,6 @@ PUBLIC :: AIRCRAFT_BALLOON
PUBLIC :: AIRCRAFT_BALLOON_LONGTYPE_GET
-PUBLIC :: FLYER_RECV_AND_ALLOCATE, FLYER_SEND
-
-INTEGER, PARAMETER :: NTAG_NCUR = 145
-INTEGER, PARAMETER :: NTAG_PACK = 245
-
-INTEGER, PARAMETER :: NMODEL_FIX = 1
-INTEGER, PARAMETER :: NMODEL_MOB = 2
-
-INTEGER, PARAMETER :: NTYPE_AIRCRA = 0
-INTEGER, PARAMETER :: NTYPE_CVBALL = 1
-INTEGER, PARAMETER :: NTYPE_ISODEN = 2
-INTEGER, PARAMETER :: NTYPE_RADIOS = 4
-
-
CONTAINS
!
! #################################################################
@@ -212,13 +198,13 @@ DEALLOCATE( IRANKNXT_AIRCRAFT_TMP )
DO JI = 1, NAIRCRAFTS
IF ( NRANKNXT_AIRCRAFT(JI) /= NRANKCUR_AIRCRAFT(JI) ) THEN
IF ( ISP == NRANKCUR_AIRCRAFT(JI) ) THEN
- CALL FLYER_SEND_AND_DEALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT, NRANKNXT_AIRCRAFT(JI) )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%SEND_DEALLOCATE( KTO = NRANKNXT_AIRCRAFT(JI), OSEND_SIZE_TO_RECEIVER = .TRUE. )
DEALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
ELSE IF ( ISP == NRANKNXT_AIRCRAFT(JI) ) THEN
IF ( ASSOCIATED( TAIRCRAFTS(JI)%TAIRCRAFT ) ) &
call Print_msg( NVERB_FATAL, 'GEN', 'AIRCRAFT_BALLOON', 'aircraft already associated' )
ALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
- CALL FLYER_RECV_AND_ALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT, NRANKCUR_AIRCRAFT(JI) )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%RECV_ALLOCATE( KFROM = NRANKCUR_AIRCRAFT(JI), ORECV_SIZE_FROM_OWNER = .TRUE. )
END IF
END IF
END DO
@@ -257,11 +243,11 @@ IF ( ISP == NFLYER_DEFAULT_RANK ) THEN
CALL FLYER_GET_RANK_MODEL_ISCRASHED( TZBALLOON, PX = TZBALLOON%XXLAUNCH, PY = TZBALLOON%XYLAUNCH )
END IF
IF ( TZBALLOON%LCRASH ) THEN
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON', 'balloon ' // TRIM( TZBALLOON%CTITLE ) &
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON', 'balloon ' // TRIM( TZBALLOON%CNAME ) &
// ': launch coordinates are outside of horizontal physical domain' )
END IF
ELSE
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'AIRCRAFT_BALLOON', 'balloon ' // TRIM( TZBALLOON%CTITLE ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'AIRCRAFT_BALLOON', 'balloon ' // TRIM( TZBALLOON%CNAME ) &
// ': position has already been initialized' )
END IF
@@ -297,11 +283,11 @@ DEALLOCATE( IRANKNXT_BALLOON_TMP )
DO JI = 1, NBALLOONS
IF ( NRANKNXT_BALLOON(JI) /= NRANKCUR_BALLOON(JI) ) THEN
IF ( ISP == NRANKCUR_BALLOON(JI) ) THEN
- CALL FLYER_SEND_AND_DEALLOCATE( TBALLOONS(JI)%TBALLOON, NRANKNXT_BALLOON(JI) )
+ CALL TBALLOONS(JI)%TBALLOON%SEND_DEALLOCATE( KTO = NRANKNXT_BALLOON(JI), OSEND_SIZE_TO_RECEIVER = .TRUE. )
DEALLOCATE( TBALLOONS(JI)%TBALLOON )
ELSE IF ( ISP == NRANKNXT_BALLOON(JI) ) THEN
ALLOCATE( TBALLOONS(JI)%TBALLOON )
- CALL FLYER_RECV_AND_ALLOCATE( TBALLOONS(JI)%TBALLOON, NRANKCUR_BALLOON(JI) )
+ CALL TBALLOONS(JI)%TBALLOON%RECV_ALLOCATE( KFROM = NRANKCUR_BALLOON(JI), ORECV_SIZE_FROM_OWNER = .TRUE. )
END IF
END IF
END DO
@@ -333,558 +319,23 @@ select type ( tpflyer )
else if ( Trim( TPFLYER%CTYPE ) == 'CVBALL' ) then
ytype = 'Constant_volume_balloons'
else
- call Print_msg( NVERB_ERROR, 'GEN', 'AIRCRAFT_BALLOON_LONGTYPE_GET', 'unknown category for flyer ' // Trim( tpflyer%ctitle ) )
+ call Print_msg( NVERB_ERROR, 'GEN', 'AIRCRAFT_BALLOON_LONGTYPE_GET', 'unknown category for flyer ' // Trim( tpflyer%cname ) )
ytype = 'Unknown'
end if
class default
- call Print_msg( NVERB_ERROR, 'GEN', 'AIRCRAFT_BALLOON_LONGTYPE_GET', 'unknown class for flyer ' // Trim( tpflyer%ctitle ) )
+ call Print_msg( NVERB_ERROR, 'GEN', 'AIRCRAFT_BALLOON_LONGTYPE_GET', 'unknown class for flyer ' // Trim( tpflyer%cname ) )
ytype = 'Unknown'
end select
if ( Len_trim( ytype ) > Len( HLONGTYPE ) ) &
call Print_msg( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_LONGTYPE_GET', &
- 'HLONGTYPE truncated for flyer ' // Trim( tpflyer%ctitle ) )
+ 'HLONGTYPE truncated for flyer ' // Trim( tpflyer%cname ) )
HLONGTYPE = Trim( ytype )
END SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
-SUBROUTINE FLYER_SEND( TPFLYER, KTO )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TAIRCRAFTDATA, TBALLOONDATA, TFLYERDATA
-USE MODD_CONF_n, ONLY: NRR
-USE MODD_DIM_n, ONLY: NKMAX
-USE MODD_IO, ONLY: ISP
-USE MODD_MPIF
-USE MODD_NSV, ONLY: NSV
-USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_PARAM_n, ONLY: CCLOUD
-USE MODD_PRECISION, ONLY: MNHINT_MPI, MNHREAL_MPI
-USE MODD_VAR_LL, ONLY: NMNH_COMM_WORLD
-
-USE MODE_DATETIME
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
-INTEGER, INTENT(IN) :: KTO ! Process to which to send flyer data
-
-CHARACTER(LEN=10) :: YFROM, YTO
-INTEGER :: IERR
-INTEGER :: IKU ! number of vertical levels
-INTEGER :: IPACKSIZE ! Size of the ZPACK buffer
-INTEGER :: IPOS ! Position in the ZPACK buffer
-INTEGER :: IPOSAIR
-INTEGER :: ISTORE_CUR
-INTEGER :: JI
-INTEGER, DIMENSION(3) :: ISTORES
-REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! Buffer to store raw data of a profiler (used for MPI communication)
-
-WRITE( YFROM, '( I10 )' ) ISP
-WRITE( YTO, '( I10 )' ) KTO
-CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'FLYER_SEND', 'send flyer '//TRIM(TPFLYER%CTITLE)//': '//TRIM(YFROM)//'->'//TRIM(YTO), &
- OLOCAL = .TRUE. )
-
-IKU = NKMAX + 2 * JPVEXT
-
-ISTORE_CUR = TPFLYER%TFLYER_TIME%N_CUR
-
-! Prepare data to send
-
-! Determine size of data to send
-! Characters, integers and logicals will be converted to reals. CMODEL and CTYPE will be coded by 1 real
-IPACKSIZE = 15 + LEN(TPFLYER%CTITLE) + ISTORE_CUR * ( 18 + NRR + NSV * 2 + IKU * ( 9 + NRR ) )
-IF ( CCLOUD == 'LIMA' ) IPACKSIZE = IPACKSIZE + ISTORE_CUR * IKU * 2
-
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TAIRCRAFTDATA )
- IPACKSIZE = IPACKSIZE + 6 + TPFLYER%NPOS * 6
-
- CLASS IS ( TBALLOONDATA )
- IPACKSIZE = IPACKSIZE + 15
-END SELECT
-
-! Communication is in 2 phases:
-! 1) first send the ISTORE dimension (optimisation: only what has already been written = N_CUR)
-! 2) send data
-ISTORES(1) = ISTORE_CUR ! Number of currently used store positions
-ISTORES(2) = SIZE( TPFLYER%NMODELHIST ) ! Total number of store positions
-ISTORES(3) = IPACKSIZE
-CALL MPI_SEND( ISTORES, 3, MNHINT_MPI, KTO-1, NTAG_NCUR, NMNH_COMM_WORLD, IERR )
-
-ALLOCATE( ZPACK(IPACKSIZE) )
-
-! Fill buffer / pack data
-IPOS = 1
-IF ( TPFLYER%CMODEL == 'FIX' ) THEN
- ZPACK(IPOS) = NMODEL_FIX
-ELSE
- ZPACK(IPOS) = NMODEL_MOB
-END IF
-IPOS = IPOS + 1
-
-ZPACK(IPOS) = TPFLYER%NMODEL; IPOS = IPOS + 1
-ZPACK(IPOS) = TPFLYER%NID; IPOS = IPOS + 1
-
-SELECT CASE( TPFLYER%CTYPE )
- CASE( 'AIRCRA' )
- ZPACK(IPOS) = NTYPE_AIRCRA
- CASE( 'CVBALL' )
- ZPACK(IPOS) = NTYPE_CVBALL
- CASE( 'ISODEN' )
- ZPACK(IPOS) = NTYPE_ISODEN
- CASE( 'RADIOS' )
- ZPACK(IPOS) = NTYPE_RADIOS
- CASE DEFAULT
- CALL PRINT_MSG( NVERB_FATAL, 'FLYER_SEND', 'invalid CTYPE for flyer' )
-END SELECT
-IPOS = IPOS + 1
-
-! Convert title characters to integers
-DO JI = 1, LEN(TPFLYER%CTITLE)
- ZPACK(IPOS) = ICHAR( TPFLYER%CTITLE(JI:JI) )
- IPOS = IPOS + 1
-END DO
-
-ZPACK(IPOS) = TPFLYER%TLAUNCH - TPREFERENCE_DATE; IPOS = IPOS + 1
-IF ( TPFLYER%LCRASH ) THEN
- ZPACK(IPOS) = 1.d0
-ELSE
- ZPACK(IPOS) = 0.d0
-END IF
-IPOS = IPOS + 1
-
-ZPACK(IPOS) = TPFLYER%NCRASH; IPOS = IPOS + 1
-
-IF ( TPFLYER%LFLY ) THEN
- ZPACK(IPOS) = 1.d0
-ELSE
- ZPACK(IPOS) = 0.d0
-END IF
-IPOS = IPOS + 1
-
-IF ( TPFLYER%LSTORE ) THEN
- ZPACK(IPOS) = 1.d0
-ELSE
- ZPACK(IPOS) = 0.d0
-END IF
-IPOS = IPOS + 1
-
-ZPACK(IPOS) = TPFLYER%TFLYER_TIME%N_CUR; IPOS = IPOS + 1
-ZPACK(IPOS) = TPFLYER%TFLYER_TIME%XTSTEP; IPOS = IPOS + 1
-DO JI = 1, ISTORE_CUR
- ZPACK(IPOS) = TPFLYER%TFLYER_TIME%TPDATES(JI) - TPREFERENCE_DATE; IPOS = IPOS + 1
-END DO
-
-ZPACK(IPOS) = TPFLYER%XX_CUR; IPOS = IPOS + 1
-ZPACK(IPOS) = TPFLYER%XY_CUR; IPOS = IPOS + 1
-ZPACK(IPOS) = TPFLYER%XZ_CUR; IPOS = IPOS + 1
-
-ZPACK(IPOS) = TPFLYER%NRANK_CUR; IPOS = IPOS + 1
-
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%NMODELHIST(1:ISTORE_CUR); IPOS = IPOS + ISTORE_CUR
-
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XX(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XY(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XZ(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XLAT(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XLON(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XZON(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XMER(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XW(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XP(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XTKE(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XTKE_DISS(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XTH(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
-
-ZPACK(IPOS:IPOS+ISTORE_CUR*NRR-1) = RESHAPE( TPFLYER%XR(1:ISTORE_CUR,1:NRR), [ISTORE_CUR*NRR] ) ; IPOS = IPOS + ISTORE_CUR * NRR
-ZPACK(IPOS:IPOS+ISTORE_CUR*NSV-1) = RESHAPE( TPFLYER%XSV(1:ISTORE_CUR,1:NSV), [ISTORE_CUR*NSV] ) ; IPOS = IPOS + ISTORE_CUR * NSV
-ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XRTZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-
-ZPACK(IPOS:IPOS+ISTORE_CUR*IKU*NRR-1) = RESHAPE( TPFLYER%XRZ(1:ISTORE_CUR,1:IKU,1:NRR), [ISTORE_CUR*IKU*NRR] )
-IPOS = IPOS + ISTORE_CUR * IKU * NRR
-
-ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XFFZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XIWCZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ); IPOS = IPOS + ISTORE_CUR * IKU
-ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XLWCZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ); IPOS = IPOS + ISTORE_CUR * IKU
-ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XCIZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-IF ( CCLOUD == 'LIMA' ) THEN
- ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XCCZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] );IPOS = IPOS + ISTORE_CUR * IKU
- ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XCRZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] );IPOS = IPOS + ISTORE_CUR * IKU
-END IF
-ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XCRARE(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] );IPOS = IPOS + ISTORE_CUR * IKU
-
-ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XCRARE_ATT(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] )
-IPOS = IPOS + ISTORE_CUR * IKU
-
-ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XWZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XZZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XZS(1:ISTORE_CUR); IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XTSRAD(1:ISTORE_CUR); IPOS = IPOS + ISTORE_CUR
-
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XTHW_FLUX(1:ISTORE_CUR); IPOS = IPOS + ISTORE_CUR
-ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XRCW_FLUX(1:ISTORE_CUR); IPOS = IPOS + ISTORE_CUR
-
-ZPACK(IPOS:IPOS+ISTORE_CUR*NSV-1) = RESHAPE( TPFLYER%XSVW_FLUX(1:ISTORE_CUR,1:NSV), [ISTORE_CUR*NSV] )
-IPOS = IPOS + ISTORE_CUR * NSV
-
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TAIRCRAFTDATA )
- IF ( TPFLYER%LTOOKOFF ) THEN
- ZPACK(IPOS) = 1.d0
- ELSE
- ZPACK(IPOS) = 0.d0
- END IF
- IPOS = IPOS + 1
-
- IF ( TPFLYER%LALTDEF ) THEN
- ZPACK(IPOS) = 1.d0
- ELSE
- ZPACK(IPOS) = 0.d0
- END IF
- IPOS = IPOS + 1
-
- ZPACK(IPOS) = TPFLYER%NPOS; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%NPOSCUR; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XP_CUR; IPOS = IPOS + 1
-
- IPOSAIR = TPFLYER%NPOS
-
- ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSLAT(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
- ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSLON(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
- ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSX(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
- ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSY(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
- IF ( TPFLYER%LALTDEF ) THEN
- ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSP(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
- ELSE
- ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSZ(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
- ENDIF
- ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSTIME(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
-
- ZPACK(IPOS) = TPFLYER%TLAND - TPREFERENCE_DATE; IPOS = IPOS + 1
-
- CLASS IS ( TBALLOONDATA )
- IF ( TPFLYER%LPOSITION_INIT ) THEN
- ZPACK(IPOS) = 1.d0
- ELSE
- ZPACK(IPOS) = 0.d0
- END IF
- IPOS = IPOS + 1
-
- ZPACK(IPOS) = TPFLYER%XLATLAUNCH ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XLONLAUNCH ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XXLAUNCH ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XYLAUNCH ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XALTLAUNCH ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XWASCENT ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XRHO ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XPRES ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XDIAMETER ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XAERODRAG ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XINDDRAG ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XVOLUME ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPFLYER%XMASS ; IPOS = IPOS + 1
-
- ZPACK(IPOS) = TPFLYER%TPOS_CUR - TPREFERENCE_DATE; IPOS = IPOS + 1
-
-END SELECT
-
-IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_WARNING, 'IO', 'FLYER_SEND', 'IPOS-1 /= IPACKSIZE (sender side)', OLOCAL = .TRUE. )
-
-! Send packed data
-CALL MPI_SEND( ZPACK, IPACKSIZE, MNHREAL_MPI, KTO-1, NTAG_PACK, NMNH_COMM_WORLD, IERR )
-
-END SUBROUTINE FLYER_SEND
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_SEND_AND_DEALLOCATE( TPFLYER, KTO )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
-USE MODD_IO, ONLY: ISP
-
-USE MODE_INI_AIRCRAFT_BALLOON, ONLY: DEALLOCATE_FLYER
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
-INTEGER, INTENT(IN) :: KTO ! Process to which to send flyer data
-
-CHARACTER(LEN=10) :: YFROM, YTO
-
-WRITE( YFROM, '( I10 )' ) ISP
-WRITE( YTO, '( I10 )' ) KTO
-CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'FLYER_SEND_AND_DEALLOCATE', &
- 'send flyer '//TRIM(TPFLYER%CTITLE)//': '//TRIM(YFROM)//'->'//TRIM(YTO), OLOCAL = .TRUE. )
-
-CALL FLYER_SEND( TPFLYER, KTO )
-
-! Free flyer data (dynamically allocated), scalar data has to be freed outside this subroutine
-CALL DEALLOCATE_FLYER( TPFLYER )
-
-END SUBROUTINE FLYER_SEND_AND_DEALLOCATE
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_RECV_AND_ALLOCATE( TPFLYER, KFROM )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TAIRCRAFTDATA, TBALLOONDATA, TFLYERDATA
-USE MODD_CONF_n, ONLY: NRR
-USE MODD_DIM_n, ONLY: NKMAX
-USE MODD_IO, ONLY: ISP
-USE MODD_MPIF
-USE MODD_NSV, ONLY: NSV
-USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_PARAM_n, ONLY: CCLOUD
-USE MODD_PRECISION, ONLY: MNHINT_MPI, MNHREAL_MPI
-USE MODD_VAR_LL, ONLY: NMNH_COMM_WORLD
-
-USE MODE_DATETIME
-USE MODE_INI_AIRCRAFT_BALLOON, ONLY: ALLOCATE_FLYER
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
-INTEGER, INTENT(IN) :: KFROM ! Process from which to receive flyer data
-
-CHARACTER(LEN=10) :: YFROM, YTO
-INTEGER :: IERR
-INTEGER :: IKU ! number of vertical levels
-INTEGER :: IPOSAIR
-INTEGER :: ISTORE_CUR
-INTEGER :: ISTORE_TOT
-INTEGER :: IPACKSIZE ! Size of the ZPACK buffer
-INTEGER :: IPOS ! Position in the ZPACK buffer
-INTEGER :: JI
-INTEGER, DIMENSION(3) :: ISTORES
-REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! Buffer to store raw data of a profiler (used for MPI communication)
-
-WRITE( YFROM, '( I10 )' ) KFROM
-WRITE( YTO, '( I10 )' ) ISP
-! CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'FLYER_RECV_AND_ALLOCATE', &
-! 'receive flyer (name not yet known): '//TRIM(YFROM)//'->'//TRIM(YTO), OLOCAL = .TRUE. )
-
-IKU = NKMAX + 2 * JPVEXT
-
-! Receive data (useful dimensions)
-CALL MPI_RECV( ISTORES, 3, MNHINT_MPI, KFROM-1, NTAG_NCUR, NMNH_COMM_WORLD, MPI_STATUS_IGNORE, IERR )
-
-ISTORE_CUR = ISTORES(1)
-ISTORE_TOT = ISTORES(2)
-IPACKSIZE = ISTORES(3)
-
-! Allocate receive buffer
-ALLOCATE( ZPACK(IPACKSIZE) )
-
-! Receive packed data
-CALL MPI_RECV( ZPACK, IPACKSIZE, MNHREAL_MPI, KFROM-1, NTAG_PACK, NMNH_COMM_WORLD, MPI_STATUS_IGNORE, IERR )
-
-! Allocation of flyer must be done only once number of stores is known
-CALL ALLOCATE_FLYER( TPFLYER, ISTORE_TOT )
-
-! Unpack data
-IPOS = 1
-
-IF ( NINT( ZPACK(IPOS) ) == NMODEL_FIX ) THEN
- TPFLYER%CMODEL = 'FIX'
-ELSE
- TPFLYER%CMODEL = 'MOB'
-END IF
-IPOS = IPOS + 1
-
-TPFLYER%NMODEL = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
-TPFLYER%NID = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
-
-SELECT CASE( NINT( ZPACK(IPOS) ) )
- CASE(NTYPE_AIRCRA )
- TPFLYER%CTYPE = 'AIRCRA'
- CASE( NTYPE_CVBALL )
- TPFLYER%CTYPE = 'CVBALL'
- CASE( NTYPE_ISODEN )
- TPFLYER%CTYPE = 'ISODEN'
- CASE( NTYPE_RADIOS )
- TPFLYER%CTYPE = 'RADIOS'
- CASE DEFAULT
- CALL PRINT_MSG( NVERB_FATAL, 'FLYER_RECV_AND_ALLOCATE', 'invalid CTYPE for flyer' )
-END SELECT
-IPOS = IPOS + 1
-
-! Convert integers to characters for title
-DO JI = 1, LEN(TPFLYER%CTITLE)
- TPFLYER%CTITLE(JI:JI) = ACHAR( NINT( ZPACK(IPOS) ) )
- IPOS = IPOS + 1
-END DO
-
-! Print full message only now (flyer title was not yet known)
-CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'FLYER_RECV_AND_ALLOCATE', &
- 'receive flyer '//TRIM(TPFLYER%CTITLE)//': '//TRIM(YFROM)//'->'//TRIM(YTO), OLOCAL = .TRUE. )
-
-TPFLYER%TLAUNCH = TPREFERENCE_DATE + ZPACK(IPOS); IPOS = IPOS + 1
-
-IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
- TPFLYER%LCRASH = .FALSE.
-ELSE
- TPFLYER%LCRASH = .TRUE.
-END IF
-IPOS = IPOS + 1
-
-TPFLYER%NCRASH = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
-
-IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
- TPFLYER%LFLY = .FALSE.
-ELSE
- TPFLYER%LFLY = .TRUE.
-END IF
-IPOS = IPOS + 1
-
-IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
- TPFLYER%LSTORE = .FALSE.
-ELSE
- TPFLYER%LSTORE = .TRUE.
-END IF
-IPOS = IPOS + 1
-
-TPFLYER%TFLYER_TIME%N_CUR = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
-TPFLYER%TFLYER_TIME%XTSTEP = ZPACK(IPOS); IPOS = IPOS + 1
-
-DO JI = 1, ISTORE_CUR
- TPFLYER%TFLYER_TIME%TPDATES(JI) = TPREFERENCE_DATE + ZPACK(IPOS); IPOS = IPOS + 1
-END DO
-
-TPFLYER%XX_CUR = ZPACK(IPOS); IPOS = IPOS + 1
-TPFLYER%XY_CUR = ZPACK(IPOS); IPOS = IPOS + 1
-TPFLYER%XZ_CUR = ZPACK(IPOS); IPOS = IPOS + 1
-
-TPFLYER%NRANK_CUR = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
-
-TPFLYER%NMODELHIST(1:ISTORE_CUR) = NINT( ZPACK(IPOS:IPOS+ISTORE_CUR-1) ) ; IPOS = IPOS + ISTORE_CUR
-
-TPFLYER%XX(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XY(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XZ(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XLAT(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XLON(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XZON(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XMER(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XW(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XP(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XTKE(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XTKE_DISS(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XTH(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-
-TPFLYER%XR(1:ISTORE_CUR,1:NRR) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*NRR-1), [ISTORE_CUR,NRR] ) ; IPOS = IPOS + ISTORE_CUR * NRR
-TPFLYER%XSV(1:ISTORE_CUR,1:NSV) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*NSV-1), [ISTORE_CUR,NSV] ) ; IPOS = IPOS + ISTORE_CUR * NSV
-TPFLYER%XRTZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-
-TPFLYER%XRZ(1:ISTORE_CUR,1:IKU,1:NRR) = RESHAPE( ZPACK(IPOS:IPOS+(ISTORE_CUR*IKU*NRR)-1), [ISTORE_CUR,IKU,NRR] )
-IPOS = IPOS + ISTORE_CUR * IKU * NRR
-
-TPFLYER%XFFZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-TPFLYER%XIWCZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-TPFLYER%XLWCZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-TPFLYER%XCIZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-IF ( CCLOUD == 'LIMA' ) THEN
- TPFLYER%XCCZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ); IPOS = IPOS + ISTORE_CUR * IKU
- TPFLYER%XCRZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ); IPOS = IPOS + ISTORE_CUR * IKU
-END IF
-TPFLYER%XCRARE(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ); IPOS = IPOS + ISTORE_CUR * IKU
-
-TPFLYER%XCRARE_ATT(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] )
-IPOS = IPOS + ISTORE_CUR * IKU
-
-TPFLYER%XWZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-TPFLYER%XZZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
-
-TPFLYER%XZS(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XTSRAD(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-
-TPFLYER%XTHW_FLUX(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-TPFLYER%XRCW_FLUX(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
-
-TPFLYER%XSVW_FLUX(1:ISTORE_CUR,1:NSV) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*NSV-1), [ISTORE_CUR,NSV] )
-IPOS = IPOS + ISTORE_CUR * NSV
-
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TAIRCRAFTDATA )
- IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
- TPFLYER%LTOOKOFF = .FALSE.
- ELSE
- TPFLYER%LTOOKOFF = .TRUE.
- END IF
- IPOS = IPOS + 1
-
- IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
- TPFLYER%LALTDEF = .FALSE.
- ELSE
- TPFLYER%LALTDEF = .TRUE.
- END IF
- IPOS = IPOS + 1
-
- TPFLYER%NPOS = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
- TPFLYER%NPOSCUR = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
-
- TPFLYER%XP_CUR = ZPACK(IPOS); IPOS = IPOS + 1
-
- IPOSAIR = TPFLYER%NPOS
-
- ALLOCATE( TPFLYER%XPOSLAT(IPOSAIR) )
- ALLOCATE( TPFLYER%XPOSLON(IPOSAIR) )
- ALLOCATE( TPFLYER%XPOSX(IPOSAIR) )
- ALLOCATE( TPFLYER%XPOSY(IPOSAIR) )
- IF ( TPFLYER%LALTDEF ) THEN
- ALLOCATE( TPFLYER%XPOSP(IPOSAIR) )
- ELSE
- ALLOCATE( TPFLYER%XPOSZ(IPOSAIR) )
- END IF
- ALLOCATE( TPFLYER%XPOSTIME(IPOSAIR) )
-
- TPFLYER%XPOSLAT(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
- TPFLYER%XPOSLON(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
- TPFLYER%XPOSX(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
- TPFLYER%XPOSY(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
- IF ( TPFLYER%LALTDEF ) THEN
- TPFLYER%XPOSP(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
- ELSE
- TPFLYER%XPOSZ(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
- END IF
- TPFLYER%XPOSTIME(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
-
- TPFLYER%TLAND = TPREFERENCE_DATE + ZPACK(IPOS); IPOS = IPOS + 1
-
- CLASS IS ( TBALLOONDATA )
- IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
- TPFLYER%LPOSITION_INIT = .FALSE.
- ELSE
- TPFLYER%LPOSITION_INIT = .TRUE.
- END IF
- IPOS = IPOS + 1
-
- TPFLYER%XLATLAUNCH = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XLONLAUNCH = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XXLAUNCH = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XYLAUNCH = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XALTLAUNCH = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XWASCENT = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XRHO = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XPRES = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XDIAMETER = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XAERODRAG = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XINDDRAG = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XVOLUME = ZPACK(IPOS); IPOS = IPOS + 1
- TPFLYER%XMASS = ZPACK(IPOS); IPOS = IPOS + 1
-
- TPFLYER%TPOS_CUR = TPREFERENCE_DATE + ZPACK(IPOS); IPOS = IPOS + 1
-
-END SELECT
-
-IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_WARNING, 'IO', 'FLYER_RECV_AND_ALLOCATE', 'IPOS-1 /= IPACKSIZE (receiver side)', OLOCAL = .TRUE. )
-
-END SUBROUTINE FLYER_RECV_AND_ALLOCATE
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-
END MODULE MODE_AIRCRAFT_BALLOON
diff --git a/src/MNH/aircraft_balloon_evol.f90 b/src/MNH/aircraft_balloon_evol.f90
index 1d03d38a3302f389102f31c53f9881b483849ac3..dcbdd6349d012cb4ceea2734c75146d1c55a5c4b 100644
--- a/src/MNH/aircraft_balloon_evol.f90
+++ b/src/MNH/aircraft_balloon_evol.f90
@@ -25,11 +25,14 @@
! -PSEA was always used even if not allocated (CSURF/=EXTE)
! -do not use PMAP if cartesian domain
! P. Wautelet 06/2022: reorganize flyers
+! P. Wautelet 01/06/2023: deduplicate code => moved to modd/mode_sensors.f90
!-----------------------------------------------------------------
! ##########################
MODULE MODE_AIRCRAFT_BALLOON_EVOL
! ##########################
+USE MODD_PRECISION, ONLY: MNHREAL
+
USE MODE_MSG
IMPLICIT NONE
@@ -42,6 +45,8 @@ PUBLIC :: AIRCRAFT_COMPUTE_POSITION
PUBLIC :: FLYER_GET_RANK_MODEL_ISCRASHED
+REAL, PARAMETER :: XTIMETHRESH = 1.E-8_MNHREAL
+
CONTAINS
! ########################################################
SUBROUTINE AIRCRAFT_BALLOON_EVOL(PTSTEP, &
@@ -154,6 +159,7 @@ REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZV ! V points z coordinates
REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZWM ! mass point wind
!
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZEXN ! Exner function
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTH_EXN ! potential temperature multiplied by Exner function
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRHO ! air density
REAL :: ZFLYER_EXN ! balloon/aircraft Exner func.
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTHW_FLUX !
@@ -161,7 +167,6 @@ REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRCW_FLUX !
REAL, DIMENSION(2,2,SIZE(PSV,3),SIZE(PSV,4)) :: ZSVW_FLUX
!
LOGICAL :: GLAUNCH ! launch/takeoff is effective at this time-step (if true)
-LOGICAL :: GSTORE ! storage occurs at this time step
LOGICAL :: GOWNER_CUR ! The process is the current owner of the flyer
!
INTEGER :: II_M ! mass balloon position (x index)
@@ -169,37 +174,6 @@ INTEGER :: IJ_M ! mass balloon position (y index)
INTEGER :: II_U ! U flux point balloon position (x index)
INTEGER :: IJ_V ! V flux point balloon position (y index)
!
-INTEGER :: IK00 ! balloon position for II_M , IJ_M
-INTEGER :: IK01 ! balloon position for II_M , IJ_M+1
-INTEGER :: IK10 ! balloon position for II_M+1, IJ_M
-INTEGER :: IK11 ! balloon position for II_M+1, IJ_M+1
-INTEGER :: IU00 ! balloon position for II_U , IJ_M
-INTEGER :: IU01 ! balloon position for II_U , IJ_M+1
-INTEGER :: IU10 ! balloon position for II_U+1, IJ_M
-INTEGER :: IU11 ! balloon position for II_U+1, IJ_M+1
-INTEGER :: IV00 ! balloon position for II_M , IJ_V
-INTEGER :: IV01 ! balloon position for II_M , IJ_V+1
-INTEGER :: IV10 ! balloon position for II_M+1, IJ_V
-INTEGER :: IV11 ! balloon position for II_M+1, IJ_V+1
-!
-REAL :: ZXCOEF ! X direction interpolation coefficient
-REAL :: ZUCOEF ! X direction interpolation coefficient (for U)
-REAL :: ZYCOEF ! Y direction interpolation coefficient
-REAL :: ZVCOEF ! Y direction interpolation coefficient (for V)
-!
-REAL :: ZZCOEF00 ! Z direction interpolation coefficient for II_M , IJ_M
-REAL :: ZZCOEF01 ! Z direction interpolation coefficient for II_M , IJ_M+1
-REAL :: ZZCOEF10 ! Z direction interpolation coefficient for II_M+1, IJ_M
-REAL :: ZZCOEF11 ! Z direction interpolation coefficient for II_M+1, IJ_M+1
-REAL :: ZUCOEF00 ! Z direction interpolation coefficient for II_U , IJ_M
-REAL :: ZUCOEF01 ! Z direction interpolation coefficient for II_U , IJ_M+1
-REAL :: ZUCOEF10 ! Z direction interpolation coefficient for II_U+1, IJ_M
-REAL :: ZUCOEF11 ! Z direction interpolation coefficient for II_U+1, IJ_M+1
-REAL :: ZVCOEF00 ! Z direction interpolation coefficient for II_M , IJ_V
-REAL :: ZVCOEF01 ! Z direction interpolation coefficient for II_M , IJ_V+1
-REAL :: ZVCOEF10 ! Z direction interpolation coefficient for II_M+1, IJ_V
-REAL :: ZVCOEF11 ! Z direction interpolation coefficient for II_M+1, IJ_V+1
-!
INTEGER :: ISTORE ! time index for storage
!
REAL :: ZTSTEP
@@ -232,15 +206,23 @@ SELECT TYPE ( TPFLYER )
IF ( TDTCUR >= TPFLYER%TLAUNCH .AND. TDTCUR <= TPFLYER%TLAND ) THEN
TPFLYER%LFLY = .TRUE.
TPFLYER%LTOOKOFF = .TRUE.
+ WRITE( CMNHMSG(1), "( 'aircraft ', A, ' takeoff on ', I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
+ TRIM( TPFLYER%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+ ELSE
+ TPFLYER%LFLY = .FALSE.
END IF
END IF
END IF TAKEOFF
!Do we have to store aircraft data?
- IF ( IMI == TPFLYER%NMODEL ) CALL FLYER_CHECK_STORESTEP( TPFLYER )
+ IF ( IMI == TPFLYER%NMODEL ) THEN
+ TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
+ END IF
+
! For aircrafts, data has only to be computed at store moments
- ISTORE = TPFLYER%TFLYER_TIME%N_CUR
IF ( IMI == TPFLYER%NMODEL .AND. TPFLYER%LFLY .AND. TPFLYER%LSTORE ) THEN
! Check if it is the right moment to store data
IF ( ABS( TDTCUR - TPFLYER%TFLYER_TIME%TPDATES(ISTORE) ) < 1e-10 ) THEN
@@ -280,14 +262,34 @@ SELECT TYPE ( TPFLYER )
IF ( TZNEXT >= TPFLYER%TLAUNCH .AND. TZNEXT <= TPFLYER%TLAND ) THEN
TPFLYER%LFLY = .TRUE.
! Force LTOOKOFF to prevent to do it again (at a next timestep)
- TPFLYER%LTOOKOFF = .TRUE.
+ IF ( .NOT. TPFLYER%LTOOKOFF ) THEN
+ TPFLYER%LTOOKOFF = .TRUE.
+ WRITE( CMNHMSG(1), "( 'aircraft ', A, ' will take off at next store on ', &
+ I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
+ TRIM( TPFLYER%CNAME ), TZNEXT%NDAY, TZNEXT%NMONTH, TZNEXT%NYEAR, TZNEXT%XTIME
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+ END IF
! Compute next position
CALL AIRCRAFT_COMPUTE_POSITION( TZNEXT, TPFLYER )
! Get rank of the process where the aircraft is and the model number
CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPFLYER )
+
+ IF ( TPFLYER%LCRASH .AND. TPFLYER%NCRASH == NCRASH_OUT_HORIZ ) THEN
+ WRITE( CMNHMSG(1), "( 'aircraft ', A, ' crashed on ', I2, '/', I2, '/', I4, ' at ', F18.12, &
+ 's (out of the horizontal boundaries)' )" ) &
+ TRIM( TPFLYER%CNAME ), TZNEXT%NDAY, TZNEXT%NMONTH, TZNEXT%NYEAR, TZNEXT%XTIME
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+ END IF
ELSE
+ IF ( TPFLYER%LFLY ) THEN
+ ! Aircraft was in flight and will have landed at next store
+ WRITE( CMNHMSG(1), "( 'aircraft ', A, ' will have landed at next store on ', &
+ I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
+ TRIM( TPFLYER%CNAME ), TZNEXT%NDAY, TZNEXT%NMONTH, TZNEXT%NYEAR, TZNEXT%XTIME
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+ END IF
TPFLYER%LFLY = .FALSE.
END IF
END IF
@@ -301,27 +303,32 @@ SELECT TYPE ( TPFLYER )
! Launch?
LAUNCH: IF ( .NOT. TPFLYER%LFLY .AND. .NOT. TPFLYER%LCRASH .AND. TPFLYER%NMODEL == IMI ) THEN
! Check if it is launchtime
- LAUNCHTIME: IF ( ( TDTCUR - TPFLYER%TLAUNCH ) >= -1.e-10 ) THEN
+ LAUNCHTIME: IF ( ( TDTCUR - TPFLYER%TLAUNCH ) >= -XTIMETHRESH ) THEN
TPFLYER%LFLY = .TRUE.
GLAUNCH = .TRUE.
TPFLYER%XX_CUR = TPFLYER%XXLAUNCH
TPFLYER%XY_CUR = TPFLYER%XYLAUNCH
TPFLYER%TPOS_CUR = TDTCUR
+ WRITE( CMNHMSG(1), "( 'balloon ', A, ' launched on ', I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
+ TRIM( TPFLYER%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF LAUNCHTIME
END IF LAUNCH
! Check if it is time to store data. This has also to be checked if the balloon
! is not yet launched or is crashed (data is also written in these cases, but with default values)
IF ( TPFLYER%NMODEL == IMI .AND. &
- ( .NOT. TPFLYER%LFLY .OR. TPFLYER%LCRASH .OR. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < 1.e-8 ) ) THEN
+ ( .NOT. TPFLYER%LFLY .OR. TPFLYER%LCRASH .OR. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < XTIMETHRESH ) ) THEN
!Do we have to store balloon data?
- CALL FLYER_CHECK_STORESTEP( TPFLYER )
+ TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
END IF
! In flight
+ ! The condition "ABS( TPFLYER%TPOS_CUR - TDTCUR ) < XTIMETHRESH" is necessary if the balloon changes of model
INFLIGHTONMODEL: IF ( TPFLYER%LFLY .AND. .NOT. TPFLYER%LCRASH .AND. TPFLYER%NMODEL == IMI &
- .AND. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < 1.e-8 ) THEN
+ .AND. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < XTIMETHRESH ) THEN
ISOWNERBAL: IF ( TPFLYER%NRANK_CUR == ISP ) THEN
CALL FLYER_INTERP_TO_MASSPOINTS()
@@ -342,10 +349,6 @@ SELECT TYPE ( TPFLYER )
CRASH_VERT: IF ( TPFLYER%LCRASH ) THEN
TPFLYER%LFLY = .FALSE.
- WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
- 's (too low or too high)' )" ) &
- TRIM( TPFLYER%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
ELSE CRASH_VERT
!No vertical crash
@@ -386,34 +389,25 @@ IMPLICIT NONE
CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
+LOGICAL :: GLOW, GHIGH
+
+GLOW = .FALSE.
+GHIGH = .FALSE.
+
SELECT CASE ( TPBALLOON%CTYPE )
!
! Iso-density balloon
!
CASE ( 'ISODEN' )
IF ( TPBALLOON%XALTLAUNCH /= XNEGUNDEF ) THEN
- IK00 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,2,:)), 1)
- ZZCOEF00 = (TPBALLOON%XALTLAUNCH - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XALTLAUNCH - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XALTLAUNCH - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XALTLAUNCH - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE IF ( TPBALLOON%XPRES /= XNEGUNDEF ) THEN
ZFLYER_EXN = (TPBALLOON%XPRES/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00))
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01))
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10))
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH )
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE
- CMNHMSG(1) = 'Error in balloon initial position (balloon ' // TRIM(TPBALLOON%CTITLE) // ' )'
+ CMNHMSG(1) = 'Error in balloon initial position (balloon ' // TRIM(TPBALLOON%CNAME) // ' )'
CMNHMSG(2) = 'neither initial ALTITUDE or PRESsure is given'
CMNHMSG(3) = 'Check your INI_BALLOON routine'
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
@@ -427,65 +421,70 @@ SELECT CASE ( TPBALLOON%CTYPE )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+ IF ( TPBALLOON%XZ_CUR > TPBALLOON%XALTLAUNCH ) THEN
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3, " (instead of ", EN12.3, ")" )' ) TPBALLOON%XZ_CUR, TPBALLOON%XALTLAUNCH
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+ END IF
!
! Constant Volume Balloon
!
CASE ( 'CVBALL' )
IF ( TPBALLOON%XALTLAUNCH /= XNEGUNDEF ) THEN
- IK00 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
+ IF ( GLOW ) THEN
TPBALLOON%XZ_CUR = TPBALLOON%XALTLAUNCH
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3, " (instead of ", EN12.3, ")" )' ) TPBALLOON%XZ_CUR, TPBALLOON%XALTLAUNCH
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
ELSE
- ZZCOEF00 = (TPBALLOON%XALTLAUNCH - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XALTLAUNCH - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XALTLAUNCH - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XALTLAUNCH - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
END IF
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE IF ( TPBALLOON%XPRES /= XNEGUNDEF ) THEN
ZFLYER_EXN = (TPBALLOON%XPRES/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH )
+ IF ( GLOW ) THEN
TPBALLOON%XZ_CUR = ZZM(1,1,IKB)
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3 )' ) TPBALLOON%XZ_CUR
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XZ_CUR, ZZM, GLOW, GHIGH )
ELSE
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00))
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01))
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10))
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
END IF
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
ELSE
TPBALLOON%XRHO = TPBALLOON%XMASS / TPBALLOON%XVOLUME
- IK00 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XRHO, ZRHO, GLOW, GHIGH )
+ IF ( GLOW ) THEN
TPBALLOON%XZ_CUR = ZZM(1,1,IKB)
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3 )' ) TPBALLOON%XZ_CUR
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XZ_CUR, ZZM, GLOW, GHIGH )
ELSE
- ZZCOEF00 = (TPBALLOON%XRHO - ZRHO(1,1,IK00)) / ( ZRHO(1,1,IK00+1) - ZRHO(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XRHO - ZRHO(1,2,IK01)) / ( ZRHO(1,2,IK01+1) - ZRHO(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XRHO - ZRHO(2,1,IK10)) / ( ZRHO(2,1,IK10+1) - ZRHO(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XRHO - ZRHO(2,2,IK11)) / ( ZRHO(2,2,IK11+1) - ZRHO(2,2,IK11))
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
END IF
END IF
END SELECT
@@ -501,6 +500,8 @@ USE MODD_NESTING, ONLY: NDAD, NDTRATIO
USE MODD_TIME, only: TDTSEG
USE MODD_TIME_n, ONLY: TDTCUR
+USE MODE_DATETIME
+
IMPLICIT NONE
CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
@@ -513,13 +514,14 @@ REAL :: ZDIVTMP
REAL :: ZMAP ! map factor at balloon location
REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
+TYPE(DATE_TIME) :: TZNEXT ! Time for next position
ZTSTEP = PTSTEP
-ZU_BAL = FLYER_INTERP_U(PU)
-ZV_BAL = FLYER_INTERP_V(PV)
+ZU_BAL = TPBALLOON%INTERP_FROM_UPOINT( PU )
+ZV_BAL = TPBALLOON%INTERP_FROM_VPOINT( PV )
if ( .not. lcartesian ) then
- ZMAP = FLYER_INTERP_2D(PMAP)
+ ZMAP = TPBALLOON%INTERP_HOR_FROM_MASSPOINT( PMAP )
else
ZMAP = 1.
end if
@@ -538,10 +540,12 @@ IMODEL_OLD = TPBALLOON%NMODEL
! Get rank of the process where the balloon is and the model number
CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPBALLOON )
-IF ( TPBALLOON%LCRASH ) THEN
- WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
- 's (out of the horizontal boundaries)' )" ) &
- TRIM( TPBALLOON%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+TZNEXT = TDTCUR + ZTSTEP
+
+IF ( TPBALLOON%LCRASH .AND. TPBALLOON%NCRASH == NCRASH_OUT_HORIZ ) THEN
+ WRITE( CMNHMSG(1), "( 'balloon ', A, ' crashed on ', I2, '/', I2, '/', I4, ' at ', F18.12, &
+ 's (out of the horizontal boundaries)' )" ) &
+ TRIM( TPBALLOON%CNAME ), TZNEXT%NDAY, TZNEXT%NMONTH, TZNEXT%NYEAR, TZNEXT%XTIME
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
@@ -549,6 +553,11 @@ IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
! Balloon has changed of model
IF ( NDAD(TPBALLOON%NMODEL ) == IMODEL_OLD ) THEN
! Nothing special to do when going to child model
+ WRITE( CMNHMSG(1), "( 'balloon ', A, ': change of model: ', I2, '->', I2, ' going to child' )" ) &
+ TRIM( TPFLYER%CNAME ), IMODEL_OLD, TPBALLOON%NMODEL
+ WRITE( CMNHMSG(2), "( 'on ', I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
+ TZNEXT%NDAY, TZNEXT%NMONTH, TZNEXT%NYEAR, TZNEXT%XTIME
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
ELSE IF ( TPBALLOON%NMODEL == NDAD(IMODEL_OLD) ) THEN
! Balloon go to parent model
! Recompute position to be compatible with parent timestep
@@ -580,15 +589,23 @@ IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
!Remark: by construction here, ISTORE is always > 1 => no risk with ISTORE-1 value
TPBALLOON%TFLYER_TIME%TPDATES(ISTORE) = TPBALLOON%TFLYER_TIME%TPDATES(ISTORE-1) + TPBALLOON%TFLYER_TIME%XTSTEP
- WRITE( CMNHMSG(1), "( 'Balloon ', A, ': store skipped at ', I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
- TRIM( TPBALLOON%CTITLE ), &
- TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NDAY, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NMONTH, &
+ WRITE( CMNHMSG(1), "( 'balloon ', A, ': store skipped on ', I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
+ TRIM( TPBALLOON%CNAME ), &
+ TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NDAY, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NMONTH, &
TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NYEAR, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%XTIME
CMNHMSG(2) = 'due to change of model (child to its parent)'
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
END IF
+ TZNEXT = TDTCUR + ZTSTEP
+
+ WRITE( CMNHMSG(1), "( 'balloon ', A, ': change of model: ', I2, '->', I2, ' going to parent' )" ) &
+ TRIM( TPFLYER%CNAME ), IMODEL_OLD, TPBALLOON%NMODEL
+ WRITE( CMNHMSG(2), "( 'on ', I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
+ TZNEXT%NDAY, TZNEXT%NMONTH, TZNEXT%NYEAR, TZNEXT%XTIME
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+
! Compute new horizontal position
TPBALLOON%XX_CUR = TPBALLOON%XX_CUR + ZU_BAL * ZTSTEP * ZMAP
TPBALLOON%XY_CUR = TPBALLOON%XY_CUR + ZV_BAL * ZTSTEP * ZMAP
@@ -597,16 +614,17 @@ IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
! Model number is now imposed
IMODEL = TPBALLOON%NMODEL
CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPBALLOON, KMODEL = IMODEL )
- IF ( TPBALLOON%LCRASH ) THEN
- WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
- 's (out of the horizontal boundaries)' )" ) &
- TRIM( TPBALLOON%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+
+ IF ( TPBALLOON%LCRASH .AND. TPBALLOON%NCRASH == NCRASH_OUT_HORIZ ) THEN
+ WRITE( CMNHMSG(1), "( 'balloon ', A, ' crashed on ', I2, '/', I2, '/', I4, ' at ', F18.12, &
+ 's (out of the horizontal boundaries)' )" ) &
+ TRIM( TPBALLOON%CNAME ), TZNEXT%NDAY, TZNEXT%NMONTH, TZNEXT%NYEAR, TZNEXT%XTIME
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
ELSE
! Special case not-managed (different dads, change of several models in 1 step (going to grand parent/grand children)...)
! This situation should be very infrequent => reasonable risk, error on the trajectory should be relatively small in most cases
- CMNHMSG(1) = 'unmanaged change of model for ballon ' // TPBALLOON%CTITLE
+ CMNHMSG(1) = 'unmanaged change of model for ballon ' // TPBALLOON%CNAME
CMNHMSG(2) = 'its trajectory might be wrong'
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
@@ -629,13 +647,13 @@ REAL :: ZRO_BAL ! air density at balloon location
REAL :: ZW_BAL ! vertical wind speed at balloon location (along z)
IF ( TPBALLOON%CTYPE == 'RADIOS' ) THEN
- ZW_BAL = FLYER_INTERP(ZWM)
+ ZW_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZWM )
TPBALLOON%XZ_CUR = TPBALLOON%XZ_CUR + ( ZW_BAL + TPBALLOON%XWASCENT ) * ZTSTEP
END IF
IF ( TPBALLOON%CTYPE == 'CVBALL' ) THEN
- ZW_BAL = FLYER_INTERP(ZWM)
- ZRO_BAL = FLYER_INTERP(ZRHO)
+ ZW_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZWM )
+ ZRO_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
! calculation with a time step of 1 second or less
IF (INT(ZTSTEP) .GT. 1 ) THEN
DO JK=1,INT(ZTSTEP)
@@ -680,12 +698,17 @@ IKE = SIZE(PZ,3) - JPVEXT
! ------------------------------------------------
! X position
-II_U = COUNT( XXHAT (:) <= TPFLYER%XX_CUR )
-II_M = COUNT( XXHATM(:) <= TPFLYER%XX_CUR )
+TPFLYER%NI_U = COUNT( XXHAT (:) <= TPFLYER%XX_CUR )
+TPFLYER%NI_M = COUNT( XXHATM(:) <= TPFLYER%XX_CUR )
+II_U = TPFLYER%NI_U
+II_M = TPFLYER%NI_M
! Y position
-IJ_V=COUNT( XYHAT (:)<=TPFLYER%XY_CUR )
-IJ_M=COUNT( XYHATM(:)<=TPFLYER%XY_CUR )
+TPFLYER%NJ_V = COUNT( XYHAT (:)<=TPFLYER%XY_CUR )
+TPFLYER%NJ_M = COUNT( XYHATM(:)<=TPFLYER%XY_CUR )
+IJ_V = TPFLYER%NJ_V
+IJ_M = TPFLYER%NJ_M
+
ZZM(:,:,1:IKU-1)=0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1,1:IKU-1)+0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1,2:IKU )
ZZM(:,:, IKU )=1.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1, IKU-1)-0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1, IKU-2)
@@ -765,20 +788,20 @@ USE MODD_GRID_n, ONLY: XXHAT, XXHATM, XYHAT, XYHATM
IMPLICIT NONE
! Interpolation coefficient for X
-ZXCOEF = (TPFLYER%XX_CUR - XXHATM(II_M)) / (XXHATM(II_M+1) - XXHATM(II_M))
-ZXCOEF = MAX (0.,MIN(ZXCOEF,1.))
+TPFLYER%XXMCOEF = ( TPFLYER%XX_CUR - XXHATM(II_M) ) / ( XXHATM(II_M+1) - XXHATM(II_M) )
+TPFLYER%XXMCOEF = MAX( 0., MIN( TPFLYER%XXMCOEF, 1. ) )
! Interpolation coefficient for y
-ZYCOEF = (TPFLYER%XY_CUR - XYHATM(IJ_M)) / (XYHATM(IJ_M+1) - XYHATM(IJ_M))
-ZYCOEF = MAX (0.,MIN(ZYCOEF,1.))
+TPFLYER%XYMCOEF = ( TPFLYER%XY_CUR - XYHATM(IJ_M) ) / ( XYHATM(IJ_M+1) - XYHATM(IJ_M) )
+TPFLYER%XYMCOEF = MAX( 0., MIN( TPFLYER%XYMCOEF, 1. ) )
! Interpolation coefficient for X (for U)
-ZUCOEF = (TPFLYER%XX_CUR - XXHAT(II_U)) / (XXHAT(II_U+1) - XXHAT(II_U))
-ZUCOEF = MAX(0.,MIN(ZUCOEF,1.))
+TPFLYER%XXUCOEF = ( TPFLYER%XX_CUR - XXHAT(II_U) ) / ( XXHAT(II_U+1) - XXHAT(II_U) )
+TPFLYER%XXUCOEF = MAX( 0., MIN( TPFLYER%XXUCOEF, 1. ) )
! Interpolation coefficient for y (for V)
-ZVCOEF = (TPFLYER%XY_CUR - XYHAT(IJ_V)) / (XYHAT(IJ_V+1) - XYHAT(IJ_V))
-ZVCOEF = MAX(0.,MIN(ZVCOEF,1.))
+TPFLYER%XYVCOEF = ( TPFLYER%XY_CUR - XYHAT(IJ_V) ) / ( XYHAT(IJ_V+1) - XYHAT(IJ_V) )
+TPFLYER%XYVCOEF = MAX( 0., MIN( TPFLYER%XYVCOEF, 1. ) )
END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1
!----------------------------------------------------------------------------
@@ -791,97 +814,56 @@ USE MODD_TIME_n, ONLY: TDTCUR
IMPLICIT NONE
+LOGICAL :: GLOW, GHIGH
+
! Find indices surrounding the vertical box where the flyer is
SELECT TYPE ( TPFLYER )
- CLASS IS ( TAIRCRAFTDATA)
+ CLASS IS ( TAIRCRAFTDATA )
IF ( TPFLYER%LALTDEF ) THEN
ZFLYER_EXN = (TPFLYER%XP_CUR/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
ELSE
- IK00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XZ_CUR, ZZM, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
END IF
- CLASS IS ( TBALLOONDATA)
+ CLASS IS ( TBALLOONDATA )
IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
- IK00 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XRHO, ZRHO, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
ELSE IF ( TPFLYER%CTYPE == 'RADIOS' .OR. TPFLYER%CTYPE == 'CVBALL' ) THEN
- IK00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,2,:)), 1)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XZ_CUR, ZZM, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
END IF
END SELECT
-! Do not allow crash on the ground: set position on the ground if too low
-IF ( ANY( [ IK00, IK01, IK10, IK11 ] < IKB ) ) THEN
- !Minimum altitude is on the ground at IKB (no crash if too low)
- IK00 = MAX ( IK00, IKB )
- IK01 = MAX ( IK01, IKB )
- IK10 = MAX ( IK10, IKB )
- IK11 = MAX ( IK11, IKB )
-
- CMNHMSG(1) = 'flyer ' // TRIM( TPFLYER%CTITLE ) // ' is near the ground'
- WRITE( CMNHMSG(2), "( 'at ', I2, '/', I2, '/', I4, ' ', F18.12, 's' )" ) &
- TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
- CALL PRINT_MSG( NVERB_INFO, 'GEN', 'FLYER_COMPUTE_INTERP_COEFF_VER', OLOCAL = .TRUE. )
-END IF
-
-! ! Check if the flyer crashed vertically (lower bound)
-! IF (IK00 < IKB .OR. IK01 < IKB .OR. IK10 < IKB .OR. IK11 < IKB ) THEN
-! TPFLYER%LCRASH = .TRUE.
-! TPFLYER%NCRASH = NCRASH_OUT_LOW
-! END IF
-
! Check if the flyer crashed vertically (higher bound)
-IF (IK00 >= IKE .OR. IK01 >= IKE .OR. IK10 >= IKE .OR. IK11 >= IKE ) THEN
+IF ( GHIGH ) THEN
TPFLYER%LCRASH = .TRUE.
TPFLYER%NCRASH = NCRASH_OUT_HIGH
-END IF
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TBALLOONDATA)
- IF ( TPFLYER%LCRASH ) RETURN
-END SELECT
+ SELECT TYPE ( TPFLYER )
+ CLASS IS ( TAIRCRAFTDATA )
+ WRITE( CMNHMSG(1), "( 'aircraft ', A, ' crashed on ', I2, '/', I2, '/', I4, ' at ', F18.12, 's (too high)' )" ) &
+ TRIM( TPFLYER%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ CLASS IS ( TBALLOONDATA )
+ WRITE( CMNHMSG(1), "( 'balloon ', A, ' crashed on ', I2, '/', I2, '/', I4, ' at ', F18.12, 's (too high)' )" ) &
+ TRIM( TPFLYER%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ END SELECT
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+END IF
-! Interpolation coefficients for the 4 suroundings verticals
SELECT TYPE ( TPFLYER )
CLASS IS ( TAIRCRAFTDATA)
IF ( TPFLYER%LALTDEF ) THEN
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00) )
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01) )
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10) )
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11) )
- TPFLYER%XZ_CUR = FLYER_INTERP(ZZM)
+ TPFLYER%XZ_CUR = TPFLYER%INTERP_FROM_MASSPOINT( ZZM )
ELSE
- ZZCOEF00 = (TPFLYER%XZ_CUR - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XZ_CUR - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XZ_CUR - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XZ_CUR - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11) )
- TPFLYER%XP_CUR = FLYER_INTERP(PP)
+ TPFLYER%XP_CUR = TPFLYER%INTERP_FROM_MASSPOINT( PP )
END IF
CLASS IS ( TBALLOONDATA)
IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
- ZZCOEF00 = (TPFLYER%XRHO - ZRHO(1,1,IK00)) / ( ZRHO(1,1,IK00+1) - ZRHO(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XRHO - ZRHO(1,2,IK01)) / ( ZRHO(1,2,IK01+1) - ZRHO(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XRHO - ZRHO(2,1,IK10)) / ( ZRHO(2,1,IK10+1) - ZRHO(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XRHO - ZRHO(2,2,IK11)) / ( ZRHO(2,2,IK11+1) - ZRHO(2,2,IK11) )
- TPFLYER%XZ_CUR = FLYER_INTERP(ZZM)
+ TPFLYER%XZ_CUR = TPFLYER%INTERP_FROM_MASSPOINT( ZZM )
ELSE IF ( TPFLYER%CTYPE == 'RADIOS' .OR. TPFLYER%CTYPE == 'CVBALL' ) THEN
- ZZCOEF00 = (TPFLYER%XZ_CUR - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XZ_CUR - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XZ_CUR - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XZ_CUR - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11) )
+ !Nothing to do
END IF
END SELECT
@@ -895,96 +877,38 @@ SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2( )
IMPLICIT NONE
-! Interpolation coefficients for the 4 suroundings verticals (for U)
-IU00 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(1,1,:)), 1)
-IU01 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(1,2,:)), 1)
-IU10 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(2,1,:)), 1)
-IU11 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(2,2,:)), 1)
-ZUCOEF00 = (TPFLYER%XZ_CUR - ZZU(1,1,IU00)) / ( ZZU(1,1,IU00+1) - ZZU(1,1,IU00) )
-ZUCOEF01 = (TPFLYER%XZ_CUR - ZZU(1,2,IU01)) / ( ZZU(1,2,IU01+1) - ZZU(1,2,IU01) )
-ZUCOEF10 = (TPFLYER%XZ_CUR - ZZU(2,1,IU10)) / ( ZZU(2,1,IU10+1) - ZZU(2,1,IU10) )
-ZUCOEF11 = (TPFLYER%XZ_CUR - ZZU(2,2,IU11)) / ( ZZU(2,2,IU11+1) - ZZU(2,2,IU11) )
+LOGICAL :: GLOW, GHIGH
+
+! Interpolation coefficients for the 4 surroundings verticals (for U)
+! ODONOLOWCRASH = .TRUE. because check for low crash has already been done
+CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'U', TPFLYER%XZ_CUR, ZZU, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
! Interpolation coefficients for the 4 suroundings verticals (for V)
-IV00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(1,1,:)), 1)
-IV01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(1,2,:)), 1)
-IV10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(2,1,:)), 1)
-IV11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(2,2,:)), 1)
-ZVCOEF00 = (TPFLYER%XZ_CUR - ZZV(1,1,IV00)) / ( ZZV(1,1,IV00+1) - ZZV(1,1,IV00) )
-ZVCOEF01 = (TPFLYER%XZ_CUR - ZZV(1,2,IV01)) / ( ZZV(1,2,IV01+1) - ZZV(1,2,IV01) )
-ZVCOEF10 = (TPFLYER%XZ_CUR - ZZV(2,1,IV10)) / ( ZZV(2,1,IV10+1) - ZZV(2,1,IV10) )
-ZVCOEF11 = (TPFLYER%XZ_CUR - ZZV(2,2,IV11)) / ( ZZV(2,2,IV11+1) - ZZV(2,2,IV11) )
+CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'V', TPFLYER%XZ_CUR, ZZV, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
SUBROUTINE FLYER_RECORD_DATA( )
-USE MODD_CST, ONLY: XCPD, XLAM_CRAD, XLIGHTSPEED, XP00, XPI, XRD, XRHOLW, XTT
+USE MODD_CST, ONLY: XP00, XPI, XRD
USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_TKE_DISS
USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_PARAM_ICE, ONLY: LSNOW_T_I => LSNOW_T
-USE MODD_PARAM_LIMA, ONLY: LSNOW_T_L => LSNOW_T, &
- XALPHAR_L => XALPHAR, XNUR_L => XNUR, XALPHAS_L => XALPHAS, XNUS_L => XNUS, &
- XALPHAG_L => XALPHAG, XNUG_L => XNUG, XALPHAI_L => XALPHAI, XNUI_L => XNUI, &
- XRTMIN_L => XRTMIN, XALPHAC_L => XALPHAC, XNUC_L => XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY: XAI_L => XAI, XBI_L => XBI, XLBEXS_L => XLBEXS,XLBS_L => XLBS,XCCS_L => XCCS, &
- XAS_L => XAS, XBS_L => XBS, XCXS_L => XCXS, &
- XLBDAS_MAX_L => XLBDAS_MAX, XLBDAS_MIN_L => XLBDAS_MIN, &
- XNS_L => XNS, XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
-USE MODD_PARAM_LIMA_MIXED, ONLY: XLBEXG_L => XLBEXG, XLBG_L => XLBG, XCCG_L => XCCG, XAG_L => XAG, XBG_L => XBG, XCXG_L => XCXG
-USE MODD_PARAM_LIMA_WARM, ONLY: XAC_L => XAC, XAR_L => XAR, XBC_L => XBC, XBR_L => XBR
-USE MODD_PARAM_n, ONLY: CCLOUD, CSURF
-USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I => XLBEXR, &
- XLBR_I => XLBR, XCCR_I => XCCR, XBR_I => XBR, XAR_I => XAR, &
- XALPHAC_I => XALPHAC, XNUC_I => XNUC, XBC_I => XBC, XAC_I => XAC, &
- XALPHAC2_I => XALPHAC2, XNUC2_I => XNUC2, &
- XALPHAS_I => XALPHAS, XNUS_I => XNUS, XLBEXS_I => XLBEXS, &
- XLBS_I => XLBS, XCCS_I => XCCS, XAS_I => XAS, XBS_I => XBS, XCXS_I => XCXS, &
- XALPHAG_I => XALPHAG, XNUG_I => XNUG, XLBEXG_I => XLBEXG, &
- XLBG_I => XLBG, XCCG_I => XCCG, XAG_I => XAG, XBG_I => XBG, XCXG_I => XCXG, &
- XALPHAI_I => XALPHAI, XNUI_I => XNUI, XLBEXI_I => XLBEXI, &
- XLBI_I => XLBI, XAI_I => XAI, XBI_I => XBI, &
- XNS_I => XNS, XRTMIN_I => XRTMIN, XCONC_LAND, XCONC_SEA, &
- XLBDAS_MAX_I => XLBDAS_MAX, XLBDAS_MIN_I => XLBDAS_MIN, &
- XTRANS_MP_GAMMAS_I => XTRANS_MP_GAMMAS
-
-USE MODE_FGAU, ONLY: GAULAG
-USE MODE_FSCATTER, ONLY: BHMIE, MOMG, MG, QEPSI, QEPSW
-USE MODE_GRIDPROJ, ONLY: SM_LATLON
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
-USE MODI_GAMMA, ONLY: GAMMA
+USE MODE_GRIDPROJ, ONLY: SM_LATLON
+USE MODE_SENSOR, ONLY: Sensor_rare_compute, Sensor_wc_compute
IMPLICIT NONE
-INTEGER, PARAMETER :: JPTS_GAULAG = 7 ! number of points for Gauss-Laguerre quadrature
-
-INTEGER :: JK ! loop index
INTEGER :: JLOOP ! loop counter
-REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
-REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
-REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
-REAL, DIMENSION(SIZE(PR,3)) :: ZCCI,ZCCR,ZCCC ! ICE,RAIN CLOUD concentration (LIMA)
-REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
-REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
-REAL :: ZA, ZB, ZCC, ZCX, ZALPHA, ZNS, ZNU, ZLB, ZLBEX, ZRHOHYD ! generic microphysical parameters
-INTEGER :: JJ ! loop counter for quadrature
-COMPLEX :: QMW,QMI,QM,QEPSIW,QEPSWI ! dielectric parameter
-REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
-REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
-REAL :: ZLBDA ! slope distribution parameter
-REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
-REAL :: ZFW ! liquid fraction
-REAL :: ZFPW ! weight for mixed-phase reflectivity
-REAL :: ZN ! number concentration
-REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
-REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
-LOGICAL :: GCALC
REAL :: ZGAM ! rotation between meso-nh base and spherical lat-lon base.
REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
+REAL, DIMENSION(SIZE(PZ,3)) :: ZZ ! altitude of model levels at station location
+REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
TPFLYER%NMODELHIST(ISTORE) = TPFLYER%NMODEL
@@ -992,496 +916,75 @@ TPFLYER%XX(ISTORE) = TPFLYER%XX_CUR
TPFLYER%XY(ISTORE) = TPFLYER%XY_CUR
TPFLYER%XZ(ISTORE) = TPFLYER%XZ_CUR
!
-CALL SM_LATLON(PLATOR,PLONOR, &
- TPFLYER%XX_CUR, TPFLYER%XY_CUR, &
- TPFLYER%XLAT(ISTORE), TPFLYER%XLON(ISTORE) )
+CALL SM_LATLON( PLATOR, PLONOR, &
+ TPFLYER%XX_CUR, TPFLYER%XY_CUR, &
+ TPFLYER%XLAT_CUR, TPFLYER%XLON_CUR )
+TPFLYER%XLAT(ISTORE) = TPFLYER%XLAT_CUR
+TPFLYER%XLON(ISTORE) = TPFLYER%XLON_CUR
!
-ZU_BAL = FLYER_INTERP_U(PU)
-ZV_BAL = FLYER_INTERP_V(PV)
-ZGAM = (XRPK * (TPFLYER%XLON(ISTORE) - XLON0) - XBETA)*(XPI/180.)
-TPFLYER%XZON (ISTORE) = ZU_BAL * COS(ZGAM) + ZV_BAL * SIN(ZGAM)
-TPFLYER%XMER (ISTORE) = - ZU_BAL * SIN(ZGAM) + ZV_BAL * COS(ZGAM)
+ZU_BAL = TPFLYER%INTERP_FROM_UPOINT( PU )
+ZV_BAL = TPFLYER%INTERP_FROM_VPOINT( PV )
+ZGAM = (XRPK * (TPFLYER%XLON_CUR - XLON0) - XBETA)*(XPI/180.)
+TPFLYER%XZON (1,ISTORE) = ZU_BAL * COS(ZGAM) + ZV_BAL * SIN(ZGAM)
+TPFLYER%XMER (1,ISTORE) = - ZU_BAL * SIN(ZGAM) + ZV_BAL * COS(ZGAM)
!
-TPFLYER%XW (ISTORE) = FLYER_INTERP(ZWM)
-TPFLYER%XTH (ISTORE) = FLYER_INTERP(PTH)
+TPFLYER%XW (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZWM )
+TPFLYER%XTH (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PTH )
!
-ZFLYER_EXN = FLYER_INTERP(ZEXN)
-TPFLYER%XP (ISTORE) = XP00 * ZFLYER_EXN**(XCPD/XRD)
+ZFLYER_EXN = TPFLYER%INTERP_FROM_MASSPOINT( ZEXN )
+TPFLYER%XP (1,ISTORE) = XP00 * ZFLYER_EXN**(XCPD/XRD)
ZR(:,:,:) = 0.
DO JLOOP=1,SIZE(PR,4)
- TPFLYER%XR (ISTORE,JLOOP) = FLYER_INTERP(PR(:,:,:,JLOOP))
+ TPFLYER%XR (1,ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( PR(:,:,:,JLOOP) )
IF (JLOOP>=2) ZR(:,:,:) = ZR(:,:,:) + PR(:,:,:,JLOOP)
END DO
DO JLOOP=1,SIZE(PSV,4)
- TPFLYER%XSV (ISTORE,JLOOP) = FLYER_INTERP(PSV(:,:,:,JLOOP))
+ TPFLYER%XSV (1,ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( PSV(:,:,:,JLOOP) )
END DO
-TPFLYER%XRTZ (ISTORE,:) = FLYER_INTERPZ(ZR(:,:,:))
+TPFLYER%XRTZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZR(:,:,:) )
DO JLOOP=1,SIZE(PR,4)
- TPFLYER%XRZ (ISTORE,:,JLOOP) = FLYER_INTERPZ(PR(:,:,:,JLOOP))
+ TPFLYER%XRZ (:,ISTORE,JLOOP) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,JLOOP) )
END DO
-TPFLYER%XFFZ (ISTORE,:) = FLYER_INTERPZ(SQRT(PU**2+PV**2))
+TPFLYER%XFFZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( SQRT(PU**2+PV**2) )
+
+TPFLYER%XRHOD (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PRHODREF )
IF (CCLOUD=="LIMA") THEN
- TPFLYER%XCIZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NI))
- TPFLYER%XCCZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NC))
- TPFLYER%XCRZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NR))
+ TPFLYER%XCIZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NI) )
+ TPFLYER%XCCZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NC) )
+ TPFLYER%XCRZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NR) )
ELSE IF ( CCLOUD=="ICE3" .OR. CCLOUD=="ICE4" ) THEN
- TPFLYER%XCIZ (ISTORE,:) = FLYER_INTERPZ(PCIT(:,:,:))
+ TPFLYER%XCIZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PCIT(:,:,:) )
END IF
-! initialization CRARE and CRARE_ATT + LWC and IWC
-TPFLYER%XCRARE(ISTORE,:) = 0.
-TPFLYER%XCRARE_ATT(ISTORE,:) = 0.
-TPFLYER%XLWCZ (ISTORE,:) = 0.
-TPFLYER%XIWCZ (ISTORE,:) = 0.
-IF (CCLOUD=="LIMA" .OR. CCLOUD=="ICE3" ) THEN ! only for ICE3 and LIMA
- TPFLYER%XLWCZ (ISTORE,:) = FLYER_INTERPZ((PR(:,:,:,2)+PR(:,:,:,3))*PRHODREF(:,:,:))
- TPFLYER%XIWCZ (ISTORE,:) = FLYER_INTERPZ((PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:))
- ZTEMPZ(:)=FLYER_INTERPZ(PTH(II_M:II_M+1,IJ_M:IJ_M+1,:) * ZEXN(:,:,:))
- ZRHODREFZ(:)=FLYER_INTERPZ(PRHODREF(:,:,:))
- IF (CCLOUD=="LIMA") THEN
- ZCCI(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NI))
- ZCCR(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NR))
- ZCCC(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NC))
- ELSE
- ZCIT(:)=FLYER_INTERPZ(PCIT(:,:,:))
- ENDIF
- DO JLOOP=3,6
- ZRZ(:,JLOOP)=FLYER_INTERPZ(PR(:,:,:,JLOOP))
- END DO
- if ( csurf == 'EXTE' ) then
- DO JK=1,IKU
- ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2)*PSEA(:,:)) ! becomes cloud mixing ratio over sea
- ZRZ(JK,7)=FLYER_INTERP_2D(PR(:,:,JK,2)*(1.-PSEA(:,:))) ! becomes cloud mixing ratio over land
- END DO
- else
- !if csurf/='EXTE', psea is not allocated
- DO JK=1,IKU
- ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2))
- ZRZ(JK,7) = 0.
- END DO
- end if
- ALLOCATE(ZAELOC(IKU))
- !
- ZAELOC(:)=0.
- ! initialization of quadrature points and weights
- ALLOCATE(ZX(JPTS_GAULAG),ZW(JPTS_GAULAG))
- CALL GAULAG(JPTS_GAULAG,ZX,ZW) ! for integration over diameters
- ! initialize minimum values
- ALLOCATE(ZRTMIN(SIZE(PR,4)+1))
- IF (CCLOUD == 'LIMA') THEN
- ZRTMIN(2)=XRTMIN_L(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_L(3)
- ZRTMIN(4)=XRTMIN_L(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_L(6)
- ZRTMIN(7)=XRTMIN_L(2) ! cloud water over land
- ELSE
- ZRTMIN(2)=XRTMIN_I(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_I(3)
- ZRTMIN(4)=XRTMIN_I(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_I(6)
- ZRTMIN(7)=XRTMIN_I(2) ! cloud water over land
- ENDIF
- ! compute cloud radar reflectivity from vertical profiles of temperature and mixing ratios
- DO JK=1,IKU
- QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- DO JLOOP=2,7
- IF (CCLOUD == 'LIMA') THEN
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCCI(JK)>0.).AND.&
- (JLOOP.NE.3.OR.ZCCR(JK)>0.).AND.((JLOOP.NE.2.AND. JLOOP.NE.7).OR.ZCCC(JK)>0.))
- ELSE
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCIT(JK)>0.))
- ENDIF
- IF(GCALC) THEN
- SELECT CASE(JLOOP)
- CASE(2) ! cloud water over sea
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_SEA
- ZCX=0.
- ZALPHA=XALPHAC2_I
- ZNU=XNUC2_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ENDIF
- CASE(3) ! rain water
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAR_L
- ZB=XBR_L
- ZCC=ZCCR(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAR_L
- ZNU=XNUR_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAR_I
- ZB=XBR_I
- ZCC=XCCR_I
- ZCX=-1.
- ZALPHA=XALPHAR_I
- ZNU=XNUR_I
- ZLB=XLBR_I
- ZLBEX=XLBEXR_I
- ENDIF
- CASE(4) ! pristine ice
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAI_L
- ZB=XBI_L
- ZCC=ZCCI(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAI_L
- ZNU=XNUI_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ELSE
- ZA=XAI_I
- ZB=XBI_I
- ZCC=ZCIT(JK)
- ZCX=0.
- ZALPHA=XALPHAI_I
- ZNU=XNUI_I
- ZLBEX=XLBEXI_I
- ZLB=XLBI_I*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ENDIF
- CASE(5) ! snow
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAS_L
- ZB=XBS_L
- ZCC=XCCS_L
- ZCX=XCXS_L
- ZALPHA=XALPHAS_L
- ZNU=XNUS_L
- ZNS=XNS_L
- ZLB=XLBS_L
- ZLBEX=XLBEXS_L
- ZFW=0
- ELSE
- ZA=XAS_I
- ZB=XBS_I
- ZCC=XCCS_I
- ZCX=XCXS_I
- ZALPHA=XALPHAS_I
- ZNU=XNUS_I
- ZNS=XNS_I
- ZLB=XLBS_I
- ZLBEX=XLBEXS_I
- ZFW=0
- ENDIF
- CASE(6) ! graupel
- !If temperature between -10 and 10°C and Mr and Mg over min threshold: melting graupel
- ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel (Fw=0)
- IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
- .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
- ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
- ELSE
- ZFW=0
- ENDIF
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAG_L
- ZB=XBG_L
- ZCC=XCCG_L
- ZCX=XCXG_L
- ZALPHA=XALPHAG_L
- ZNU=XNUG_L
- ZLB=XLBG_L
- ZLBEX=XLBEXG_L
- ELSE
- ZA=XAG_I
- ZB=XBG_I
- ZCC=XCCG_I
- ZCX=XCXG_I
- ZALPHA=XALPHAG_I
- ZNU=XNUG_I
- ZLB=XLBG_I
- ZLBEX=XLBEXG_I
- ENDIF
- CASE(7) ! cloud water over land
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_LAND
- ZCX=0.
- ZALPHA=XALPHAC_I
- ZNU=XNUC_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ENDIF
- END SELECT
- IF ( JLOOP == 5 .AND. CCLOUD=='LIMA'.AND.LSNOW_T_L ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE IF (JLOOP.EQ.5 .AND. (CCLOUD=='ICE3'.AND.LSNOW_T_I) ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE
- ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
- ZN=ZCC*ZLBDA**ZCX
- END IF
- ZREFLOC=0.
- ZAETMP=0.
- DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
- ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
- SELECT CASE(JLOOP)
- CASE(2,3,7)
- QM=QMW
- CASE(4,5,6)
- ! pristine ice, snow, dry graupel
- ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
- QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
-
- ! water inclusions in ice in air
- QEPSWI=MG(QMW**2,QM**2,ZFW)
- ! ice in air inclusions in water
- QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
-
- !MG weighted rule (Matrosov 2008)
- IF(ZFW .LT. 0.37) THEN
- ZFPW=0
- ELSE IF(ZFW .GT. 0.63) THEN
- ZFPW=1
- ELSE
- ZFPW=(ZFW-0.37)/(0.63-0.37)
- ENDIF
- QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
- END SELECT
- CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
- ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- END DO
- ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZN/(4.*GAMMA(ZNU)*.93)
- ZAETMP=ZAETMP * XPI *ZN/(4.*GAMMA(ZNU))
- TPFLYER%XCRARE(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)+ZREFLOC
- ZAELOC(JK)=ZAELOC(JK)+ZAETMP
- END IF
- END DO
- END DO
-
- ! apply attenuation
- ALLOCATE(ZZMZ(IKU))
- ZZMZ(:)=FLYER_INTERPZ(ZZM(:,:,:))
- ! nadir
- ZAETOT=1.
- DO JK=COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1,-1
- IF(JK.EQ.COUNT(TPFLYER%XZ_CUR >= ZZMZ(:))) THEN
- IF(TPFLYER%XZ_CUR<=ZZMZ(JK)+.5*(ZZMZ(JK+1)-ZZMZ(JK))) THEN
- ! only attenuation from ZAELOC(JK)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK)*(TPFLYER%XZ_CUR-ZZMZ(JK))))
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK+1)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK+1)*(TPFLYER%XZ_CUR-.5*(ZZMZ(JK+1)+ZZMZ(JK))) &
- +ZAELOC(JK)*.5*(ZZMZ(JK+1)-ZZMZ(JK))))
- END IF
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK+1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK+1)+ZAELOC(JK))*(ZZMZ(JK+1)-ZZMZ(JK)))
- END IF
- TPFLYER%XCRARE_ATT(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)*ZAETOT
- END DO
- ! zenith
- ZAETOT=1.
- DO JK = MAX(COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1)+1,IKU
- IF ( JK .EQ. (MAX(COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1)+1) ) THEN
- IF(TPFLYER%XZ_CUR>=ZZMZ(JK)-.5*(ZZMZ(JK)-ZZMZ(JK-1))) THEN
- ! only attenuation from ZAELOC(JK)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK)*(ZZMZ(JK)-TPFLYER%XZ_CUR)))
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK-1)*(.5*(ZZMZ(JK)+ZZMZ(JK-1))-TPFLYER%XZ_CUR) &
- +ZAELOC(JK)*.5*(ZZMZ(JK)-ZZMZ(JK-1))))
- END IF
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK-1)+ZAELOC(JK))*(ZZMZ(JK)-ZZMZ(JK-1)))
- END IF
- TPFLYER%XCRARE_ATT(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)*ZAETOT
- END DO
-
- TPFLYER%XZZ (ISTORE,:) = ZZMZ(:)
- DEALLOCATE(ZZMZ,ZAELOC)
- ! m^3 → mm^6/m^3 → dBZ
- WHERE(TPFLYER%XCRARE(ISTORE,:)>0)
- TPFLYER%XCRARE(ISTORE,:)=10.*LOG10(1.E18*TPFLYER%XCRARE(ISTORE,:))
- ELSEWHERE
- TPFLYER%XCRARE(ISTORE,:)=XUNDEF
- END WHERE
- WHERE(TPFLYER%XCRARE_ATT(ISTORE,:)>0)
- TPFLYER%XCRARE_ATT(ISTORE,:)=10.*LOG10(1.E18*TPFLYER%XCRARE_ATT(ISTORE,:))
- ELSEWHERE
- TPFLYER%XCRARE_ATT(ISTORE,:)=XUNDEF
- END WHERE
- DEALLOCATE(ZX,ZW,ZRTMIN)
-END IF ! end LOOP ICE3
+
+ZTH_EXN(:,:,:) = PTH(TPFLYER%NI_M:TPFLYER%NI_M+1, TPFLYER%NJ_M:TPFLYER%NJ_M+1, :) * ZEXN(:,:,:)
+ZZ(:) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZZM(:,:,:) )
+TPFLYER%XZZ(:,ISTORE) = ZZ(:)
+
+CALL Sensor_wc_compute( TPFLYER, ISTORE, PR, PRHODREF )
+CALL Sensor_rare_compute( TPFLYER, ISTORE, PR, PSV, PRHODREF, PCIT, ZTH_EXN, ZZ, PSEA )
+
! vertical wind
-TPFLYER%XWZ (ISTORE,:) = FLYER_INTERPZ(ZWM(:,:,:))
-IF (SIZE(PTKE)>0) TPFLYER%XTKE (ISTORE) = FLYER_INTERP(PTKE)
-IF (SIZE(PTS) >0) TPFLYER%XTSRAD(ISTORE) = FLYER_INTERP_2D(PTS)
-TPFLYER%XTKE_DISS(ISTORE) = FLYER_INTERP(XCURRENT_TKE_DISS)
-TPFLYER%XZS(ISTORE) = FLYER_INTERP_2D(PZ(:,:,1+JPVEXT))
-TPFLYER%XTHW_FLUX(ISTORE) = FLYER_INTERP(ZTHW_FLUX)
-TPFLYER%XRCW_FLUX(ISTORE) = FLYER_INTERP(ZRCW_FLUX)
+TPFLYER%XWZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZWM(:,:,:) )
+
+! Dry air density at flyer position
+TPFLYER%XRHOD_SENSOR(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PRHODREF )
+
+IF (SIZE(PTKE)>0) TPFLYER%XTKE (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PTKE )
+IF ( CRAD /= 'NONE' ) TPFLYER%XTSRAD(ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT(PTS )
+TPFLYER%XTKE_DISS(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( XCURRENT_TKE_DISS )
+TPFLYER%XZS(ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PZ(:,:,1+JPVEXT) )
+TPFLYER%XTHW_FLUX(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZTHW_FLUX )
+TPFLYER%XRCW_FLUX(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZRCW_FLUX )
DO JLOOP=1,SIZE(PSV,4)
-TPFLYER%XSVW_FLUX(ISTORE,JLOOP) = FLYER_INTERP(ZSVW_FLUX(:,:,:,JLOOP))
+TPFLYER%XSVW_FLUX(ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( ZSVW_FLUX(:,:,:,JLOOP) )
END DO
END SUBROUTINE FLYER_RECORD_DATA
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZXCOEF) * ( (1.-ZZCOEF00) * PA(JI ,JJ ,IK00) + ZZCOEF00 * PA(JI ,JJ ,IK00+1)) &
- + (1.- ZYCOEF) * ( ZXCOEF) * ( (1.-ZZCOEF10) * PA(JI+1,JJ ,IK10) + ZZCOEF10 * PA(JI+1,JJ ,IK10+1)) &
- + ( ZYCOEF) * (1.-ZXCOEF) * ( (1.-ZZCOEF01) * PA(JI ,JJ+1,IK01) + ZZCOEF01 * PA(JI ,JJ+1,IK01+1)) &
- + ( ZYCOEF) * ( ZXCOEF) * ( (1.-ZZCOEF11) * PA(JI+1,JJ+1,IK11) + ZZCOEF11 * PA(JI+1,JJ+1,IK11+1))
-!
-END FUNCTION FLYER_INTERP
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERPZ(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL, DIMENSION(SIZE(PA,3)) :: PB
-!
-INTEGER :: JI, JJ, JK
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-!
-DO JK=1,SIZE(PA,3)
- IF ( (PA(JI,JJ,JK) /= XUNDEF) .AND. (PA(JI+1,JJ,JK) /= XUNDEF) .AND. &
- (PA(JI,JJ+1,JK) /= XUNDEF) .AND. (PA(JI+1,JJ+1,JK) /= XUNDEF) ) THEN
- PB(JK) = (1.-ZYCOEF) * (1.-ZXCOEF) * PA(JI,JJ,JK) + &
- (1.-ZYCOEF) * (ZXCOEF) * PA(JI+1,JJ,JK) + &
- (ZYCOEF) * (1.-ZXCOEF) * PA(JI,JJ+1,JK) + &
- (ZYCOEF) * (ZXCOEF) * PA(JI+1,JJ+1,JK)
- ELSE
- PB(JK) = XUNDEF
- END IF
-END DO
-!
-END FUNCTION FLYER_INTERPZ
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_U(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_U
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZUCOEF) * ( (1.-ZUCOEF00) * PA(JI ,JJ ,IU00) + ZUCOEF00 * PA(JI ,JJ ,IU00+1)) &
- + (1.- ZYCOEF) * ( ZUCOEF) * ( (1.-ZUCOEF10) * PA(JI+1,JJ ,IU10) + ZUCOEF10 * PA(JI+1,JJ ,IU10+1)) &
- + ( ZYCOEF) * (1.-ZUCOEF) * ( (1.-ZUCOEF01) * PA(JI ,JJ+1,IU01) + ZUCOEF01 * PA(JI ,JJ+1,IU01+1)) &
- + ( ZYCOEF) * ( ZUCOEF) * ( (1.-ZUCOEF11) * PA(JI+1,JJ+1,IU11) + ZUCOEF11 * PA(JI+1,JJ+1,IU11+1))
-!
-END FUNCTION FLYER_INTERP_U
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_V(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_V
-END IF
-!
-PB = (1.- ZVCOEF) * (1.-ZXCOEF) * ( (1.-ZVCOEF00) * PA(JI ,JJ ,IV00) + ZVCOEF00 * PA(JI ,JJ ,IV00+1)) &
- + (1.- ZVCOEF) * ( ZXCOEF) * ( (1.-ZVCOEF10) * PA(JI+1,JJ ,IV10) + ZVCOEF10 * PA(JI+1,JJ ,IV10+1)) &
- + ( ZVCOEF) * (1.-ZXCOEF) * ( (1.-ZVCOEF01) * PA(JI ,JJ+1,IV01) + ZVCOEF01 * PA(JI ,JJ+1,IV01+1)) &
- + ( ZVCOEF) * ( ZXCOEF) * ( (1.-ZVCOEF11) * PA(JI+1,JJ+1,IV11) + ZVCOEF11 * PA(JI+1,JJ+1,IV11+1))
-!
-END FUNCTION FLYER_INTERP_V
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_2D(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZXCOEF) * PA(JI ,JJ ) &
- + (1.- ZYCOEF) * ( ZXCOEF) * PA(JI+1,JJ ) &
- + ( ZYCOEF) * (1.-ZXCOEF) * PA(JI ,JJ+1) &
- + ( ZYCOEF) * ( ZXCOEF) * PA(JI+1,JJ+1)
-!
-END FUNCTION FLYER_INTERP_2D
-!----------------------------------------------------------------------------
-
END SUBROUTINE AIRCRAFT_BALLOON_EVOL
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
@@ -1591,30 +1094,5 @@ END IF
END SUBROUTINE FLYER_GET_RANK_MODEL_ISCRASHED
!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_CHECK_STORESTEP( TPFLYER )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
-
-USE MODE_STATPROF_TOOLS, ONLY: STATPROF_INSTANT
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER ! balloon/aircraft
-
-INTEGER :: ISTORE
-
-!Remark: TPFLYER%TFLYER_TIME%N_CUR and %TPDATES are updated in STATPROF_INSTANT
-CALL STATPROF_INSTANT( TPFLYER%TFLYER_TIME, ISTORE )
-
-IF ( ISTORE < 1 ) THEN
- !No profiler storage at this time step
- TPFLYER%LSTORE = .FALSE.
-ELSE
- TPFLYER%LSTORE = .TRUE.
-END IF
-
-END SUBROUTINE FLYER_CHECK_STORESTEP
-!----------------------------------------------------------------------------
END MODULE MODE_AIRCRAFT_BALLOON_EVOL
diff --git a/src/MNH/ch_aer_coag.f90 b/src/MNH/ch_aer_coag.f90
index 87a97af5cb13d02cfe303f8e431a97330568cfb0..4e50174f9f637fed1dac8a6c648e773e8cfb21b4 100644
--- a/src/MNH/ch_aer_coag.f90
+++ b/src/MNH/ch_aer_coag.f90
@@ -14,15 +14,15 @@
!!
INTERFACE
!!
-SUBROUTINE CH_AER_COAG(PM, PSIG0, PRG0, PN0,PDMINTRA,PDMINTER,PTGAS,PMU,&
- PLAMBDA,PRHOP0)
+SUBROUTINE CH_AER_COAG(PM,PLNSIG,PRG,PN,PDMINTRA,PDMINTER,&
+ PTEMP,PMU,PLAMBDA,PRHOP )
IMPLICIT NONE
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PM,PRHOP0
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PM,PRHOP
REAL, DIMENSION(:), INTENT(INOUT) :: PLAMBDA, PMU
REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA
REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTER
-REAL, DIMENSION(:),INTENT(IN) :: PTGAS
-REAL, DIMENSION(:,:), INTENT(IN) :: PSIG0, PRG0, PN0
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP
+REAL, DIMENSION(:,:), INTENT(IN) :: PLNSIG, PRG, PN
END SUBROUTINE CH_AER_COAG
!!
END INTERFACE
@@ -30,59 +30,43 @@ END INTERFACE
END MODULE MODI_CH_AER_COAG
!!
!! #############################################
- SUBROUTINE CH_AER_COAG(PM, PSIG0, PRG0, PN0,PDMINTRA,PDMINTER,PTGAS,PMU,&
- PLAMBDA,PRHOP0)
+ SUBROUTINE CH_AER_COAG(PM,PLNSIG,PRG,PN,PDMINTRA,PDMINTER,&
+ PTEMP,PMU,PLAMBDA,PRHOP )
!! #############################################
!!
!! PURPOSE
!! -------
-!!
-!! compute the terms due to Brownian, turbulent and Gravitational
-!! coagulation:
+!! Compute the terms due to Brownian, turbulent and gravitational
+!! coagulation:
!! a set of arrays are used to evaluate the double integral
-!! REFERENCE
-!! ---------
-!! none
+!! Based on Whitby et al. 1991 : Appendix H
!!
-!! AUTHOR
-!! ------
-!! Vincent Crassier (LA)
+!! METHOD
+!! ------
+!! * Arrays of numerical evaluation of coagulation terms
+!! in the free-molecule regime (computed from the ESMAP code)
+!! ZINTRA - Intamodal coagulation, mode i,j 0th and 6th Moment
+!! ZINTER0I - Intermodal coagulation, mode i, 0th Moment
+!! ZINTER3I - Intermodal coagulation, mode i, 3rd Moment
+!! ZINTER6I - Intermodal coagulation, mode i, 6th Moment
+!! ZINTER6J - Intermodal coagulation, mode j, 6th Moment
!!
-!! MODIFICATIONS
-!! -------------
-!*****************************************************************
-! * Arrays of numerical evaluation of coagulation terms
-! in the free-molecule regime (computed from the ESMAP code)
-!
-! ZINTRA - Intamodal coagulation, mode i,j 0th and 6th Moment
-!
-! ZINTER0I - Intermodal coagulation, mode i, 0th Moment
-! ZINTER3I - Intermodal coagulation, mode i, 3rd Moment
-! ZINTER6I - Intermodal coagulation, mode i, 6th Moment
-! ZINTER6J - Intermodal coagulation, mode j, 6th Moment
-!
-! * Variables used during the coefficients evaluation
-! ZXI(i) - Variables values at the array nodes
-! ZXINT(i) - Variables values where the interpolation
-! is to be made
-!
-! intramodal coagulation
-!
-! ZXINTRAMIN - Minimal value of ln(sigma)
-! ZXINTRAMAX - Maximal value of ln(sigma)
-! ZDXINTRA - Step of ln(sigma) in the array
-!
-! intermodal coagulation
-!
-! ZXINTERMIN(i) - Minimal value of the variable i
-! ZXINTERMAX(i) - Maximal value of the variable i
-! ZDXINTER(i) - Step of the variable i in the arrays
-!
-! i=1 - ln(sigmaj)
-! i=2 - ln(sigmai)
-! i=3 - ln((ZR=Rgj/Rgi)**2)
-!
-!***************************************************************
+!! * Variables used during the coefficients evaluation
+!! ZXINT(i) - Variables values where the interpolation
+!! is to be made
+!!
+!! * intramodal coagulation terms
+!! ZXINTRAMIN - Minimal value of ln(sigma)
+!! ZXINTRAMAX - Maximal value of ln(sigma)
+!! ZDXINTRA - Step of ln(sigma) in the array
+!!
+!! * intermodal coagulation terms:
+!! ZXINTERMIN(i) - Minimal value of the variable i
+!! ZXINTERMAX(i) - Maximal value of the variable i
+!! ZDXINTER(i) - Step of the variable i in the arrays
+!! i=1 - ln(sigmaj)
+!! i=2 - ln(sigmai)
+!! i=3 - ln((ZR=Rgj/Rgi)**2)
!!
!! EXTERNAL
!! -------
@@ -90,336 +74,261 @@ END MODULE MODI_CH_AER_COAG
!! IMPLICIT ARGUMENTS
!! ------------------
!!
-USE MODD_CH_AEROSOL
-USE MODD_CST, ONLY : &
- XPI & !Definition of pi
- ,XBOLTZ ! Boltzman constant
+!! REFERENCE
+!! ---------
+!! none
!!
+!! AUTHOR
+!! ------
+!! Vincent Crassier (LA)
+!!
+!! MODIFICATIONS
+!! -------------
+!! October 2018 J. Pianezze - Add comments, cleaning and debug
+!! + move mode merging into ch_aer_driver
+!!
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CH_AEROSOL
+USE MODD_CST, ONLY : XPI, XBOLTZ
+USE MODD_CONF, ONLY : NVERB
+!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PM,PRHOP0
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PM,PRHOP
REAL, DIMENSION(:), INTENT(INOUT) :: PLAMBDA, PMU
REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA
REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTER
-REAL, DIMENSION(:),INTENT(IN) :: PTGAS
-REAL, DIMENSION(:,:), INTENT(IN) :: PSIG0, PRG0, PN0
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP
+REAL, DIMENSION(:,:), INTENT(IN) :: PLNSIG, PRG, PN
!
!* 0.2 Declarations of local variables
!
-INTEGER :: JI,JJ
+INTEGER :: JI,JJ
!
-REAL :: ZTURBDS ! Rate of dissipation of kinetic energy per unit mass (m2/s3)
+REAL, DIMENSION(SIZE(PM,1)) :: ZKFM,ZKNC
+REAL, DIMENSION(SIZE(PM,1)) :: ZR,ZR2,ZR4
+REAL, DIMENSION(SIZE(PM,1)) :: ZRM,ZRM2,ZRM3
+REAL, DIMENSION(SIZE(PM,1)) :: ZKNG
+REAL, DIMENSION(SIZE(PM,1)) :: ZAI,ZKNGI,ZAJ,ZKNGJ
+REAL, DIMENSION(SIZE(PM,1)) :: ZINTRA0NC,ZINTRA0FM,ZINTRA0
+REAL, DIMENSION(SIZE(PM,1)) :: ZINTRA6NC,ZINTRA6FM,ZINTRA6
+REAL, DIMENSION(SIZE(PM,1)) :: ZINTERNC,ZINTERFM,ZINTER
+REAL, DIMENSION(SIZE(PM,1)) :: ZAPPROX
!
-REAL, DIMENSION(SIZE(PM,1)) :: ZKFM,ZKNC
-!REAL, DIMENSION(SIZE(PM,1)) :: ZKTURB,ZKGRAV,ZR3,ZRM4
-REAL, DIMENSION(SIZE(PM,1)) :: ZR,ZR2,ZR4
-REAL, DIMENSION(SIZE(PM,1)) :: ZRM,ZRM2,ZRM3
-REAL, DIMENSION(SIZE(PM,1)) :: ZKNG
-REAL, DIMENSION(SIZE(PM,1)) :: ZAI,ZKNGI,ZAJ,ZKNGJ
-REAL, DIMENSION(SIZE(PM,1)) :: ZINTRA0NC,ZINTRA0FM,ZINTRA0
-REAL, DIMENSION(SIZE(PM,1)) :: ZINTRA3NC,ZINTRA3FM,ZINTRA3
-REAL, DIMENSION(SIZE(PM,1)) :: ZINTRA6NC,ZINTRA6FM,ZINTRA6
-REAL, DIMENSION(SIZE(PM,1)) :: ZINTERNC,ZINTERFM,ZINTER
-REAL, DIMENSION(SIZE(PM,1)) :: ZAPPROX
+REAL, DIMENSION(SIZE(PM,1)) :: ZRGJ, ZRGI, ZRG
!
-REAL, DIMENSION(SIZE(PM,1)) :: ZA,ZB,ZC,ZD
-REAL, DIMENSION(SIZE(PM,1)) :: ZRGJ, ZRGI, ZRG
+REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG01,ZESG04,ZESG05,ZESG08,ZESG09
+REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG12,ZESG16
+REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG20,ZESG24,ZESG25,ZESG28
+REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG32,ZESG36
+REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG49
+REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG52
+REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG64
+REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG81,ZESG85
+REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG100,ZESG121,ZESG144,ZESG169,ZESG196
+REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG256
+REAL, DIMENSION(SIZE(PM,1)) :: ZRB0,ZRB6
+REAL, DIMENSION(SIZE(PM,1)) :: ZRES
!
-REAL, DIMENSION(SIZE(PM,1)) :: ZERF0,ZPHI0,ZXi,ZSOL
-REAL, DIMENSION(SIZE(PM,1)) :: ZERF3,ZPHI3
-REAL, DIMENSION(SIZE(PM,1)) :: ZERF6,ZPHI6
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZINVSIG,ZLNDG
+!-------------------------------------------------------------------------------
!
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG01,ZESG04,ZESG05,ZESG08,ZESG09
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG12,ZESG16
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG20,ZESG24,ZESG25,ZESG28
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG32,ZESG36
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG49
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG52
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG64
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG81,ZESG85
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG100,ZESG121,ZESG144,ZESG169,ZESG196
-REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZESG256
-REAL, DIMENSION(SIZE(PM,1)) :: ZRB0,ZRB6
-REAL, DIMENSION(SIZE(PM,1)) :: ZRES
-!-------------------------------------------------------------------------------!
-ZTURBDS=0.001
-ZKNC(:)=2.*XBOLTZ*PTGAS(:)/(3.*PMU(:))
+!* 1. INITIALIZATION
+! --------------
!
-PDMINTRA(:,:)=0.
-PDMINTER(:,:)=0.
+PDMINTRA(:,:) = 0.0
+PDMINTER(:,:) = 0.0
!
-!****************************************************************
-! Initialisation des variables utilisees dans le calcul des
-! coefficients de coagulation
-!****************************************************************
-
-ZESG01(:,:) = exp(0.125*PSIG0(:,1:JPMODE)**2)
-ZESG04(:,:) = ZESG01(:,:) ** 4
-ZESG05(:,:) = ZESG04(:,:) * ZESG01(:,:)
-ZESG08(:,:) = ZESG04(:,:) * ZESG04(:,:)
-ZESG09(:,:) = ZESG04(:,:) * ZESG05(:,:)
-ZESG12(:,:) = ZESG04(:,:) * ZESG04(:,:) * ZESG04(:,:)
-ZESG16(:,:) = ZESG08(:,:) * ZESG08(:,:)
-ZESG20(:,:) = ZESG16(:,:) * ZESG04(:,:)
-ZESG24(:,:) = ZESG12(:,:) * ZESG12(:,:)
-ZESG25(:,:) = ZESG16(:,:) * ZESG09(:,:)
-ZESG28(:,:) = ZESG20(:,:) * ZESG08(:,:)
-ZESG32(:,:) = ZESG16(:,:) * ZESG16(:,:)
-ZESG36(:,:) = ZESG16(:,:) * ZESG20(:,:)
-ZESG49(:,:) = ZESG25(:,:) * ZESG20(:,:) * ZESG04(:,:)
-ZESG52(:,:) = ZESG16(:,:) * ZESG36(:,:)
-ZESG64(:,:) = ZESG32(:,:) * ZESG32(:,:)
-ZESG81(:,:) = ZESG49(:,:) * ZESG32(:,:)
-ZESG85(:,:) = ZESG64(:,:) * ZESG20(:,:) * ZESG01(:,:)
-ZESG100(:,:) = ZESG36(:,:) * ZESG64(:,:)
-ZESG121(:,:) = ZESG85(:,:) * ZESG36(:,:)
-ZESG144(:,:) = ZESG100(:,:) * ZESG36(:,:) * ZESG08(:,:)
-ZESG169(:,:) = ZESG144(:,:) * ZESG25(:,:)
-ZESG196(:,:) = ZESG144(:,:) * ZESG52(:,:)
+ZKNC(:) = 2.*XBOLTZ*PTEMP(:)/(3.*PMU(:))
+!
+! Compute coagulation coefficients : Whitby et al. 1991 : Appendix H
+!
+ZESG01 (:,:) = EXP(0.125*PLNSIG(:,:)**2)
+ZESG04 (:,:) = ZESG01 (:,:) ** 4
+ZESG05 (:,:) = ZESG04 (:,:) * ZESG01 (:,:)
+ZESG08 (:,:) = ZESG04 (:,:) * ZESG04 (:,:)
+ZESG09 (:,:) = ZESG04 (:,:) * ZESG05 (:,:)
+ZESG12 (:,:) = ZESG04 (:,:) * ZESG04 (:,:) * ZESG04(:,:)
+ZESG16 (:,:) = ZESG08 (:,:) * ZESG08 (:,:)
+ZESG20 (:,:) = ZESG16 (:,:) * ZESG04 (:,:)
+ZESG24 (:,:) = ZESG12 (:,:) * ZESG12 (:,:)
+ZESG25 (:,:) = ZESG16 (:,:) * ZESG09 (:,:)
+ZESG28 (:,:) = ZESG20 (:,:) * ZESG08 (:,:)
+ZESG32 (:,:) = ZESG16 (:,:) * ZESG16 (:,:)
+ZESG36 (:,:) = ZESG16 (:,:) * ZESG20 (:,:)
+ZESG49 (:,:) = ZESG25 (:,:) * ZESG20 (:,:) * ZESG04(:,:)
+ZESG52 (:,:) = ZESG16 (:,:) * ZESG36 (:,:)
+ZESG64 (:,:) = ZESG32 (:,:) * ZESG32 (:,:)
+ZESG81 (:,:) = ZESG49 (:,:) * ZESG32 (:,:)
+ZESG85 (:,:) = ZESG64 (:,:) * ZESG20 (:,:) * ZESG01(:,:)
+ZESG100(:,:) = ZESG36 (:,:) * ZESG64 (:,:)
+ZESG121(:,:) = ZESG85 (:,:) * ZESG36 (:,:)
+ZESG144(:,:) = ZESG100(:,:) * ZESG36 (:,:) * ZESG08(:,:)
+ZESG169(:,:) = ZESG144(:,:) * ZESG25 (:,:)
+ZESG196(:,:) = ZESG144(:,:) * ZESG52 (:,:)
ZESG256(:,:) = ZESG144(:,:) * ZESG100(:,:) * ZESG12(:,:)
-
-!***************************************************************
-! Transfert de moments entre les modes i et j
-!***************************************************************
-
-ZINVSIG(:,:)=1./PSIG0(:,1:JPMODE)**2
-ZLNDG(:,:)=log(2.*PRG0(:,1:JPMODE))
-
-ZA(:)=0.5*(ZINVSIG(:,1)-ZINVSIG(:,2))
-ZD(:) = 0.
-ZXi(:)= 0.
-
-WHERE (ABS(ZA(:)) > 1E-4)
- ZB(:)=ZINVSIG(:,2)*ZLNDG(:,2)-ZINVSIG(:,1)*ZLNDG(:,1)
- ZC(:)=0.5*(ZINVSIG(:,1)*ZLNDG(:,1)**2-ZINVSIG(:,2)*ZLNDG(:,2)**2) - &
- &log((PN0(:,1)*PSIG0(:,2))/(PN0(:,2)*PSIG0(:,1)))
-
- ZD(:)=ZB(:)**2-4.*ZA(:)*ZC(:)
-
- ZSOL(:)=(-ZB(:)+sqrt(ABS(ZD(:))))/(2.*ZA(:))
- WHERE (ZSOL(:) < 5.E+2)
- ZSOL(:)=exp(ZSOL(:))/2.
- ZXi(:)=log(ZSOL(:)/PRG0(:,1))/(sqrt(2.)*PSIG0(:,1))
- ENDWHERE
-ENDWHERE
-
-!*********************************************************************
-! calculate the intramodal moment coefficients (log-normal model)
-!*********************************************************************
-
-do JI=1,JPMODE
-
- ZKFM(:)=sqrt(3.*XBOLTZ*PTGAS(:)/PRHOP0(:,JI))*1.e-3
- !ZKTURB(:)=sqrt(XPI*ZTURBDS*PMU(:)/(120.*PRHOP0(:,JI)))*1.e-18
- !ZKGRAV(:)=1.5/4.*0.544*XPI*PRHOP0(:,JI)/PMU(:)*1.e-24
-!*************************************************************
-! calculate ZVG,ln2(sigma) and sigma
-! (log-normal model)
-!*************************************************************
-
- ZRG(:)=PRG0(:,JI)
- ZKNG(:)=PLAMBDA(:)/ZRG(:)
- ZAI(:)=1.392*ZKNG(:)**0.0783
-
-!***********************
-! Brownian Coagulation
-!***********************
-
- ZRB0(:)=0.8
- ZRB6(:)=ZRB0
-
- ZINTRA0FM(:)=ZKFM(:)*ZRB0(:)*sqrt(2.*ZRG(:))*(ZESG01(:,JI)+ZESG25(:,JI)+2.*ZESG05(:,JI))
- ZINTRA3FM(:)=ZKFM(:)*ZRB0(:)*sqrt(ZRG(:))**7*sqrt(2.)*(ZESG49(:,JI)+ZESG36(:,JI)*ZESG01(:,JI)+&
- &2.*ZESG25(:,JI)*ZESG04(:,JI)+ZESG09(:,JI)*ZESG16(:,JI)+ZESG100(:,JI)*ZESG09(:,JI)+&
- &2.*ZESG64(:,JI)*ZESG01(:,JI))
- ZINTRA6FM(:)=ZKFM(:)*ZRB6(:)*sqrt(ZRG(:))**13*sqrt(2.)*ZESG85(:,JI)*&
- (1.+2.*ZESG04(:,JI)+ZESG24(:,JI))
- ZINTRA0NC(:)=ZKNC(:)*(1.+ZESG08(:,JI)+ZAI(:)*ZKNG(:)*(ZESG20(:,JI)+ZESG04(:,JI)))
- ZINTRA3NC(:)=ZKNC(:)*ZRG(:)**3*(2.*ZESG36(:,JI)+ZAI(:)*ZKNG(:)*(ZESG16(:,JI)+ZESG04(:,JI)*ZESG04(:,JI)+&
- &ZESG36(:,JI)*ZESG04(:,JI)+ZESG64(:,JI)*ZESG16(:,JI))+ZESG16(:,JI)*ZESG04(:,JI)+&
- &ZESG64(:,JI)*ZESG04(:,JI))
- ZINTRA6NC(:)=2.*ZKNC(:)*(ZRG(:))**6*ZESG52(:,JI)*(ZESG20(:,JI)+ZESG28(:,JI)+ZAI(:)*ZKNG(:)*(1.+ZESG16(:,JI)))
- ZINTRA0(:)=ZINTRA0FM(:)*(ZINTRA0NC(:)/(ZINTRA0FM(:)+ZINTRA0NC(:)))
- ZINTRA3(:)=ZINTRA3FM(:)*(ZINTRA3NC(:)/(ZINTRA3FM(:)+ZINTRA3NC(:)))
- ZINTRA6(:)=ZINTRA6FM(:)*(ZINTRA6NC(:)/(ZINTRA6FM(:)+ZINTRA6NC(:)))
-
- PDMINTRA(:,NM0(JI))=ZINTRA0(:)
- PDMINTRA(:,NM3(JI))=ZINTRA3(:)
- PDMINTRA(:,NM6(JI))=ZINTRA6(:)
- !print*,'PDMINTRA(:,NM0(',JI,') =',MINVAL(PDMINTRA(:,NM0(JI))), MAXVAL(PDMINTRA(:,NM0(JI)))
- !print*,'PDMINTRA(:,NM3(',JI,') =',MINVAL(PDMINTRA(:,NM3(JI))), MAXVAL(PDMINTRA(:,NM3(JI)))
- !print*,'PDMINTRA(:,NM6(',JI,') =',MINVAL(PDMINTRA(:,NM6(JI))), MAXVAL(PDMINTRA(:,NM6(JI)))
-
-enddo
-!print*,'=============================='
-!print*,'=============================='
-
-WHERE (ZD(:) > 0. .AND. ZXi(:) > (6.*PSIG0(:,1)/sqrt(2.)))
-
-! transfert du moment d'ordre 0 (nombre)
-!**************************************
-
- ZERF0(:)=sqrt(1.-exp(-4.*(ZXi(:))**2/XPI))
- ZPHI0(:)=0.5*(1.+ZERF0(:))
-
-! transfert du moment d'ordre 3 (masse)
-!**************************************
-
- ZERF3(:)=sqrt(1.-exp(-4.*(ZXi(:)-3.*PSIG0(:,1)/sqrt(2.))**2/XPI))
- ZPHI3(:)=0.5*(1.+ZERF3(:))
-
-! transfert du moment d'ordre 6 (dispersion)
-!**************************************
-
- ZERF6(:)=sqrt(1.-exp(-4.*(ZXi(:)-6.*PSIG0(:,1)/sqrt(2.))**2/XPI))
- ZPHI6(:)=0.5*(1.+ZERF6(:))
-
- PDMINTRA(:,NM0(2))=PDMINTRA(:,NM0(2))-(1.-ZPHI0(:)**2)*PDMINTRA(:,NM0(1))*(PM(:,NM0(1))/PM(:,NM0(2)))**2
- PDMINTRA(:,NM0(1))=(2.-ZPHI0(:)**2)*PDMINTRA(:,NM0(1))
-
- PDMINTRA(:,NM3(2))=PDMINTRA(:,NM3(1))*(1.-ZPHI0(:)*ZPHI3(:))*PM(:,NM0(1))**2
- PDMINTRA(:,NM3(1))=PDMINTRA(:,NM3(1))*(ZPHI0(:)*ZPHI3(:)-1.)*PM(:,NM0(1))**2
-
- ZKFM(:)=sqrt(3.*XBOLTZ*PTGAS(:)/PRHOP0(:,1))*1.e-3
- ZRG(:)=PRG0(:,1)
- ZKNG(:)=PLAMBDA(:)/ZRG(:)
- ZAI(:)=1.392*ZKNG(:)**0.0783
-
- ZINTRA6FM(:)=ZKFM(:)*sqrt(2.)*sqrt(ZRG(:))**13*(ZESG169(:,1)+ZESG144(:,1)*ZESG01(:,1)+&
- 2.*ZESG121(:,1)*ZESG04(:,1)+ZESG81(:,1)*ZESG16(:,1)+&
- ZESG256(:,1)*ZESG09(:,1)+ZESG196(:,1)*ZESG01(:,1))
-
- ZINTRA6NC(:)=ZKNC(:)*(ZRG(:))**6*(2.*ZESG144(:,1)+ZAI(:)*ZKNG(:)*(ZESG100(:,1)+&
- ZESG64(:,1)*ZESG04(:,1))+ZAI(:)*ZKNG(:)*(ZESG144(:,1)*ZESG04(:,1)+&
- ZESG196(:,1)*ZESG16(:,1))+ZESG100(:,1)*ZESG04(:,1)+&
- ZESG196(:,1)*ZESG04(:,1))
-
- ZINTRA6(:)=ZINTRA6FM(:)*(ZINTRA6NC(:)/(ZINTRA6FM(:)+ZINTRA6NC(:)))
-
- PDMINTRA(:,NM6(2))=PDMINTRA(:,NM6(2))+(PDMINTRA(:,NM6(1))*(1.-ZPHI3(:)**2)+ZINTRA6(:)*(1.-ZPHI0(:)*ZPHI6(:)))&
- &*(PM(:,NM0(1))/PM(:,NM0(2)))**2
-
- PDMINTRA(:,NM6(1))=PDMINTRA(:,NM6(1))*(ZPHI3(:)**2)+ZINTRA6(:)*(ZPHI0(:)*ZPHI6(:)-1.)
-
-ELSEWHERE
-
- PDMINTRA(:,NM3(1))=0.
- PDMINTRA(:,NM3(2))=0.
-
-
-ENDWHERE
-
-do JI=1,JPMODE
-!print*,'2.-ZPHI0(:)**2 =',MINVAL(2.-ZPHI0(:)**2), MAXVAL(2.-ZPHI0(:)**2)
-! print*,'apres corr PDMINTRA(:,NM0(',JI,') =',MINVAL(PDMINTRA(:,NM0(JI))), MAXVAL(PDMINTRA(:,NM0(JI)))
-! print*,'apres corr PDMINTRA(:,NM3(',JI,') =',MINVAL(PDMINTRA(:,NM3(JI))), MAXVAL(PDMINTRA(:,NM3(JI)))
-! print*,'apres corr PDMINTRA(:,NM6(',JI,') =',MINVAL(PDMINTRA(:,NM6(JI))), MAXVAL(PDMINTRA(:,NM6(JI)))
- enddo
-
-!*********************************************************************
-! calculate the intermodal moment coefficients (log-normal model)
-!*********************************************************************
-
-do JI=1,(JPMODE-1)
- do JJ=(JI+1),JPMODE
-
- ZRGI(:)=PRG0(:,JI)
- ZKNGI(:)=PLAMBDA(:)/ZRGI(:)
- ZAI(:)=1.392*ZKNGI(:)**0.0783
-
- ZRGJ(:)=PRG0(:,JJ)
- ZKNGJ(:)=PLAMBDA(:)/ZRGJ(:)
- ZAJ(:)=1.392*ZKNGJ(:)**0.0783
-
- ZR(:)=sqrt(ZRGJ(:)/ZRGI(:))
- ZR2(:)=ZR(:)*ZR(:)
- !ZR3(:)=ZR(:)*ZR2(:)
- ZR4(:)=ZR2(:)*ZR2(:)
- ZRM(:)=1./ZR(:)
- ZRM2(:)=ZRM(:)*ZRM(:)
- ZRM3(:)=ZRM(:)*ZRM2(:)
- !ZRM4(:)=ZRM2(:)*ZRM2(:)
-
-!**********************
-! Brownian Coagulation
-!**********************
-
- ZRES(:)=0.9
-
- ZAPPROX(:)=sqrt(2.*ZRGI(:))*(ZESG01(:,JI)+ZR(:)*ZESG01(:,JJ)+2.*ZR2(:)*ZESG01(:,JI)*ZESG04(:,JJ)&
- +ZR4(:)*ZESG09(:,JI)*ZESG16(:,JJ)+ZRM3(:)*ZESG16(:,JI)*ZESG09(:,JJ)+&
- 2.*ZRM(:)*ZESG04(:,JI)*ZESG01(:,JJ))
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE INTRA-MODAL COAGULATION TERMS
+! -------------------------------------
+!
+DO JI=1,JPMODE
+ !
+ !* 2.0 INITIALIZATION
+ ! --------------
+ !
+ ZRG(:) = PRG(:,JI)
+ ZKNG(:) = PLAMBDA(:)/ZRG(:)
+ ZAI(:) = 1.392*ZKNG(:)**0.0783
+ ZKFM(:) = SQRT(3.*XBOLTZ*PTEMP(:)/PRHOP(:,JI))*1.E-3
+ !
+ ZRB0(:) = 0.8
+ ZRB6(:) = ZRB0
+ !
+ !* 2.1 FREE-MOLECULE REGIME (KN > 10)
+ ! ------------------------------
+ !
+ ZINTRA0FM(:) = ZKFM(:) * ZRB0(:) * SQRT(2.*ZRG(:)) * &
+ & (ZESG01(:,JI)+ZESG25(:,JI)+2.*ZESG05(:,JI))
+ ZINTRA6FM(:) = ZKFM(:)*ZRB6(:)*sqrt(ZRG(:))**13*sqrt(2.)*ZESG85(:,JI) * &
+ & (1.+2.*ZESG04(:,JI)+ZESG24(:,JI))
+ !
+ !* 2.2 NEAR-CONTINUUM (KN < 0.1)
+ ! -------------------------
+ !
+ ZINTRA0NC(:) = ZKNC(:)*(1.+ZESG08(:,JI)+ZAI(:)*ZKNG(:)*(ZESG20(:,JI)+ZESG04(:,JI)))
+ ZINTRA6NC(:) = 2.*ZKNC(:)*(ZRG(:))**6*ZESG52(:,JI)*(ZESG20(:,JI)+ZESG28(:,JI)+&
+ ZAI(:)*ZKNG(:)*(1.+ZESG16(:,JI)))
+ !
+ !* 2.3 HARMONIC MEAN
+ ! -------------
+ !
+ ZINTRA0(:) = ZINTRA0FM(:)*(ZINTRA0NC(:) / (ZINTRA0FM(:)+ZINTRA0NC(:)))
+ ZINTRA6(:) = ZINTRA6FM(:)*(ZINTRA6NC(:) / (ZINTRA6FM(:)+ZINTRA6NC(:)))
+ !
+ PDMINTRA(:,NM0(JI)) = - ZINTRA0(:) * PM(:,NM0(JI))**2.0
+ PDMINTRA(:,NM3(JI)) = 0.0
+ PDMINTRA(:,NM6(JI)) = ZINTRA6(:) * PM(:,NM0(JI))**2.0
+ !
+ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTE INTER-MODAL COAGULATION TERMS
+! -------------------------------------
+!
+! JPMODE = 2
+! donc :
+! - JI = 1
+! - JJ = 2
+!
+DO JI=1,(JPMODE-1)
+ DO JJ=(JI+1),JPMODE
+ !
+ ZRGI (:) = PRG(:,JI)
+ ZKNGI(:) = PLAMBDA(:)/ZRGI(:)
+ ZAI (:) = 1.392*ZKNGI(:)**0.0783
+ !
+ ZRGJ (:) = PRG(:,JJ)
+ ZKNGJ(:) = PLAMBDA(:)/ZRGJ(:)
+ ZAJ (:) = 1.392*ZKNGJ(:)**0.0783
+ !
+ ZR (:) = SQRT(ZRGJ(:)/ZRGI(:))
+ ZR2 (:) = ZR(:)*ZR(:)
+ ZR4 (:) = ZR2(:)*ZR2(:)
+ ZRM (:) = 1./ZR(:)
+ ZRM2(:) = ZRM(:)*ZRM(:)
+ ZRM3(:) = ZRM(:)*ZRM2(:)
+ !
+ !
+ ! * 3.1 Free-Molecule Regime (Kn > 10) : appendix H.2.2.1 - Whitby et al. 1991
+ ! ----------------------------------------------------------------------
+ !
+ ZRES(:)=0.9
+ !
+ ! moment 0
+ !
+ ZAPPROX(:)=sqrt(2.*ZRGI(:))*(ZESG01(:,JI)+ZR(:)*ZESG01(:,JJ)+2.*ZR2(:)*ZESG01(:,JI)*ZESG04(:,JJ)&
+ +ZR4(:)*ZESG09(:,JI)*ZESG16(:,JJ)+ZRM3(:)*ZESG16(:,JI)*ZESG09(:,JJ)+&
+ 2.*ZRM(:)*ZESG04(:,JI)*ZESG01(:,JJ))
- ZINTERFM(:)=ZKFM(:)*ZRES(:)*ZAPPROX(:)
+ ZINTERFM(:)=ZKFM(:)*ZRES(:)*ZAPPROX(:)
- ZAPPROX(:)=2.+ZAI(:)*ZKNGI(:)*(ZESG04(:,JI)+ZR2(:)*ZESG16(:,JI)*ZESG04(:,JJ))+&
+ ZAPPROX(:)=2.+ZAI(:)*ZKNGI(:)*(ZESG04(:,JI)+ZR2(:)*ZESG16(:,JI)*ZESG04(:,JJ))+&
ZAJ(:)*ZKNGJ(:)*(ZESG04(:,JJ)+ZRM2(:)*ZESG16(:,JJ)*ZESG04(:,JI))+&
(ZR2(:)+ZRM2(:))*(ZESG04(:,JI)*ZESG04(:,JJ))
- ZINTERNC(:)=ZKNC(:)*ZAPPROX(:)
+ ZINTERNC(:)=ZKNC(:)*ZAPPROX(:)
- ZINTER(:)=ZINTERNC(:)*(ZINTERFM(:)/(ZINTERNC(:)+ZINTERFM(:)))
+ ZINTER(:)=ZINTERNC(:)*(ZINTERFM(:)/(ZINTERNC(:)+ZINTERFM(:)))
- PDMINTER(:,NM0(JI))=PM(:,NM0(JJ))*ZINTER(:)
- PDMINTER(:,NM0(JJ))=-PM(:,NM0(JJ))*ZINTER(:)
-
- ZAPPROX(:)=sqrt(2.)*sqrt(ZRGI(:))**7*(ZESG49(:,JI)+ZR(:)*ZESG36(:,JI)*ZESG01(:,JJ)+2.*ZR2(:)*&
+ PDMINTER(:,NM0(JI))=-PM(:,NM0(JI))*PM(:,NM0(JJ))*ZINTER(:)
+ PDMINTER(:,NM0(JJ))= 0.0
+ !
+ ! moment 3
+ !
+ ZAPPROX(:)=sqrt(2.)*sqrt(ZRGI(:))**7*(ZESG49(:,JI)+ZR(:)*ZESG36(:,JI)*ZESG01(:,JJ)+2.*ZR2(:)*&
ZESG25(:,JI)*ZESG04(:,JJ)+ZR4(:)*ZESG09(:,JI)*ZESG16(:,JJ)+ZRM3(:)*&
ZESG100(:,JI)*ZESG09(:,JJ)+2.*ZRM(:)*ZESG64(:,JI)*ZESG01(:,JJ))
- ZINTERFM(:)=ZKFM(:)*ZRES(:)*ZAPPROX(:)
+ ZINTERFM(:)=ZKFM(:)*ZRES(:)*ZAPPROX(:)
- ZAPPROX(:)=(2.*ZESG36(:,JI)+ZAI(:)*ZKNGI(:)*(ZESG16(:,JI)+ZR2(:)*ZESG04(:,JI)*ZESG04(:,JJ))+&
- ZAJ(:)*ZKNGJ(:)*(ZESG36(:,JI)*ZESG04(:,JJ)+ZRM2(:)*ZESG16(:,JJ)*ZESG64(:,JI))+&
- ZR2(:)*ZESG16(:,JI)*ZESG04(:,JJ)+ZRM2(:)*ZESG64(:,JI)*ZESG04(:,JJ))*(ZRGI(:))**3
+ ZAPPROX(:)=(2.*ZESG36(:,JI)+ZAI(:)*ZKNGI(:)*(ZESG16(:,JI)+ZR2(:)*ZESG04(:,JI)*ZESG04(:,JJ))+&
+ ZAJ(:)*ZKNGJ(:)*(ZESG36(:,JI)*ZESG04(:,JJ)+ZRM2(:)*ZESG16(:,JJ)*ZESG64(:,JI))+&
+ ZR2(:)*ZESG16(:,JI)*ZESG04(:,JJ)+ZRM2(:)*ZESG64(:,JI)*ZESG04(:,JJ))*(ZRGI(:))**3
- ZINTERNC(:)=ZKNC(:)*ZAPPROX(:)
+ ZINTERNC(:)=ZKNC(:)*ZAPPROX(:)
- ZINTER(:)=ZINTERNC(:)*(ZINTERFM(:)/(ZINTERNC(:)+ZINTERFM(:)))
+ ZINTER(:)=ZINTERNC(:)*(ZINTERFM(:)/(ZINTERNC(:)+ZINTERFM(:)))
- PDMINTER(:,NM3(JI))=-PM(:,NM0(JI))*PM(:,NM0(JJ))*ZINTER(:)
- PDMINTER(:,NM3(JJ))=PM(:,NM0(JI))*PM(:,NM0(JJ))*ZINTER(:)
+ PDMINTER(:,NM3(JI))=-PM(:,NM0(JI))*PM(:,NM0(JJ))*ZINTER(:)
+ PDMINTER(:,NM3(JJ))=-PDMINTER(:,NM3(JI))
+
+ ! moment 6
- ZAPPROX(:)=sqrt(2.)*sqrt(ZRGI(:))**13*(ZESG169(:,JI)+ZR(:)*ZESG144(:,JI)*ZESG01(:,JJ)+&
- 2.*ZR2(:)*ZESG121(:,JI)*ZESG04(:,JJ)+ZR4(:)*ZESG81(:,JI)*ZESG16(:,JJ)+&
- ZRM3(:)*ZESG256(:,JI)*ZESG09(:,JJ)+2*ZRM(:)*ZESG196(:,JI)*ZESG01(:,JJ))
+ ZAPPROX(:)=sqrt(2.)*sqrt(ZRGI(:))**13*(ZESG169(:,JI)+ZR(:)*ZESG144(:,JI)*ZESG01(:,JJ)+&
+ 2.*ZR2(:)*ZESG121(:,JI)*ZESG04(:,JJ)+ZR4(:)*ZESG81(:,JI)*ZESG16(:,JJ)+&
+ ZRM3(:)*ZESG256(:,JI)*ZESG09(:,JJ)+2*ZRM(:)*ZESG196(:,JI)*ZESG01(:,JJ))
- ZINTERFM(:)=ZKFM(:)*ZRES(:)*ZAPPROX(:)
+ ZINTERFM(:)=ZKFM(:)*ZRES(:)*ZAPPROX(:)
- ZAPPROX(:)=(ZRGI(:))**6*(2.*ZESG144(:,JI)+ZAI(:)*ZKNGI(:)*(ZESG100(:,JI)+&
+ ZAPPROX(:)=(ZRGI(:))**6*(2.*ZESG144(:,JI)+ZAI(:)*ZKNGI(:)*(ZESG100(:,JI)+&
ZR2(:)*ZESG64(:,JI)*ZESG04(:,JJ))+ZAJ(:)*ZKNGJ(:)*(ZESG144(:,JI)*ZESG04(:,JJ)+&
ZRM2(:)*ZESG196(:,JI)*ZESG16(:,JJ))+ZR2(:)*ZESG100(:,JI)*ZESG04(:,JJ)+&
ZRM2(:)*ZESG196(:,JI)*ZESG04(:,JJ))
- ZINTERNC(:)=ZKNC(:)*ZAPPROX(:)
+ ZINTERNC(:)=ZKNC(:)*ZAPPROX(:)
- ZINTER(:)=ZINTERNC(:)*(ZINTERFM(:)/(ZINTERNC(:)+ZINTERFM(:)))
+ ZINTER(:)=ZINTERNC(:)*(ZINTERFM(:)/(ZINTERNC(:)+ZINTERFM(:)))
- PDMINTER(:,NM6(JI))=-PM(:,NM0(JI))*PM(:,NM0(JJ))*ZINTER(:)
- PDMINTER(:,NM6(JJ))=PM(:,NM0(JI))*PM(:,NM0(JJ))*ZINTER(:)
+ PDMINTER(:,NM6(JI))=-PM(:,NM0(JI))*PM(:,NM0(JJ))*ZINTER(:)
- ZAPPROX(:)=sqrt(2.)*sqrt(ZRGI(:))**7*sqrt(ZRGJ(:))**6*(ZESG49(:,JI)*&
+ ZAPPROX(:)=sqrt(2.)*sqrt(ZRGI(:))**7*sqrt(ZRGJ(:))**6*(ZESG49(:,JI)*&
ZESG36(:,JJ)+ZR(:)*ZESG36(:,JI)*ZESG49(:,JJ)+2.*ZR2(:)*ZESG25(:,JI)*&
ZESG64(:,JJ)+ZR4(:)*ZESG09(:,JI)*ZESG100(:,JJ)+ZRM3(:)*ZESG100(:,JI)*&
ZESG09(:,JJ)+2.*ZRM(:)*ZESG64(:,JI)*ZESG25(:,JJ))
- ZINTERFM(:)=ZKFM(:)*ZRES(:)*ZAPPROX(:)
+ ZINTERFM(:)=ZKFM(:)*ZRES(:)*ZAPPROX(:)
- ZAPPROX(:)=(ZRGI(:))**3*(ZRGJ(:))**3*(2.*ZESG36(:,JI)*ZESG36(:,JJ)+&
+ ZAPPROX(:)=(ZRGI(:))**3*(ZRGJ(:))**3*(2.*ZESG36(:,JI)*ZESG36(:,JJ)+&
ZAI(:)*ZKNGI(:)*(ZESG16(:,JI)*ZESG16(:,JJ)+ZR2(:)*ZESG04(:,JI)*ZESG64(:,JJ))+&
ZAJ(:)*ZKNGJ(:)*(ZESG36(:,JI)*ZESG16(:,JJ)+ZRM2(:)*ZESG64(:,JI)*ZESG04(:,JJ))+&
ZR2(:)*ZESG16(:,JI)*ZESG64(:,JJ)+ZRM2(:)*ZESG64(:,JI)*ZESG16(:,JJ))
- ZINTERNC(:)=ZKNC(:)*ZAPPROX(:)
+ ZINTERNC(:)=ZKNC(:)*ZAPPROX(:)
- ZINTER(:)=ZINTERNC(:)*(ZINTERFM(:)/(ZINTERNC(:)+ZINTERFM(:)))
+ ZINTER(:)=ZINTERNC(:)*(ZINTERFM(:)/(ZINTERNC(:)+ZINTERFM(:)))
- PDMINTER(:,NM6(JJ))=PDMINTER(:,NM6(JJ))+2.*PM(:,NM0(JI))*PM(:,NM0(JJ))*ZINTER(:)
+ PDMINTER(:,NM6(JJ))=-PDMINTER(:,NM6(JI))+2.*PM(:,NM0(JI))*PM(:,NM0(JJ))*ZINTER(:)
- enddo
-enddo
+ ENDDO
+ENDDO
END SUBROUTINE CH_AER_COAG
diff --git a/src/MNH/ch_aer_depos.f90 b/src/MNH/ch_aer_depos.f90
index cf5659aa332d24dec88b471aae1fd4ae678c0ac7..37ca0645fe6e357302967318c408f59e0c2469a3 100644
--- a/src/MNH/ch_aer_depos.f90
+++ b/src/MNH/ch_aer_depos.f90
@@ -116,12 +116,12 @@ END IF
!Get minimum values possible
ZPMIN(1) = XN0IMIN
ZRGMIN = ZINIRADIUSI
-ZPMIN(2) = ZPMIN(1) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGIMIN)**2)
-ZPMIN(3) = ZPMIN(1) * (ZRGMIN**6)*EXP(18. * LOG(XSIGIMIN)**2)
+ZPMIN(2) = ZPMIN(1) * (ZRGMIN**3)*EXP(4.5 * LOG(XINISIGI)**2)
+ZPMIN(3) = ZPMIN(1) * (ZRGMIN**6)*EXP(18. * LOG(XINISIGI)**2)
ZPMIN(4) = XN0JMIN
ZRGMIN = ZINIRADIUSJ
-ZPMIN(5) = ZPMIN(4) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGJMIN)**2)
-ZPMIN(6) = ZPMIN(4) * (ZRGMIN**6)*EXP(18. * LOG(XSIGJMIN)**2)
+ZPMIN(5) = ZPMIN(4) * (ZRGMIN**3)*EXP(4.5 * LOG(XINISIGJ)**2)
+ZPMIN(6) = ZPMIN(4) * (ZRGMIN**6)*EXP(18. * LOG(XINISIGJ)**2)
!
!
CALL PPP2AERO(ZSVT, PRHODREF, &
@@ -167,15 +167,15 @@ SELECT CASE (CCLOUD)
CASE ('KESS','REVE','ICE3','ICE4')
! One moment cloud scheme
CALL AER_WET_DEP_KMT_WARM (NSPLITR, PTSTEP, PZZ, PRHODREF, &
- PRT(:,:,:,2), PRT(:,:,:,3), ZRCS, &
- ZRRS, ZSVAER, PTHT, PPABST, ZRG, &
+ PRT(:,:,:,2), PRT(:,:,:,3), &
+ ZSVAER, PTHT, PPABST, ZRG, &
PEVAP3D, JPMODE,ZRHOP, ZMASSMIN, &
PSEA=ZSEA, PTOWN=ZTOWN)
CASE ('KHKO','C2R2','C3R5')
! Two moment cloud scheme
CALL AER_WET_DEP_KMT_WARM (NSPLITR, PTSTEP, PZZ, PRHODREF, &
- PRT(:,:,:,2), PRT(:,:,:,3), ZRCS, &
- ZRRS, ZSVAER, PTHT, PPABST, ZRG, &
+ PRT(:,:,:,2), PRT(:,:,:,3), &
+ ZSVAER, PTHT, PPABST, ZRG, &
PEVAP3D, JPMODE,ZRHOP, ZMASSMIN, &
PSEA=ZSEA, PTOWN=ZTOWN, &
PCCT=PSVT(:,:,:,NSV_C2R2BEG+1), &
@@ -183,8 +183,8 @@ SELECT CASE (CCLOUD)
CASE ('LIMA')
! Two moment cloud scheme
CALL AER_WET_DEP_KMT_WARM (NSPLITR, PTSTEP, PZZ, PRHODREF, &
- PRT(:,:,:,2), PRT(:,:,:,3), ZRCS, &
- ZRRS, ZSVAER, PTHT, PPABST, ZRG, &
+ PRT(:,:,:,2), PRT(:,:,:,3), &
+ ZSVAER, PTHT, PPABST, ZRG, &
PEVAP3D, JPMODE,ZRHOP, ZMASSMIN, &
PSEA=ZSEA, PTOWN=ZTOWN, &
PCCT=PSVT(:,:,:,NSV_LIMA_NC), &
diff --git a/src/MNH/ch_aer_eqm_initn.f90 b/src/MNH/ch_aer_eqm_initn.f90
index 0759d63cebf4fb9ecacb825551b4dc67bb1bec1e..d9b1a77621153cfe89c0d5365b9c2b267761147a 100644
--- a/src/MNH/ch_aer_eqm_initn.f90
+++ b/src/MNH/ch_aer_eqm_initn.f90
@@ -403,16 +403,16 @@ XSVMIN(NSV_AERBEG:NSV_AEREND) = XMNH_TINY
XSVMIN(NSV_CHEMBEG-1+JP_CH_CO) = 1E-10
! For i mode
ZRHODREFMIN = MAX_ll( PRHODREF(:,:,:), IINFO_ll)
-ZMASS = XN0IMIN * ((ZMINRGI**3)*EXP(4.5 * (LOG(XSIGIMIN))**2))
-ZM6MIN = XN0IMIN * ((ZMINRGI**6)*EXP(18. * (LOG(XSIGIMIN))**2))
+ZMASS = XN0IMIN * ((ZMINRGI**3)*EXP(4.5 * (LOG(XINISIGI))**2))
+ZM6MIN = XN0IMIN * ((ZMINRGI**6)*EXP(18. * (LOG(XINISIGI))**2))
XSVMIN(NSV_AERBEG-1+JP_CH_BCi) = 0.5*ZMASS * XFAC(JP_AER_BC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN)
XSVMIN(NSV_AERBEG-1+JP_CH_OCi) = 0.5*ZMASS * XFAC(JP_AER_OC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN)
XSVMIN(NSV_AERBEG-1+JP_CH_M0i) = XN0IMIN * 1E-6 / (ZDEN2MOL*ZRHODREFMIN)
IF (LVARSIGI) XSVMIN(NSV_AERBEG-1+JP_CH_M6i) = ZM6MIN / (ZDEN2MOL*ZRHODREFMIN)
!
! For j mode
-ZMASS = XN0JMIN * ((ZMINRGJ**3)*EXP(4.5 * (LOG(XSIGJMIN))**2))
-ZM6MIN = XN0JMIN * ((ZMINRGJ**6)*EXP(18. * (LOG(XSIGJMIN))**2))
+ZMASS = XN0JMIN * ((ZMINRGJ**3)*EXP(4.5 * (LOG(XINISIGJ))**2))
+ZM6MIN = XN0JMIN * ((ZMINRGJ**6)*EXP(18. * (LOG(XINISIGJ))**2))
XSVMIN(NSV_AERBEG-1+JP_CH_BCj) = 0.5*ZMASS * XFAC(JP_AER_BC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN)
XSVMIN(NSV_AERBEG-1+JP_CH_OCj) = 0.5*ZMASS * XFAC(JP_AER_OC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN)
XSVMIN(NSV_AERBEG-1+JP_CH_M0j) = XN0JMIN * 1E-6 / (ZDEN2MOL*ZRHODREFMIN)
diff --git a/src/MNH/ch_aer_init_soa.f90 b/src/MNH/ch_aer_init_soa.f90
index 0dbc529a95bd07abd996b37f90dfa681ef299cf7..ed12e0c2510ff0de5d6fe22d1d0fad10c0ea3be1 100644
--- a/src/MNH/ch_aer_init_soa.f90
+++ b/src/MNH/ch_aer_init_soa.f90
@@ -1,13 +1,8 @@
-!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!ORILAM_LIC for details.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!! ########################
MODULE MODI_CH_AER_INIT_SOA
!! ########################
@@ -50,9 +45,8 @@ END MODULE MODI_CH_AER_INIT_SOA
!! None
!!
USE MODD_CH_AEROSOL
-USE MODD_CH_M9_n, ONLY : CNAMES, NEQ
+USE MODD_CH_M9_n, ONLY : CNAMES
USE MODD_CH_MNHC_n, ONLY : CCH_SCHEME
-USE MODD_NSV, ONLY : NSV_CHEM
!!
IMPLICIT NONE
!!
diff --git a/src/MNH/ch_aer_reallfin.f90 b/src/MNH/ch_aer_reallfin.f90
index 505f3acfae89b18fac882c45bc4a2fe83b953ac0..101835c6c8a9ce8afeef7ffa24f52c4a1aaa3b8b 100644
--- a/src/MNH/ch_aer_reallfin.f90
+++ b/src/MNH/ch_aer_reallfin.f90
@@ -134,7 +134,7 @@ ZRHOI(:) = 1.8e3
ZRHOI(JP_AER_H2O) = 1.0e3 ! water
ZRHOI(JP_AER_DST) = XDENSITY_DUST
!
-PSV(:,:,:,:) = MAX(PSV(:,:,:,:), 0.)
+PSV(:,:,:,:) = MAX(PSV(:,:,:,:), 1E-20)
PCO(:,:,:) = MAX(PCO(:,:,:), 10.E-9*PRHODREF(:,:,:))
!
! Special treatment for BC and OC (link to CO gaseous concentration)
@@ -310,6 +310,7 @@ DO JN=1,JPMODE
!
ZRG(:,:,:,JN)=(ZM(:,:,:,NM3(JN))/ZN(:,:,:,JN))**(1./3.)*EXP(-1.5*ZSIGMA(:,:,:))
!
+
ENDDO
!
!conversion into ppv
diff --git a/src/MNH/ch_aer_trans.f90 b/src/MNH/ch_aer_trans.f90
index d8844d117baa87b4a65456a4af08737169242bb2..400ccec1f6e4b79c458fe1a55b8502cb8d3180f7 100644
--- a/src/MNH/ch_aer_trans.f90
+++ b/src/MNH/ch_aer_trans.f90
@@ -95,16 +95,16 @@ CHARACTER(LEN=10), INTENT(IN) :: HSCHEME
!
!* 0.2 declarations local variables
!
-INTEGER :: JJ, JN ! loop counter
+INTEGER :: JJ, JN, II ! loop counter
! variables for the aerosol module
!
REAL, DIMENSION(SIZE(PM,1)) :: ZSIGMA
REAL, DIMENSION(SIZE(PM,1)) :: ZSUM
REAL, SAVE, DIMENSION(JPIN) :: ZPMIN
LOGICAL, SAVE :: GPHYSLIM = .TRUE. ! flag
-REAL :: ZRGMIN
+REAL, SAVE :: ZRGMIN
REAL, PARAMETER :: ZCSTAVOG=6.0221367E+11
-REAL :: ZINIRADIUSI, ZINIRADIUSJ
+REAL, SAVE :: ZINIRADIUSI, ZINIRADIUSJ
!
@@ -128,13 +128,13 @@ END IF
ZPMIN(1) = XN0IMIN
ZRGMIN = ZINIRADIUSI
-ZPMIN(2) = ZPMIN(1) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGIMIN)**2)
-ZPMIN(3) = ZPMIN(1) * (ZRGMIN**6)*EXP(18. * LOG(XSIGIMIN)**2)
+ZPMIN(2) = ZPMIN(1) * (ZRGMIN**3)*EXP(4.5 * LOG(XINISIGI)**2)
+ZPMIN(3) = ZPMIN(1) * (ZRGMIN**6)*EXP(18. * LOG(XINISIGI)**2)
ZPMIN(4) = XN0JMIN
ZRGMIN = ZINIRADIUSJ
-ZPMIN(5) = ZPMIN(4) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGJMIN)**2)
-ZPMIN(6) = ZPMIN(4) * (ZRGMIN**6)*EXP(18. * LOG(XSIGJMIN)**2)
+ZPMIN(5) = ZPMIN(4) * (ZRGMIN**3)*EXP(4.5 * LOG(XINISIGJ)**2)
+ZPMIN(6) = ZPMIN(4) * (ZRGMIN**6)*EXP(18. * LOG(XINISIGJ)**2)
END IF
@@ -768,6 +768,8 @@ END IF
!
!* 1.n transfer moment 0 from gas to aerosol variable
!
+!print*,'aer_trans N0i =',MINVAL(PAERO(:,JP_CH_M0i)), MAXVAL(PAERO(:,JP_CH_M0i))
+!print*,'aer_trans N0j =',MINVAL(PAERO(:,JP_CH_M0j)), MAXVAL(PAERO(:,JP_CH_M0j))
PM(:,1) = MAX(PAERO(:,JP_CH_M0i) * 1E+6, XMNH_TINY) ! convert from 1/cc to 1/m3
PM(:,4) = MAX(PAERO(:,JP_CH_M0j) * 1E+6, XMNH_TINY) ! convert from 1/cc to 1/m3
@@ -892,7 +894,7 @@ PMASK(:,JN) = 1.
END WHERE
ENDDO
-
+
ELSE
!
!* 2. TRANSFER FROM AEROSOL TO GAS MODULE
diff --git a/src/MNH/ch_aer_wetdepn.f90 b/src/MNH/ch_aer_wetdepn.f90
index b1041d55d5171b6a39b85289f99ee1b09a47536b..dd051acd8e62e7409f874285fe408355fa6c0793 100644
--- a/src/MNH/ch_aer_wetdepn.f90
+++ b/src/MNH/ch_aer_wetdepn.f90
@@ -99,12 +99,12 @@ END IF
!Get minimum values possible
ZPMIN(1) = XN0IMIN
ZRGMIN = ZINIRADIUSI
-ZPMIN(2) = ZPMIN(1) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGIMIN)**2)
-ZPMIN(3) = ZPMIN(1) * (ZRGMIN**6)*EXP(18. * LOG(XSIGIMIN)**2)
+ZPMIN(2) = ZPMIN(1) * (ZRGMIN**3)*EXP(4.5 * LOG(XINISIGI)**2)
+ZPMIN(3) = ZPMIN(1) * (ZRGMIN**6)*EXP(18. * LOG(XINISIGI)**2)
ZPMIN(4) = XN0JMIN
ZRGMIN = ZINIRADIUSJ
-ZPMIN(5) = ZPMIN(4) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGJMIN)**2)
-ZPMIN(6) = ZPMIN(4) * (ZRGMIN**6)*EXP(18. * LOG(XSIGJMIN)**2)
+ZPMIN(5) = ZPMIN(4) * (ZRGMIN**3)*EXP(4.5 * LOG(XINISIGJ)**2)
+ZPMIN(6) = ZPMIN(4) * (ZRGMIN**6)*EXP(18. * LOG(XINISIGJ)**2)
!
CALL PPP2AERO(PSVT, PRHODREF, PSIG3D=ZSIG, PRG3D=ZRG, PM3D=ZPMOLD)
CALL PPP2AERO(PCWETDEP, PRHODREF, PSIG3D=ZSIGN, PRG3D=ZRGN, PM3D=ZPM)
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 6678d6e268ccc85266d79418972f7814fb54923f..dc5bf562970fc851320fe6bed68b0901aa0caa7b 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -1088,7 +1088,7 @@ LCH_PH = .FALSE.
LCH_RET_ICE = .FALSE.
XCH_PHINIT = 5.2
XRTMIN_AQ = 5.e-8
-CCHEM_INPUT_FILE = 'EXSEG1.nam'
+CCHEM_INPUT_FILE = 'MNHC.input'
CCH_TDISCRETIZATION = 'SPLIT'
NCH_SUBSTEPS = 1
LCH_TUV_ONLINE = .FALSE.
@@ -1168,8 +1168,8 @@ LHETEROSO4 = .FALSE. ! switch to active sulfates heteronegeous
! production
LSEDIMAERO = .FALSE. ! switch to active aerosol sedimentation
LAERINIT = .FALSE. ! switch to initialize aerosol in arome
-CMINERAL = "NONE" ! mineral equilibrium scheme
-CORGANIC = "NONE" ! mineral equilibrium scheme
+CMINERAL = "EQSAM" ! mineral equilibrium scheme
+CORGANIC = "MPMPO" ! mineral equilibrium scheme
CNUCLEATION = "NONE" ! sulfates nucleation scheme
LDEPOS_AER(:) = .FALSE.
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index 674b21574e9c2c06920f4e4271afb73bcc10b7ce..dabc5ab3efab5b39df4b867fd199af12420fc955 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -63,7 +63,6 @@
!! 03/2010 (G.Tanguy) Clean up of unuseful variables
!! 05/2010 Add lidar
!!! 03/2012 (S. Bielli) Add NAM_NCOUT for netcdf output (removed 11/07/2016)
-!! 03/2013 (O.Caumont) Modif call aircraft_balloon
!! 03/2013 (C. Augros) Add variables for radar simulator in NAMELIST:
!! NBAZIM,LSNRT,XSNRMIN
!! D.Ricard 2015 : add LMOIST_ES
@@ -83,24 +82,22 @@
!! 01/2018 (J.-P. Chaboureau) Add altitude interpolation
!! 01/2018 (J.-P. Chaboureau) Add coarse graining
!! 01/2018 (G.Delautier) SURFEX 8.1
-!! 03/2018 (P.Wautelet) replace SUBTRACT_TO_DATE and ADD_FORECAST_TO_DATE
-!! by DATETIME_CORRECTDATE
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! V.Vionnet 07/2017 add LWIND_CONTRAV
!! 11/2017 (D. Ricard, P. Marquet) add diagnostics for THETAS
! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
! P. Wautelet 11/02/2019: added missing use of MODI_CH_MONITOR_n
! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
-! P. Wautelet 26/07/2019: bug correction: deallocate of zsea done too early
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
! P. Wautelet 06/07/2021: use FINALIZE_MNH
+! P. Wautelet 15/09/2023! remove offline balloons
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_ADV_n
-USE MODD_AIRCRAFT_BALLOON
+USE MODD_AIRCRAFT_BALLOON, ONLY: LFLYER
USE MODD_BUDGET
USE MODD_CONF
USE MODD_CONF_n
@@ -113,7 +110,7 @@ USE MODD_FIELD_n
USE MODD_GR_FIELD_n
USE MODD_GRID, ONLY: XLONORI, XLATORI
USE MODD_GRID_n
-USE MODD_IO, ONLY: CIO_DIR, NIO_VERB, NVERB_DEBUG, TFILEDATA, TFILE_SURFEX
+USE MODD_IO, ONLY: NIO_VERB, NVERB_DEBUG, TFILEDATA, TFILE_SURFEX
USE MODD_LBC_n
USE MODD_LES
USE MODD_LES_BUDGET
@@ -141,11 +138,9 @@ USE MODD_TIME_n
USE MODD_TURB_n
USE MODD_VAR_ll
!
-USE MODE_AIRCRAFT_BALLOON
USE MODE_DATETIME
USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_FIELD_WRITE, only: IO_Header_write
USE MODE_IO, only: IO_Config_set, IO_Init
USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_ll
@@ -157,14 +152,11 @@ USE MODE_MODELN_HANDLER
USE MODE_MSG
USE MODE_POS
USE MODE_TIME
-USE MODE_WRITE_AIRCRAFT_BALLOON
-use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
!
USE MODI_CH_MONITOR_n
USE MODI_COMPUTE_R00
USE MODI_DIAG_SURF_ATM_N
USE MODI_INIT_MNH
-USE MODI_MNHGET_SURF_PARAM_n
USE MODI_PHYS_PARAM_n
USE MODI_VERSION
USE MODI_WRITE_DIAG_SURF_ATM_N
@@ -181,8 +173,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of local variables
!
-TYPE(DATE_TIME) :: TXDTBAL ! current time and date for BALLOON and AIRCRAFT trajectories
-TYPE(DATE_TIME) :: TPDTCUR_SAVE
CHARACTER (LEN=28), DIMENSION(1) :: YINIFILE ! names of the INPUT FM-file
CHARACTER (LEN=28), DIMENSION(1) :: YINIFILEPGD ! names of the INPUT FM-file
CHARACTER (LEN=5) :: YSUFFIX ! character string for the OUTPUT FM-file number
@@ -193,9 +183,8 @@ CHARACTER (LEN=4) :: YTURB ! initial flag to call to turbulence schemes
INTEGER :: ILUOUT0 ! Logical unit number for the output listing
REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME0, ZTIME1, ZTIME2, ZRAD, ZDCONV, ZSHADOWS, ZGROUND, &
ZTRACER, ZDRAG, ZTURB, ZMAFL, ZCHEM, ZTIME_BU, ZEOL ! CPU times
-REAL(kind=MNHTIME), DIMENSION(2) :: ZSTART, ZINIT, ZWRIT, ZBALL, ZPHYS, ZSURF, ZWRITS, ZTRAJ ! storing variables
+REAL(kind=MNHTIME), DIMENSION(2) :: ZSTART, ZINIT, ZWRIT, ZPHYS, ZSURF, ZWRITS, ZTRAJ ! storing variables
INTEGER(KIND=LFIINT) :: INPRAR ! number of articles predicted in the LFIFM file
-INTEGER :: ISTEPBAL ! loop indice for balloons and aircraft
INTEGER :: ILUNAM ! Logical unit numbers for the namelist file
! and for output_listing file
INTEGER :: JF =0 ! loop index
@@ -205,10 +194,8 @@ LOGICAL:: GCLOUD_ONLY ! conditionnal radiation computations for
! the only cloudy columns
!
INTEGER :: IIU, IJU, IKU
-REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA
REAL, DIMENSION(:,:,:,:),ALLOCATABLE :: ZWETDEPAER
!
-TYPE(TFILEDATA),POINTER :: TZDIACFILE => NULL()
TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL() !Namelist file
!
NAMELIST/NAM_DIAG/ CISO, LVAR_RS, LVAR_LS, &
@@ -222,9 +209,7 @@ NAMELIST/NAM_DIAG/ CISO, LVAR_RS, LVAR_LS, &
LCLD_COV, LVAR_PR, LTOTAL_PR, LMEAN_PR, XMEAN_PR, &
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,&
- XLAT_BALLOON,XLON_BALLOON,XALT_BALLOON,&
+ CSPEC_BU_DIAG,CSPEC_DIAG, &
LC2R2, LC3R5, LELECDIAG, CAERDIAG, &
NGPS,XLAT_GPS,XLON_GPS,XZS_GPS,CNAM_GPS,XDIFFORO, &
NVERSION_RAD, NCURV_INTERPOL, LCART_RAD, CARF,LREFR,LDNDZ,&
@@ -313,13 +298,6 @@ CSPEC_DIAG=''
LTRAJ=.FALSE.
LLIMA_DIAG=.FALSE.
!
-LAIRCRAFT_BALLOON=.FALSE.
-NTIME_AIRCRAFT_BALLOON=NUNDEF
-XSTEP_AIRCRAFT_BALLOON=XUNDEF
-XLAT_BALLOON(:)=XUNDEF
-XLON_BALLOON(:)=XUNDEF
-XALT_BALLOON(:)=XUNDEF
-!
NGPS=-1
CNAM_GPS(:)=''
XLAT_GPS(:)=XUNDEF
@@ -515,60 +493,6 @@ ZWRIT =ZTIME2-ZTIME1
ZTIME1=ZTIME2
!-------------------------------------------------------------------------------
!
-!* 4.1 BALLOON and AIRCRAFT
-!
-IF ( LAIRCRAFT_BALLOON ) THEN
-!
- CALL IO_File_add2list(TZDIACFILE,TRIM(CINIFILE)//'BAL','MNHDIACHRONIC','WRITE', &
- HDIRNAME=CIO_DIR,KLFINPRAR=INPRAR,KLFITYPE=1,KLFIVERB=NVERB)
-!
- CALL IO_File_open(TZDIACFILE)
-!
- WRITE(ILUOUT0,*) ' '
- WRITE(ILUOUT0,*) 'DIAG AFTER OPEN DIACHRONIC FILE'
- WRITE(ILUOUT0,*) ' '
-!
- TPDTCUR_SAVE = TDTCUR
-!
- TXDTBAL%nyear = TDTCUR%nyear
- TXDTBAL%nmonth = TDTCUR%nmonth
- TXDTBAL%nday = TDTCUR%nday
- TXDTBAL%xtime = TDTCUR%xtime - NTIME_AIRCRAFT_BALLOON/2.
- CALL DATETIME_CORRECTDATE(TXDTBAL)
- TDTCUR = TXDTBAL !TDTCUR is used in AIRCRAFT_BALLOON
-!
- ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
- ZSEA(:,:) = 0.
- CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
- DO ISTEPBAL = 1, NTIME_AIRCRAFT_BALLOON, INT(XSTEP_AIRCRAFT_BALLOON)
- CALL AIRCRAFT_BALLOON( XSTEP_AIRCRAFT_BALLOON, XZZ, XMAP, XLONORI, XLATORI, XUT, XVT, XWT, &
- XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, XRHODREF, XCIT, ZSEA )
-
- TXDTBAL%xtime = TXDTBAL%xtime + XSTEP_AIRCRAFT_BALLOON
- CALL DATETIME_CORRECTDATE(TXDTBAL)
- TDTCUR = TXDTBAL !TDTCUR is used in AIRCRAFT_BALLOON
- END DO
- DEALLOCATE (ZSEA)
-!
- TDTCUR = TPDTCUR_SAVE
-!
- CALL IO_Header_write(TZDIACFILE)
- CALL WRITE_LFIFMN_FORDIACHRO_n(TZDIACFILE)
- CALL WRITE_AIRCRAFT_BALLOON(TZDIACFILE)
-#ifdef MNH_IOLFI
- CALL MENU_DIACHRO(TZDIACFILE,'END')
-#endif
- CALL IO_File_close(TZDIACFILE)
- WRITE(ILUOUT0,*) ' '
- WRITE(ILUOUT0,*) 'DIAG AFTER CLOSE DIACHRONIC FILE'
- WRITE(ILUOUT0,*) ' '
-END IF
-!
-CALL SECOND_MNH2(ZTIME2)
-ZBALL =ZTIME2-ZTIME1
-ZTIME1=ZTIME2
-!-------------------------------------------------------------------------------
-!
!* 5.0 Call to physics
!
!* initialise the source terms
@@ -771,7 +695,6 @@ ZTIME2=ZTIME2-ZTIME0
!WRITE(ILUOUT0,YFMT) '| START | ',ZSTART,' | ',100.*ZSTART/ZTIME2,' |'
!WRITE(ILUOUT0,YFMT) '| INIT | ',ZINIT,' | ',100.*ZINIT/ZTIME2,' |'
!WRITE(ILUOUT0,YFMT) '| WRIT | ',ZWRIT,' | ',100.*ZWRIT/ZTIME2,' |'
-!WRITE(ILUOUT0,YFMT) '| BALL | ',ZBALL,' | ',100.*ZBALL/ZTIME2,' |'
!WRITE(ILUOUT0,YFMT) '| PHYS | ',ZPHYS,' | ',100.*ZPHYS/ZTIME2,' |'
!IF (ZRAD>0.) &
! WRITE(ILUOUT0,YFMT2) '| ',CRAD,' | ',ZRAD
diff --git a/src/MNH/dustcamsn.f90 b/src/MNH/dustcamsn.f90
index 33966adfd96f0d7b3e6d5684f374c77cc7721e38..94732c05c0006a92918710c24f4e1a329ebb660d 100644
--- a/src/MNH/dustcamsn.f90
+++ b/src/MNH/dustcamsn.f90
@@ -125,13 +125,12 @@ DO JN = 1, NMODE_DST
ZMMIN(IM3(JN)) = XN0MIN(IMODEIDX) * (ZRGMIN**3)*EXP(4.5 * LOG(ZINISIGMA(JN))**2)
ZMMIN(IM6(JN)) = XN0MIN(IMODEIDX) * (ZRGMIN**6)*EXP(18. * LOG(ZINISIGMA(JN))**2)
- IF (JPDUSTORDER(JN) == 1) ZMASS(:,:,:,JN) = PMASSCAMS(:,:,:,1) ! fin mode
- IF (JPDUSTORDER(JN) == 2) ZMASS(:,:,:,JN) = PMASSCAMS(:,:,:,2) ! median mode
- IF (JPDUSTORDER(JN) == 3) ZMASS(:,:,:,JN) = PMASSCAMS(:,:,:,3) ! large mode
+ IF (JPDUSTORDER(JN) == 1) ZMASS(:,:,:,JN) = MAX(PMASSCAMS(:,:,:,1), 1E-16) ! fin mode
+ IF (JPDUSTORDER(JN) == 2) ZMASS(:,:,:,JN) = MAX(PMASSCAMS(:,:,:,2), 1E-15) ! median mode
+ IF (JPDUSTORDER(JN) == 3) ZMASS(:,:,:,JN) = MAX(PMASSCAMS(:,:,:,3), 1E-15) ! large mode
ENDDO
-ZMASS(:,:,:,:) = MAX(ZMASS(:,:,:,:), 1E-40)
!
!
ZRHOI = XDENSITY_DUST !1.8e3 !++changed alfgr
@@ -158,14 +157,14 @@ DO JN = 1, NMODE_DST
(ZINIRADIUS(JN)**3) * &
EXP(4.5*LOG(ZINISIGMA(JN))**2)
- ZM(:,:,:,IM3(JN)) = MAX(ZMMIN(IM3(JN)), ZM(:,:,:,IM3(JN)))
+! ZM(:,:,:,IM3(JN)) = MAX(ZMMIN(IM3(JN)), ZM(:,:,:,IM3(JN)))
!
!* 1.3 calculate moment 6 from m0, RG and SIG
!
ZM(:,:,:,IM6(JN))= ZM(:,:,:,IM0(JN)) * ((ZINIRADIUS(JN)**6) * &
EXP(18.*(LOG(ZINISIGMA(JN)))**2))
!
- ZM(:,:,:,IM6(JN)) = MAX(ZMMIN(IM6(JN)), ZM(:,:,:,IM6(JN)))
+! ZM(:,:,:,IM6(JN)) = MAX(ZMMIN(IM6(JN)), ZM(:,:,:,IM6(JN)))
!
!* 1.4 output concentration
!
diff --git a/src/MNH/eol_alm.f90 b/src/MNH/eol_alm.f90
index ab533254e9d4fb65551a4d269e29cef05f3eae1e..509a014b15177f20aba4a338929e8ee2ae4b4ab8 100644
--- a/src/MNH/eol_alm.f90
+++ b/src/MNH/eol_alm.f90
@@ -379,8 +379,8 @@ DO KTSUBCOUNT=1,INBSUBCOUNT
!
IF (LTIPLOSSG) THEN
ZPHI = + ZAOA &
- + TFARM%XBLA_PITCH(JROT) &
- + XTWIST_ELT(JROT,JBLA,JBELT)
+ - TFARM%XBLA_PITCH(JROT) &
+ - XTWIST_ELT(JROT,JBLA,JBELT)
IF (ZPHI > 0.0) THEN
ZFTIPL = (2.0/XPI)*ACOS(MIN( &
1.0, EXP(-(TTURBINE%NNB_BLADES/2.0) &
diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90
index 37d6dcbb36b0cfe46e05f26752c1136b6d50a200..70ef993128c8e200877b345ee7e86123124a663e 100644
--- a/src/MNH/ground_paramn.f90
+++ b/src/MNH/ground_paramn.f90
@@ -980,7 +980,7 @@ IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
XCURRENT_SWD (:,:) = SUM( XDIRSRFSWD(:,:,:) + XSCAFLASWD(:,:,:), DIM=3 )
XCURRENT_LWU (:,:) = XLWU(:,:,IKB)
XCURRENT_SWU (:,:) = XSWU(:,:,IKB)
- IF ( GSTATPROF_SURF ) THEN
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
XCURRENT_SWDIR(:,:) = SUM( XDIRSRFSWD(:,:,:), DIM=3 )
XCURRENT_SWDIFF(:,:) = SUM( XSCAFLASWD(:,:,:), DIM=3 )
XCURRENT_DSTAOD(:,:) = 0.0
@@ -1005,7 +1005,7 @@ IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWD, 'GROUND_PARAM_n::XCURRENT_SWD' )
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWU, 'GROUND_PARAM_n::XCURRENT_LWU' )
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWU, 'GROUND_PARAM_n::XCURRENT_SWU' )
- IF ( GSTATPROF_SURF ) THEN
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIR, 'GROUND_PARAM_n::XCURRENT_SWDIR' )
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIFF, 'GROUND_PARAM_n::XCURRENT_SWDIFF' )
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_DSTAOD, 'GROUND_PARAM_n::XCURRENT_DSTAOD' )
@@ -1014,7 +1014,7 @@ IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
END IF
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZON10M, 'GROUND_PARAM_n::XCURRENT_ZON10M' )
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_MER10M, 'GROUND_PARAM_n::XCURRENT_MER10M' )
- IF ( GSTATPROF_SURF ) THEN
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_RN, 'GROUND_PARAM_n::XCURRENT_RN' )
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_H, 'GROUND_PARAM_n::XCURRENT_H' )
CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LE, 'GROUND_PARAM_n::XCURRENT_LE' )
@@ -1211,7 +1211,7 @@ IF(LBLOWSNOW) THEN
END DO
END IF
!
-IF ( GSTATPROF_SURF ) THEN
+IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
XCURRENT_RN (IIB:IIE,IJB:IJE) = RESHAPE(ZP_RN(:), ISHAPE_2)
XCURRENT_H (IIB:IIE,IJB:IJE) = RESHAPE(ZP_H (:), ISHAPE_2)
XCURRENT_LE (IIB:IIE,IJB:IJE) = RESHAPE(ZP_LE(:), ISHAPE_2)
diff --git a/src/MNH/ini_aircraft.f90 b/src/MNH/ini_aircraft.f90
index 530cb390cf71f355a423fdbc836e950f34577a16..64e39beb3c82047dd42ed9f19ccd5d9c94f2a434 100644
--- a/src/MNH/ini_aircraft.f90
+++ b/src/MNH/ini_aircraft.f90
@@ -18,74 +18,6 @@ CONTAINS
! #######################
SUBROUTINE INI_AIRCRAFT
! #######################
-!
-!
-!!**** *INI_AIRCRAFT* - user initializes the aircraft flight path
-!!
-!! PURPOSE
-!! -------
-!
-!
-!!** METHOD
-!! ------
-!!
-!! Must be defined (for each aircraft):
-!! ---------------
-!!
-!! No default exist for these variables.
-!! ************************************
-!!
-!! 1) the model in which the aircraft will evolve
-!! if NOT initialized, the aircraft is NOT used.
-!!
-!! 2) the possibility to switch from a model to its dad or kid
-!! 'FIX' : NMODEL used during the run
-!! 'MOB' : best resolution model used. NMODEL=1 is used at the beginning
-!!
-!!
-!! 3) the type of aircraft
-!!
-!! 'AIRCRA' for aircraft
-!!
-!! 4) the takeoff date and time
-!!
-!! 5) the number of flight path segments (SEG)
-!!
-!! 6) the (SEG ) duration of flight in the segments, in the flight order (sec.)
-!!
-!! 6bis) TAIRCRAFT%LALTDEF : flag to define the mode of initialisation of
-!! aircraft altitude TRUE for pressure (corresponding to %XSEGP)
-!! or FALSE for Z (corresponding to %XSEGZ)
-!!
-!! 7) the (SEG+1) latitudes of the segments ends, in the flight order
-!! first point is take-off
-!! last point is landing
-!!
-!! 8) the (SEG+1) longitudes of the segments ends, in the flight order
-!!
-!! 9) the (SEG+1) pressure (%XSEGP) or Z (%XSEGZ) of the segments ends, in the flight order
-!!
-!!
-!!
-!! Can be defined (for each aircraft):
-!! --------------
-!!
-!!
-!! 9) the time step for data storage.
-!! default is 60s
-!!
-!! 10) the name or title describing the aircraft (8 characters)
-!! default is the aircraft type (6 characters) + the aircraft numbers (2 characters)
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
!!
!! AUTHOR
!! ------
@@ -122,6 +54,8 @@ DO JI = 1, NAIRCRAFTS
TZAIRCRAFT%NID = JI
+ TZAIRCRAFT%LFIX = .FALSE.
+
IF ( CTITLE(JI) == '' ) THEN
WRITE( CTITLE(JI), FMT = '( A, I3.3) ') TRIM( CTYPE(JI) ), JI
@@ -129,7 +63,7 @@ DO JI = 1, NAIRCRAFTS
CMNHMSG(2) = 'title set to ' // TRIM( CTITLE(JI) )
CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_AIRCRAFT', OLOCAL = .TRUE. )
END IF
- TZAIRCRAFT%CTITLE = CTITLE(JI)
+ TZAIRCRAFT%CNAME = CTITLE(JI)
IF ( CMODEL(JI) == 'FIX' ) THEN
IF ( NMODEL(JI) < 1 .OR. NMODEL(JI) > NMODEL_NEST ) THEN
@@ -202,7 +136,7 @@ DO JI = 1, NAIRCRAFTS
IF ( TZAIRCRAFT%LALTDEF ) THEN
! Print a warning if pressures seem too high (> 2000 hPa)
IF ( ANY( TZAIRCRAFT%XPOSP > 2.E5 ) ) THEN
- CMNHMSG(1) = TRIM( TZAIRCRAFT%CTITLE ) // ': pressure values seem too high'
+ CMNHMSG(1) = TRIM( TZAIRCRAFT%CNAME ) // ': pressure values seem too high'
CMNHMSG(2) = 'check that they are given in hPa and not Pa'
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_AIRCRAFT', OLOCAL = .TRUE. )
END IF
diff --git a/src/MNH/ini_aircraft_balloon.f90 b/src/MNH/ini_aircraft_balloon.f90
index 48f7b1e22d81e0dde1c15933169240920de14843..f31a5584a3f4d9018367801a666ac2644e9098a0 100644
--- a/src/MNH/ini_aircraft_balloon.f90
+++ b/src/MNH/ini_aircraft_balloon.f90
@@ -7,6 +7,7 @@
! P. Wautelet 01/10/2020: bugfix: DEFAULT_FLYER: add missing default values
! P. Wautelet 06/2022: reorganize flyers
! P. Wautelet 25/08/2022: write balloon positions in netCDF4 files inside HDF5 groups
+! P. Wautelet 15/09/2023: remove offline balloons
!-----------------------------------------------------------------
!###############################
@@ -19,8 +20,6 @@ IMPLICIT NONE
PRIVATE
-PUBLIC :: ALLOCATE_FLYER, DEALLOCATE_FLYER
-
PUBLIC :: INI_AIRCRAFT_BALLOON
CONTAINS
@@ -68,12 +67,11 @@ CONTAINS
! ------------
!
USE MODD_AIRCRAFT_BALLOON
-USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_DIAG_FLAG, ONLY: LAIRCRAFT_BALLOON, NTIME_AIRCRAFT_BALLOON, &
- XALT_BALLOON, XLAT_BALLOON, XLON_BALLOON, XSTEP_AIRCRAFT_BALLOON
+USE MODD_CONF, ONLY: CPROGRAM, NMODEL
USE MODD_DYN_n, ONLY: DYN_MODEL
USE MODD_IO, ONLY: ISP, TFILEDATA
USE MODD_PARAMETERS, ONLY: NUNDEF
+USE MODD_PARAM_n, ONLY: PARAM_MODEL
!
USE MODE_GRIDPROJ, ONLY: SM_XYHAT
USE MODE_INI_AIRCRAFT, ONLY: INI_AIRCRAFT
@@ -95,29 +93,16 @@ REAL, INTENT(IN) :: PLONOR ! longitude of origine point
!
INTEGER :: IMI ! current model index
INTEGER :: JI
+LOGICAL :: GCHECK
!
!----------------------------------------------------------------------------
-!
-IMI=GET_CURRENT_MODEL_INDEX()
-!----------------------------------------------------------------------------
-!
-!* 1. Default values
-! --------------
-!
-IF ( CPROGRAM == 'DIAG ') THEN
- IF ( .NOT. LAIRCRAFT_BALLOON ) RETURN
- IF (NTIME_AIRCRAFT_BALLOON == NUNDEF .OR. XSTEP_AIRCRAFT_BALLOON == XUNDEF) THEN
- CMNHMSG(1) = "NTIME_AIRCRAFT_BALLOON and/or XSTEP_AIRCRAFT_BALLOON not initialized in DIAG "
- CMNHMSG(2) = "No calculations for Balloons and Aircraft"
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_AIRCRAFT_BALLOON' )
-
- LAIRCRAFT_BALLOON=.FALSE.
- RETURN
- ENDIF
-ENDIF
+
+IF ( CPROGRAM == 'DIAG ') RETURN
IF ( NAIRCRAFTS > 0 .OR. NBALLOONS > 0 ) LFLYER = .TRUE.
-!
+
+IMI = GET_CURRENT_MODEL_INDEX()
+
!----------------------------------------------------------------------------
!
!* 2. Balloon initialization
@@ -164,13 +149,50 @@ END IF
!* 4. Allocations of storage arrays
! -----------------------------
!
-IF ( IMI == 1 .AND. ISP == NFLYER_DEFAULT_RANK ) THEN
+! Check that CCLOUD, CRAD and CTURB are the same for all models if some flyers have CMODEL='MOB'
+! This is necessary because we need to allocate and compute the same data on every model if the flyer is allowed to change model
+! This check is only done once (on MODEL IMI=1)
+! This check has to be done AFTER the calls to INI_AIRCRAFT and INI_BALLOON
+IF ( IMI == 1 .AND. NMODEL > 1 .AND. ISP == NFLYER_DEFAULT_RANK ) THEN
+ GCHECK = .FALSE.
+
+ DO JI = 1, NBALLOONS
+ IF ( TBALLOONS(JI)%TBALLOON%CMODEL == 'MOB' ) THEN
+ GCHECK = .TRUE.
+ EXIT
+ END IF
+ END DO
+
+ DO JI = 1, NAIRCRAFTS
+ IF ( TAIRCRAFTS(JI)%TAIRCRAFT%CMODEL == 'MOB' ) THEN
+ GCHECK = .TRUE.
+ EXIT
+ END IF
+ END DO
+
+ IF ( GCHECK ) THEN
+ DO JI = 2, NMODEL
+ IF ( PARAM_MODEL(JI)%CCLOUD /= PARAM_MODEL(1)%CCLOUD ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT_BALLOON', &
+ 'CCLOUD must be the same on all nested domains if aircraft/balloon has CMODEL="MOB"' )
+ IF ( PARAM_MODEL(JI)%CRAD /= PARAM_MODEL(1)%CRAD ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT_BALLOON', &
+ 'CRAD must be the same on all nested domains if aircraft/balloon has CMODEL="MOB"' )
+ IF ( PARAM_MODEL(JI)%CTURB /= PARAM_MODEL(1)%CTURB ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT_BALLOON', &
+ 'CTURB must be the same on all nested domains if aircraft/balloon has CMODEL="MOB"' )
+ END DO
+ END IF
+END IF
+
+! Allocate data arrays of flyers
+IF ( ISP == NFLYER_DEFAULT_RANK ) THEN
DO JI = 1, NBALLOONS
- CALL ALLOCATE_FLYER( TBALLOONS(JI)%TBALLOON )
+ IF ( TBALLOONS(JI)%TBALLOON%NMODEL == IMI ) CALL TBALLOONS(JI)%TBALLOON%DATA_ARRAYS_ALLOCATE()
END DO
DO JI = 1, NAIRCRAFTS
- CALL ALLOCATE_FLYER( TAIRCRAFTS(JI)%TAIRCRAFT )
+ IF ( TAIRCRAFTS(JI)%TAIRCRAFT%NMODEL == IMI ) CALL TAIRCRAFTS(JI)%TAIRCRAFT%DATA_ARRAYS_ALLOCATE()
END DO
END IF
!
@@ -225,6 +247,7 @@ CALL SM_XYHAT( PLATOR, PLONOR, TPFLYER%XLATLAUNCH, TPFLYER%XLONLAUNCH, TPFLYER%X
IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' ) THEN
! Read the current location in the synchronous file
+ ! Remark: if the balloon is not yet in flight or is crashed, position is not available in file
IF ( TPINIFILE%CFORMAT == 'LFI' &
.OR. ( TPINIFILE%CFORMAT == 'NETCDF4' .AND. &
@@ -232,9 +255,9 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
.OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 6 ) ) ) ) THEN
! Read in LFI file or in old format if netCDF (MesoNH < 5.6)
TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(TPFLYER%CTITLE)//'LAT', &
+ CMNHNAME = TRIM(TPFLYER%CNAME)//'LAT', &
CSTDNAME = '', &
- CLONGNAME = TRIM(TPFLYER%CTITLE)//'LAT', &
+ CLONGNAME = TRIM(TPFLYER%CNAME)//'LAT', &
CUNITS = 'degree', &
CDIR = '--', &
CCOMMENT = '', &
@@ -248,9 +271,9 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
GREAD = .TRUE.
TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(TPFLYER%CTITLE)//'LON', &
+ CMNHNAME = TRIM(TPFLYER%CNAME)//'LON', &
CSTDNAME = '', &
- CLONGNAME = TRIM(TPFLYER%CTITLE)//'LON', &
+ CLONGNAME = TRIM(TPFLYER%CNAME)//'LON', &
CUNITS = 'degree', &
CDIR = '--', &
CCOMMENT = '', &
@@ -261,9 +284,9 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
CALL IO_Field_read(TPINIFILE,TZFIELD,ZLON)
TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(TPFLYER%CTITLE)//'ALT', &
+ CMNHNAME = TRIM(TPFLYER%CNAME)//'ALT', &
CSTDNAME = '', &
- CLONGNAME = TRIM(TPFLYER%CTITLE)//'ALT', &
+ CLONGNAME = TRIM(TPFLYER%CNAME)//'ALT', &
CUNITS = 'm', &
CDIR = '--', &
CCOMMENT = '', &
@@ -274,9 +297,9 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
CALL IO_Field_read(TPINIFILE,TZFIELD,TPFLYER%XZ_CUR)
TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(TPFLYER%CTITLE)//'WASCENT', &
+ CMNHNAME = TRIM(TPFLYER%CNAME)//'WASCENT', &
CSTDNAME = '', &
- CLONGNAME = TRIM(TPFLYER%CTITLE)//'WASCENT', &
+ CLONGNAME = TRIM(TPFLYER%CNAME)//'WASCENT', &
CUNITS = 'm s-1', &
CDIR = '--', &
CCOMMENT = '', &
@@ -287,9 +310,9 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
CALL IO_Field_read(TPINIFILE,TZFIELD,TPFLYER%XWASCENT)
TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(TPFLYER%CTITLE)//'RHO', &
+ CMNHNAME = TRIM(TPFLYER%CNAME)//'RHO', &
CSTDNAME = '', &
- CLONGNAME = TRIM(TPFLYER%CTITLE)//'RHO', &
+ CLONGNAME = TRIM(TPFLYER%CNAME)//'RHO', &
CUNITS = 'kg m-3', &
CDIR = '--', &
CCOMMENT = '', &
@@ -304,7 +327,7 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
! Read in netCDF file (new structure since MesoNH 5.6)
IF ( ISP /= TPINIFILE%NMASTER_RANK ) CALL PRINT_MSG( NVERB_ERROR, 'IO', 'INI_LAUNCH', 'process is not the file master process')
- ISTATUS = NF90_INQ_NCID( TPINIFILE%NNCID, TRIM( TPFLYER%CTITLE ), IGROUPID )
+ ISTATUS = NF90_INQ_NCID( TPINIFILE%NNCID, TRIM( TPFLYER%CNAME ), IGROUPID )
IF ( ISTATUS == NF90_NOERR ) THEN
GREAD = .TRUE.
@@ -386,7 +409,7 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
TPFLYER%LFLY = .TRUE.
TPFLYER%TPOS_CUR = TDTCUR
- CMNHMSG(1) = 'current location read from synchronous file for ' // TRIM( TPFLYER%CTITLE )
+ CMNHMSG(1) = 'current location read from synchronous file for ' // TRIM( TPFLYER%CNAME )
IF (TPFLYER%CTYPE== 'CVBALL') THEN
WRITE( CMNHMSG(2), * ) " Lat=", ZLAT, " Lon=", ZLON
WRITE( CMNHMSG(3), * ) " Alt=", TPFLYER%XZ_CUR, " Wasc=", TPFLYER%XWASCENT
@@ -397,7 +420,7 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
ELSE
! The position is not found, data is not in the synchronous file
! Use the position given in namelist
- CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_LAUNCH', 'initial location taken from namelist for ' // TRIM( TPFLYER%CTITLE ) )
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_LAUNCH', 'initial location taken from namelist for ' // TRIM( TPFLYER%CNAME ) )
END IF
! Correct timestep if necessary
@@ -415,24 +438,6 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
CALL FLYER_TIMESTEP_CORRECT( DYN_MODEL(IMODEL)%XTSTEP, TPFLYER )
END IF
- !
-ELSE IF ( CPROGRAM == 'DIAG ' ) THEN
- IF ( LAIRCRAFT_BALLOON ) THEN
- ! read the current location in MODD_DIAG_FLAG
- !
- ZLAT=XLAT_BALLOON(KNBR)
- ZLON=XLON_BALLOON(KNBR)
- TPFLYER%XZ_CUR=XALT_BALLOON(KNBR)
- IF (TPFLYER%XZ_CUR /= XUNDEF .AND. ZLAT /= XUNDEF .AND. ZLON /= XUNDEF ) THEN
- CALL SM_XYHAT( PLATOR, PLONOR, ZLAT, ZLON, TPFLYER%XX_CUR, TPFLYER%XY_CUR )
- TPFLYER%LFLY = .TRUE.
- CMNHMSG(1) = 'current location read from MODD_DIAG_FLAG for ' // TRIM( TPFLYER%CTITLE )
- WRITE( CMNHMSG(2), * ) " Lat=", ZLAT, " Lon=", ZLON," Alt=",TPFLYER%XZ_CUR
- CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_LAUNCH' )
- END IF
- !
- CALL FLYER_TIMESTEP_CORRECT( XSTEP_AIRCRAFT_BALLOON, TPFLYER )
- END IF
END IF
! Restore correct value of GSMONOPROC
@@ -491,7 +496,7 @@ TPFLYER%TFLYER_TIME%XTSTEP = NINT( TPFLYER%TFLYER_TIME%XTSTEP / PTSTEP_MODEL ) *
IF ( ABS( TPFLYER%TFLYER_TIME%XTSTEP - ZTSTEP_OLD ) > 1E-6 ) THEN
WRITE( CMNHMSG(1), '( "Timestep for flyer ", A, " is set to ", EN12.3, " (instead of ", EN12.3, ")" )' ) &
- TPFLYER%CTITLE, TPFLYER%TFLYER_TIME%XTSTEP, ZTSTEP_OLD
+ TPFLYER%CNAME, TPFLYER%TFLYER_TIME%XTSTEP, ZTSTEP_OLD
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_LAUNCH' )
END IF
@@ -501,187 +506,6 @@ END SUBROUTINE FLYER_TIMESTEP_CORRECT
!----------------------------------------------------------------------------
!
END SUBROUTINE INI_AIRCRAFT_BALLOON
-
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
-SUBROUTINE ALLOCATE_FLYER( TPFLYER, KSTORE )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
-USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_CONF_n, ONLY: NRR
-USE MODD_DIAG_FLAG, ONLY: NTIME_AIRCRAFT_BALLOON
-USE MODD_DIM_n, ONLY: NKMAX
-USE MODD_DYN, ONLY: XSEGLEN
-USE MODD_DYN_n, ONLY: DYN_MODEL
-USE MODD_NSV, ONLY: NSV
-USE MODD_PARAMETERS, ONLY: JPVEXT, NNEGUNDEF, XUNDEF
-USE MODD_PARAM_n, ONLY: CCLOUD, CTURB
-USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
-INTEGER, OPTIONAL, INTENT(IN) :: KSTORE
-
-INTEGER :: IKU ! number of vertical levels
-INTEGER :: ISTORE ! number of storage instants
-
-CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'ALLOCATE_FLYER', 'flyer: ' // TRIM(TPFLYER%CTITLE), OLOCAL = .TRUE. )
-
-IKU = NKMAX + 2 * JPVEXT
-
-IF ( PRESENT( KSTORE ) ) THEN
- ISTORE = KSTORE
-ELSE
- IF ( CPROGRAM == 'DIAG ' ) THEN
- ISTORE = INT ( NTIME_AIRCRAFT_BALLOON / TPFLYER%TFLYER_TIME%XTSTEP ) + 1
- ELSE
- ISTORE = NINT ( ( XSEGLEN - DYN_MODEL(1)%XTSTEP ) / TPFLYER%TFLYER_TIME%XTSTEP ) + 1
- ENDIF
-END IF
-!
-ALLOCATE( TPFLYER%TFLYER_TIME%TPDATES(ISTORE) )
-ALLOCATE( TPFLYER%NMODELHIST(ISTORE) )
-ALLOCATE( TPFLYER%XX (ISTORE) )
-ALLOCATE( TPFLYER%XY (ISTORE) )
-ALLOCATE( TPFLYER%XZ (ISTORE) )
-ALLOCATE( TPFLYER%XLON (ISTORE) )
-ALLOCATE( TPFLYER%XLAT (ISTORE) )
-ALLOCATE( TPFLYER%XZON (ISTORE) )
-ALLOCATE( TPFLYER%XMER (ISTORE) )
-ALLOCATE( TPFLYER%XW (ISTORE) )
-ALLOCATE( TPFLYER%XP (ISTORE) )
-ALLOCATE( TPFLYER%XTH (ISTORE) )
-ALLOCATE( TPFLYER%XR (ISTORE, NRR) )
-ALLOCATE( TPFLYER%XSV (ISTORE, NSV) )
-ALLOCATE( TPFLYER%XRTZ (ISTORE, IKU) )
-ALLOCATE( TPFLYER%XRZ (ISTORE, IKU, NRR) )
-ALLOCATE( TPFLYER%XFFZ (ISTORE, IKU) )
-ALLOCATE( TPFLYER%XIWCZ(ISTORE, IKU) )
-ALLOCATE( TPFLYER%XLWCZ(ISTORE, IKU) )
-ALLOCATE( TPFLYER%XCIZ (ISTORE, IKU) )
-IF ( CCLOUD == 'LIMA' ) THEN
- ALLOCATE( TPFLYER%XCCZ(ISTORE, IKU) )
- ALLOCATE( TPFLYER%XCRZ(ISTORE, IKU) )
-ELSE
- ALLOCATE( TPFLYER%XCCZ(0, 0) )
- ALLOCATE( TPFLYER%XCRZ(0, 0) )
-ENDIF
-ALLOCATE( TPFLYER%XCRARE (ISTORE, IKU) )
-ALLOCATE( TPFLYER%XCRARE_ATT(ISTORE, IKU) )
-ALLOCATE( TPFLYER%XWZ (ISTORE, IKU) )
-ALLOCATE( TPFLYER%XZZ (ISTORE, IKU) )
-IF ( CTURB == 'TKEL' ) THEN
- ALLOCATE( TPFLYER%XTKE(ISTORE) )
-ELSE
- ALLOCATE( TPFLYER%XTKE(0) )
-END IF
-ALLOCATE( TPFLYER%XTKE_DISS(ISTORE) )
-ALLOCATE( TPFLYER%XTSRAD (ISTORE) )
-ALLOCATE( TPFLYER%XZS (ISTORE) )
-
-ALLOCATE( TPFLYER%XTHW_FLUX(ISTORE) )
-ALLOCATE( TPFLYER%XRCW_FLUX(ISTORE) )
-ALLOCATE( TPFLYER%XSVW_FLUX(ISTORE, NSV) )
-
-TPFLYER%NMODELHIST = NNEGUNDEF
-TPFLYER%XX = XUNDEF
-TPFLYER%XY = XUNDEF
-TPFLYER%XZ = XUNDEF
-TPFLYER%XLON = XUNDEF
-TPFLYER%XLAT = XUNDEF
-TPFLYER%XZON = XUNDEF
-TPFLYER%XMER = XUNDEF
-TPFLYER%XW = XUNDEF
-TPFLYER%XP = XUNDEF
-TPFLYER%XTH = XUNDEF
-TPFLYER%XR = XUNDEF
-TPFLYER%XSV = XUNDEF
-TPFLYER%XRTZ = XUNDEF
-TPFLYER%XRZ = XUNDEF
-TPFLYER%XFFZ = XUNDEF
-TPFLYER%XIWCZ = XUNDEF
-TPFLYER%XLWCZ = XUNDEF
-TPFLYER%XCIZ = XUNDEF
-TPFLYER%XCCZ = XUNDEF
-TPFLYER%XCRZ = XUNDEF
-TPFLYER%XCRARE = XUNDEF
-TPFLYER%XCRARE_ATT = XUNDEF
-TPFLYER%XWZ = XUNDEF
-TPFLYER%XZZ = XUNDEF
-TPFLYER%XTKE = XUNDEF
-TPFLYER%XTKE_DISS = XUNDEF
-TPFLYER%XTSRAD = XUNDEF_SFX
-TPFLYER%XZS = XUNDEF
-
-TPFLYER%XTHW_FLUX = XUNDEF
-TPFLYER%XRCW_FLUX = XUNDEF
-TPFLYER%XSVW_FLUX = XUNDEF
-
-END SUBROUTINE ALLOCATE_FLYER
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE DEALLOCATE_FLYER( TPFLYER )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TAIRCRAFTDATA, TFLYERDATA
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
-
-CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'DEALLOCATE_FLYER', 'flyer: ' // TRIM(TPFLYER%CTITLE), OLOCAL = .TRUE. )
-
-DEALLOCATE( TPFLYER%TFLYER_TIME%TPDATES )
-DEALLOCATE( TPFLYER%NMODELHIST )
-DEALLOCATE( TPFLYER%XX )
-DEALLOCATE( TPFLYER%XY )
-DEALLOCATE( TPFLYER%XZ )
-DEALLOCATE( TPFLYER%XLON )
-DEALLOCATE( TPFLYER%XLAT )
-DEALLOCATE( TPFLYER%XZON )
-DEALLOCATE( TPFLYER%XMER )
-DEALLOCATE( TPFLYER%XW )
-DEALLOCATE( TPFLYER%XP )
-DEALLOCATE( TPFLYER%XTH )
-DEALLOCATE( TPFLYER%XR )
-DEALLOCATE( TPFLYER%XSV )
-DEALLOCATE( TPFLYER%XRTZ )
-DEALLOCATE( TPFLYER%XRZ )
-DEALLOCATE( TPFLYER%XFFZ )
-DEALLOCATE( TPFLYER%XIWCZ )
-DEALLOCATE( TPFLYER%XLWCZ )
-DEALLOCATE( TPFLYER%XCIZ )
-DEALLOCATE( TPFLYER%XCCZ )
-DEALLOCATE( TPFLYER%XCRZ )
-DEALLOCATE( TPFLYER%XCRARE )
-DEALLOCATE( TPFLYER%XCRARE_ATT )
-DEALLOCATE( TPFLYER%XWZ )
-DEALLOCATE( TPFLYER%XZZ )
-DEALLOCATE( TPFLYER%XTKE )
-DEALLOCATE( TPFLYER%XTKE_DISS )
-DEALLOCATE( TPFLYER%XTSRAD )
-DEALLOCATE( TPFLYER%XZS )
-
-DEALLOCATE( TPFLYER%XTHW_FLUX )
-DEALLOCATE( TPFLYER%XRCW_FLUX )
-DEALLOCATE( TPFLYER%XSVW_FLUX )
-
-SELECT TYPE( TPFLYER )
- CLASS IS ( TAIRCRAFTDATA )
- DEALLOCATE( TPFLYER%XPOSLAT )
- DEALLOCATE( TPFLYER%XPOSLON )
- DEALLOCATE( TPFLYER%XPOSX )
- DEALLOCATE( TPFLYER%XPOSY )
- IF ( TPFLYER%LALTDEF ) THEN
- DEALLOCATE( TPFLYER%XPOSP )
- ELSE
- DEALLOCATE( TPFLYER%XPOSZ )
- END IF
- DEALLOCATE( TPFLYER%XPOSTIME )
-END SELECT
-
-END SUBROUTINE DEALLOCATE_FLYER
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-
END MODULE MODE_INI_AIRCRAFT_BALLOON
diff --git a/src/MNH/ini_balloon.f90 b/src/MNH/ini_balloon.f90
index 342eb5abfe3a76cc51e44df83376f90a728f3b7f..e3ca63c57f4548453f78fef314f1cf78e9f11ed2 100644
--- a/src/MNH/ini_balloon.f90
+++ b/src/MNH/ini_balloon.f90
@@ -17,84 +17,6 @@ CONTAINS
SUBROUTINE INI_BALLOON
! ######################
!
-!
-!!**** *INI_BALLOON* - user initializes the balloon characteristics
-!!
-!! PURPOSE
-!! -------
-!
-!
-!!** METHOD
-!! ------
-!!
-!! For constant volume Balloon, horizontal advection using horizontal wind
-!! vertical speed of the balloon calculated using the balloon equation
-!! (Koffi et AL 2000, JAS vol 57 P.2007-2021)
-!!
-!! Must be defined (for each balloon):
-!! ---------------
-!!
-!! No default exist for these variables.
-!! ************************************
-!!
-!! 1) the model in which the balloon will evolve
-!! if NOT initialized, the balloon is NOT used.
-!! 1.1) the possibility to switch from a model to its dad or kid
-!! 'FIX' : NMODEL used during the run
-!! 'MOB' : best resolution model used. NMODEL=1 is used at the beginning
-!!
-!! 2) the type of balloon
-!!
-!! 'RADIOS' for radiosounding balloon
-!! 'ISODEN' for iso-density balloon
-!! 'CVBALL' for constant volume Balloon
-!!
-!! 3) the launching date and time
-!!
-!! 4) the latitude of the launching site
-!!
-!! 5) the longitude of the launching site
-!!
-!! 6) the altitude of the launching site (for 'RADIOS')
-!!
-!! OR
-!!
-!! the altitude OR pressure of balloon at start of the leveled flight
-!! (for 'ISODEN'). In this case, the density of this level will be computed,
-!! and the balloon will evolve at this density level.
-!!
-!!
-!!
-!! Can be defined (for each balloon):
-!! --------------
-!!
-!! 7) the ascentional vertical speed of the ballon (in calm air) (for 'RADIOS')
-!! default is 5m/s
-!!
-!! 8) the time step for data storage.
-!! default is 60s
-!!
-!! 9) the name or title describing the balloon (8 characters)
-!! default is the balloon type (6 characters) + the balloon numbers (2 characters)
-!!
-!! 10) for 'CVBALL' the aerodynamic drag coefficient of the balloon
-!!
-!! 11) for 'CVBALL' the induced drag coefficient (i.e. air shifted by the balloon)
-!!
-!! 12) for 'CVBALL' the volume of the balloon
-!!
-!! 13) for 'CVBALL' the mass of the balloon
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
!! AUTHOR
!! ------
!! Valery Masson * Meteo-France *
@@ -126,6 +48,8 @@ DO JI = 1, NBALLOONS
TZBALLOON%NID = JI
+ TZBALLOON%LFIX = .FALSE.
+
IF ( CTITLE(JI) == '' ) THEN
WRITE( CTITLE(JI), FMT = '( A, I3.3) ') TRIM( CTYPE(JI) ), JI
@@ -133,7 +57,7 @@ DO JI = 1, NBALLOONS
CMNHMSG(2) = 'title set to ' // TRIM( CTITLE(JI) )
CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_BALLOON', OLOCAL = .TRUE. )
END IF
- TZBALLOON%CTITLE = CTITLE(JI)
+ TZBALLOON%CNAME = CTITLE(JI)
IF ( CMODEL(JI) == 'FIX' ) THEN
IF ( NMODEL(JI) < 1 .OR. NMODEL(JI) > NMODEL_NEST ) THEN
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index c81a19fe8c4644ad61a9ae27f111daec4711169d..cdd35bb47c5bd743899fb2bbbee8d14671686b3b 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -524,9 +524,6 @@ INTEGER :: IIU_B,IJU_B
INTEGER :: IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZCO2 ! CO2 concentration near the surface
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSEA ! sea fraction
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTOWN ! town fraction
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZBARE ! bare soil fraction
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
@@ -2638,17 +2635,6 @@ IF (CRAD == 'ECMW') THEN
!* get cover mask for aerosols
!
IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN
- ALLOCATE(ZSEA(IIU,IJU))
- ALLOCATE(ZTOWN(IIU,IJU))
- ALLOCATE(ZBARE(IIU,IJU))
- IF (CSURF=='EXTE') THEN
- CALL GOTO_SURFEX(KMI)
- CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
- ELSE
- ZSEA (:,:) = 1.
- ZTOWN(:,:) = 0.
- ZBARE(:,:) = 0.
- END IF
!
IF ( CAOP=='EXPL' .AND. LDUST .AND. KMI==1) THEN
ALLOCATE( XEXT_COEFF_WVL_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
@@ -2666,9 +2652,8 @@ IF (CRAD == 'ECMW') THEN
!
CALL INI_RADIATIONS_ECMWF (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
- XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
+ XSTATM, XOZON, XAER,XDST_WL, LSUBG_COND )
!
- DEALLOCATE(ZSEA,ZTOWN,ZBARE)
ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
XAER_CLIM(:,:,:,:) =XAER(:,:,:,:)
!
@@ -2679,23 +2664,11 @@ ELSE IF (CRAD == 'ECRA') THEN
!* get cover mask for aerosols
!
IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN
- ALLOCATE(ZSEA(IIU,IJU))
- ALLOCATE(ZTOWN(IIU,IJU))
- ALLOCATE(ZBARE(IIU,IJU))
- IF (CSURF=='EXTE') THEN
- CALL GOTO_SURFEX(KMI)
- CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
- ELSE
- ZSEA (:,:) = 1.
- ZTOWN(:,:) = 0.
- ZBARE(:,:) = 0.
- END IF
!
CALL INI_RADIATIONS_ECRAD (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
- XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
+ XSTATM, XOZON, XAER,XDST_WL, LSUBG_COND )
- DEALLOCATE(ZSEA,ZTOWN,ZBARE)
ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
XAER_CLIM(:,:,:,:) = XAER(:,:,:,:)
!
diff --git a/src/MNH/ini_posprofilern.f90 b/src/MNH/ini_posprofilern.f90
index 674dab0d8b87fa1096fce764af6ff069161da646..6a50b045d044f43e3a1ae420c44edadfc66d488c 100644
--- a/src/MNH/ini_posprofilern.f90
+++ b/src/MNH/ini_posprofilern.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -67,7 +67,7 @@ USE MODD_TYPE_STATPROF, ONLY: TPROFILERDATA
USE MODE_MSG
USE MODE_STATPROF_READER, ONLY: STATPROF_CSV_READ
-USE MODE_STATPROF_TOOLS, ONLY: PROFILER_ADD, PROFILER_ALLOCATE, STATPROF_INI_INTERP, STATPROF_POSITION
+USE MODE_STATPROF_TOOLS, ONLY: PROFILER_ADD, STATPROF_INI_INTERP, STATPROF_POSITION
IMPLICIT NONE
!
@@ -105,20 +105,23 @@ allocate( tprofilers_time%tpdates(istore) )
NUMBPROFILER_LOC = 0
IF (CFILE_PROF=="NO_INPUT_CSV") THEN
+ IF ( NNUMB_PROF > NNOCSVPROFILERMAX ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'INI_POSPROFILER_n', 'number of profilers is limited to NNOCSVPROFILERMAX' )
+
! Treat namelist
INUMBPROF = 0
IF ( NNUMB_PROF > 0 ) THEN
DO JI = 1, NNUMB_PROF
IF ( LCARTESIAN ) THEN
- TZPROFILER%XX = XX_PROF(JI)
- TZPROFILER%XY = XY_PROF(JI)
+ TZPROFILER%XX_CUR = XX_PROF(JI)
+ TZPROFILER%XY_CUR = XY_PROF(JI)
ELSE
- TZPROFILER%XLAT = XLAT_PROF(JI)
- TZPROFILER%XLON = XLON_PROF(JI)
+ TZPROFILER%XLAT_CUR = XLAT_PROF(JI)
+ TZPROFILER%XLON_CUR = XLON_PROF(JI)
CALL STATPROF_INI_INTERP( TZPROFILER )
END IF
- TZPROFILER%XZ = XZ_PROF(JI)
- TZPROFILER%CNAME = CNAME_PROF(JI)
+ TZPROFILER%XZ_CUR = XZ_PROF(JI)
+ TZPROFILER%CNAME = CNAME_PROF(JI)
CALL STATPROF_POSITION( TZPROFILER, GINSIDE, GPRESENT )
@@ -138,7 +141,8 @@ END IF
LPROFILER = ( INUMBPROF > 0 )
DO JI = 1, NUMBPROFILER_LOC
- CALL PROFILER_ALLOCATE( TPROFILERS(JI), ISTORE )
+ TPROFILERS(JI)%LFIX = .TRUE.
+ CALL TPROFILERS(JI)%DATA_ARRAYS_ALLOCATE( ISTORE )
END DO
!----------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_radiations_ecmwf.f90 b/src/MNH/ini_radiations_ecmwf.f90
index e8f11de28487376225ce40d9803858ab0ba1308d..73aa70d072869c00657eda7dbd1264212b3981a9 100644
--- a/src/MNH/ini_radiations_ecmwf.f90
+++ b/src/MNH/ini_radiations_ecmwf.f90
@@ -12,7 +12,7 @@ INTERFACE
SUBROUTINE INI_RADIATIONS_ECMWF( &
PZHAT, PPABST, PTHT, PTSRAD, PLAT, PLON, TPDTCUR, TPDTEXP, &
HLW, KDLON, KFLEV, KFLUX, KRAD, KSWB, HAER, KAER, KSTATM, &
- PSTATM, PSEA, PTOWN, PBARE, POZON, PAER, PDST_WL, OSUBG_COND )
+ PSTATM, POZON, PAER, PDST_WL, OSUBG_COND )
!
USE MODD_TYPE_DATE
!
@@ -23,9 +23,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST! pressure
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !Temperature
REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD ! surface radiative temperature
-REAL, DIMENSION (:,:), INTENT(IN) :: PSEA ! sea fraction
-REAL, DIMENSION (:,:), INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION (:,:), INTENT(IN) :: PBARE ! bare soil fraction
REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON ! arrays of latitude-longitude
!
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
@@ -61,7 +58,7 @@ END MODULE MODI_INI_RADIATIONS_ECMWF
SUBROUTINE INI_RADIATIONS_ECMWF( &
PZHAT, PPABST, PTHT, PTSRAD, PLAT, PLON, TPDTCUR, TPDTEXP, &
HLW, KDLON, KFLEV, KFLUX, KRAD, KSWB, HAER, KAER, KSTATM, &
- PSTATM, PSEA, PTOWN, PBARE, POZON, PAER, PDST_WL, OSUBG_COND )
+ PSTATM, POZON, PAER, PDST_WL, OSUBG_COND )
! ###################################################################
!
!!**** *INI_RADIATIONS * - initialisation for ECMWF radiation scheme in the MesoNH framework
@@ -181,10 +178,6 @@ END MODULE MODI_INI_RADIATIONS_ECMWF
!ECMWF radiation scheme specific modules
!
USE OYOMCST, ONLY: RTT
-USE PARKIND1, ONLY: JPRB
-USE YOEAERD, ONLY: RCAEOPS, RCAEOPL, RCAEOPU, RCAEOPD, RCTRBGA, &
- RCVOBGA, RCSTBGA, RCTRPT, RCAEADM, RCAEROS, &
- RCAEADK
USE YOETHF, ONLY: RTICE
!
!MESO-NH modules
@@ -205,7 +198,7 @@ USE MODE_ll
USE MODE_REPRO_SUM
USE MODE_SALTOPT
!
-USE MODI_INI_HOR_AERCLIM
+USE MODI_AEROZON
USE MODI_INI_RADCONF
USE MODI_INI_STAND_ATM
USE MODI_RADAER
@@ -224,9 +217,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST! pressure
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !Temperature
REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD ! surface radiative temperature
-REAL, DIMENSION (:,:), INTENT(IN) :: PSEA ! sea fraction
-REAL, DIMENSION (:,:), INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION (:,:), INTENT(IN) :: PBARE ! bare soil fraction
REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON ! arrays of latitude-longitude
!
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
@@ -258,11 +248,8 @@ LOGICAL :: GWINTER ! .T. when WINTERtime
LOGICAL :: GSEASON ! .T. when SUMMERtime in the northern hemisphere or
! when WINTERtime in the southern hemisphere
!
-INTEGER :: JI, JJ, JK, JK1, JKRAD,IIJ,JL ! loop index
-!
INTEGER :: IIB ! I index value of the first inner mass point
INTEGER :: IJB ! J index value of the first inner mass point
-INTEGER :: IKB ! K index value of the first inner mass point
INTEGER :: IIE ! I index value of the last inner mass point
INTEGER :: IJE ! J index value of the last inner mass point
INTEGER :: IKE ! K index value of the last inner mass point
@@ -275,7 +262,6 @@ REAL :: ZLATMEAN ! MEAN LATitude in the domain
REAL :: ZLAT_TROPICAL ! TROPIQUE LATitude
REAL :: ZLAT_POLAR ! POLAR circle LATitude
!
-REAL, DIMENSION(:,:),ALLOCATABLE :: ZLON ! longitude
REAL, DIMENSION(SIZE(PSTATM,1)) :: ZZSTAT ! half level altitudes of standard atm.
!
INTEGER :: IINFO_ll ! return code of parallel routine
@@ -283,20 +269,8 @@ INTEGER :: IIMAX_ll,IJMAX_ll ! Number of points of
! Global physical domain
! in the x and y directions
!
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZEXNT ! Exner function
-!
! Variables for aerosols and ozone climatologies set up
-REAL, DIMENSION (:), ALLOCATABLE :: ZAESEA, ZAELAN, ZAEURB, ZAEDES
-REAL(KIND=JPRB), DIMENSION (:), ALLOCATABLE :: ZAESEA_RAD, ZAELAN_RAD, ZAEURB_RAD, ZAEDES_RAD
-LOGICAL, DIMENSION (:,:),ALLOCATABLE :: GAFRICA, GASIA, GAUSTRALIA
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZDESERT ! desert fraction
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZPAVE, ZWORK_GRID
-REAL(KIND=JPRB), DIMENSION (:,:,:), ALLOCATABLE :: ZAER
-REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZPRES_HL,ZT_HL,ZOZON
-REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZCVDAES, ZCVDAEL, ZCVDAEU, ZCVDAED,ZETAH
-REAL(KIND=JPRB), DIMENSION (:), ALLOCATABLE :: ZGEMU
-REAL, DIMENSION(:), ALLOCATABLE :: ZAECOV_SEA, ZAECOV_URB, ZAECOV_LAN, ZAECOV_DES
-INTEGER :: ZYMD, ZHOURS ! date for climatology initialisation
+REAL :: ZSINDEL,ZCOSDEL,ZTSIDER,ZCORSOL ! astronomical parameters not used here
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
@@ -310,7 +284,6 @@ CALL GET_DIM_EXT_ll ('B',IIU,IJU)
IKU = SIZE(PTHT,3)
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB = 1 + JPVEXT
IKE = IKU - JPVEXT
!
! size of global physical domain
@@ -430,272 +403,25 @@ CALL INI_RADCONF (HLW,KSWB,OSUBG_COND)
!* 8. INITIALIZE RADIATIVELY ACTIVE COMPOUNDS (3D FIELDS)
! ------------------------------------------------------
!
-!* 8.1 set up for grid dependant quantitites (from initial state)
-!
-ALLOCATE (ZPRES_HL(KDLON,KFLEV+1))
-ALLOCATE (ZPAVE(KDLON,KFLEV))
-ALLOCATE (ZETAH(KDLON,KFLEV+1))
-ALLOCATE (ZT_HL(KDLON,KFLEV+1))
-ALLOCATE (ZGEMU(KDLON))
-ZT_HL(:,:) = 273.
-!
-ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-DO JK=IKB,IKE+1
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZPRES_HL(IIJ,JKRAD) = XP00 * (0.5*(ZEXNT(JI,JJ,JK)+ZEXNT(JI,JJ,JK-1)))**(XCPD/XRD)
- ZT_HL(IIJ,JKRAD) = 0.5*(PTHT(JI,JJ,JK)*ZEXNT(JI,JJ,JK)+PTHT(JI,JJ,JK-1)*ZEXNT(JI,JJ,JK-1))
- END DO
- END DO
-END DO
-!
-! Surface temperature at the first level
-!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZT_HL(IIJ,1) = PTSRAD(JI,JJ)
- END DO
-END DO
-WHERE (ZT_HL(:,:) == 0.)
- ZT_HL(:,:) = 273.
-ENDWHERE
-!
-! Standard atmosphere extension
-!* begining at ikup+1 level allows to use a model domain higher than 50km
-!
-IKUP = IKE-JPVEXT+1
-!
-DO JK=IKUP+1,KFLEV+1
- JK1 = (KSTATM-1)+(JK-IKUP)
- ZPRES_HL(:,JK) = PSTATM(JK1,2)*100.0
- ZT_HL(:,JK) = PSTATM(JK1,3)
-END DO
-!
-! vertical grid inversion for compatibility with ECMWF routines
-!
-ALLOCATE (ZWORK_GRID(SIZE(ZPRES_HL,1),KFLEV+1))
-!
-!half level pressure
-!
-ZWORK_GRID(:,:)=ZPRES_HL(:,:)
-DO JKRAD=1, KFLEV+1
- JK1=(KFLEV+1)+1-JKRAD
- ZPRES_HL(:,JKRAD) = ZWORK_GRID(:,JK1)
-END DO
-!
-!half level temperature
-!
-ZWORK_GRID(:,:)=ZT_HL(:,:)
-DO JKRAD=1, KFLEV+1
- JK1=(KFLEV+1)+1-JKRAD
- ZT_HL(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-DEALLOCATE(ZWORK_GRID)
-!
-DO JKRAD=1,KFLEV
- ZPAVE(:,JKRAD)=0.5*(ZPRES_HL(:,JKRAD)+ZPRES_HL(:,JKRAD+1))
-END DO
-!
-!coo geographique
-!
-IF(.NOT.LCARTESIAN) THEN
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZGEMU(IIJ) = SIN ( PLAT(JI,JJ) * XPI/180)
- END DO
- END DO
-ELSE
- ZGEMU(:) = SIN ( XLAT0 * XPI/180)
-END IF
-!
-!* 8.2 OZONE climatology
-!
-ALLOCATE (ZOZON(KDLON,KFLEV))
-!
-IF (LFIX_DAT ) THEN ! Ajout PP
- ZYMD = TPDTEXP%nyear * 1E4 + TPDTEXP%nmonth * 1E2 + TPDTEXP%nday
- ZHOURS = INT(TPDTEXP%xtime / 60.)
-ELSE
- ZYMD = TPDTCUR%nyear * 1E4 + TPDTCUR%nmonth * 1E2 + TPDTCUR%nday
- ZHOURS = INT(TPDTCUR%xtime / 60.)
-END IF
-!
-! Fortuin langematz climatology loading
-!
-CALL SUECOZC ( ZYMD , ZHOURS )
-!
-! Interpolation on the simulation domain
-!
-CALL RADOZC ( 1 , KDLON, KDLON , 1, KFLEV, 1 ,&
- KDLON ,0,ZPRES_HL, ZGEMU, &
- ZOZON )
-!
-!* 8.3 AEROSOLS climatogy
-!
-ALLOCATE (ZAER(KDLON, KFLEV,KAER))
-!
-IF(HAER /= 'NONE') THEN
-!
-! 8.3.1 horizontal ditributions
+!* 8.1 Aerosols and Ozone climatologies
!
- ALLOCATE (ZAESEA(KDLON))
- ALLOCATE (ZAELAN(KDLON))
- ALLOCATE (ZAEURB(KDLON))
- ALLOCATE (ZAEDES(KDLON))
-
- ALLOCATE (ZAESEA_RAD(KDLON))
- ALLOCATE (ZAELAN_RAD(KDLON))
- ALLOCATE (ZAEURB_RAD(KDLON))
- ALLOCATE (ZAEDES_RAD(KDLON))
-!
-! AEROSOLS ECMWF climatologies
-!
- IF ( HAER =='TANR' .OR. HAER == 'TEGE' ) THEN
- CALL INI_HOR_AERCLIM (HAER,IIB,IIE,IJB,IJE,KDLON,ZYMD,ZHOURS, &
- PLAT,PLON,ZAESEA,ZAELAN,ZAEURB,ZAEDES )
- END IF
-!
-! AEROSOLS from SURFACE FRACTIONS
-!
- IF( HAER =='SURF') THEN
+ALLOCATE (POZON(IIU,IJU,KFLEV))
+ALLOCATE (PAER(IIU,IJU,KFLEV,KAER))
!
- !* deserts are only considered over Africa, southern Asia, Australia
- !* longitude between -180 and 180 for geographical tests
- ! Only bare soil fractions larger than 0.5 are supposed to contribute to
- ! desert aerosols
- !
- ALLOCATE(ZDESERT (IIU,IJU))
- ZDESERT(:,:) = 0.
-
- IF (.NOT.LCARTESIAN) THEN
- !* deserts are only considered over Africa, southern Asia, Australia
- ALLOCATE(ZLON (IIU,IJU))
- ALLOCATE(GAFRICA (IIU,IJU))
- ALLOCATE(GASIA (IIU,IJU))
- ALLOCATE(GAUSTRALIA(IIU,IJU))
- !* longitude between -180 and 180 for geographical tests
- ZLON = PLON(:,:) - NINT(PLON/360.)*360.
- GAFRICA (:,:) = PLAT(:,:) > -36.086389 .AND. PLAT(:,:) < 36.010556 &
- .AND. ZLON(:,:) > -73.18 .AND. ZLON(:,:) < 34.158611
- GASIA (:,:) = PLAT(:,:) > 4.358056 .AND. PLAT(:,:) < 55.335278 &
- .AND. ZLON(:,:) > -123.157778 .AND. ZLON(:,:) <-34.285556
- GAUSTRALIA(:,:) = PLAT(:,:) > -39.561389 .AND. PLAT(:,:) < -10.251667 &
- .AND. ZLON(:,:) > -155.041944 .AND. ZLON(:,:) < -111.405556
- !
- ! Only bare soil fractions larger than 0.5 are supposed to contribute to
- ! desert aerosols
- !
- WHERE (GAFRICA(:,:) .OR. GASIA(:,:) .OR. GAUSTRALIA(:,:)) &
- ZDESERT(:,:) = MAX( 2.*(PBARE(:,:)-0.5) , 0.)
- !
- !
- ELSE
- !
- ZDESERT(:,:) = MAX( 2.*(PBARE(:,:)-0.5) , 0.)
- !
- ENDIF
- !
- !* fills sea, town, desert and land surface covers for aerosols distributions
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZAESEA(IIJ) = PSEA(JI,JJ)
- ZAEURB(IIJ) = PTOWN(JI,JJ)
- ZAEDES(IIJ) = ZDESERT(JI,JJ)
- ZAELAN(IIJ) = MAX( 1.- ZAESEA(IIJ) - ZAEURB(IIJ) - ZAEDES(IIJ) , 0.)
- END DO
- END DO
- IF (ALLOCATED(ZLON)) DEALLOCATE(ZLON)
- IF (ALLOCATED(GAFRICA)) DEALLOCATE(GAFRICA)
- IF (ALLOCATED(GASIA)) DEALLOCATE(GASIA)
- IF (ALLOCATED(GAUSTRALIA)) DEALLOCATE(GAUSTRALIA)
- IF (ALLOCATED(ZDESERT)) DEALLOCATE(ZDESERT)
-
- END IF
+CALL AEROZON(PPABST,PTHT,PTSRAD,PLAT,PLON,TPDTCUR,TPDTEXP, &
+ KDLON,KFLEV,HAER,KAER,KSTATM, &
+ ZSINDEL,ZCOSDEL,ZTSIDER,ZCORSOL, &
+ PSTATM,POZON, PAER)
!
-! 8.3.2 vertical ditributions (standard profiles derived from Tanre)
-!
- ALLOCATE (ZCVDAES(KDLON,KFLEV+1))
- ALLOCATE (ZCVDAEL(KDLON,KFLEV+1))
- ALLOCATE (ZCVDAEU(KDLON,KFLEV+1))
- ALLOCATE (ZCVDAED(KDLON,KFLEV+1))
- DO JL=1,KDLON
- ZETAH(JL,:)=ZPRES_HL(JL,:)/101300. ! reference pressure for normalisation
- END DO
- WHERE (ZETAH (:,:) > 1.)
- ZETAH(:,:)=1.
- END WHERE
-!
-! set up of vertical ditribution parameters
- CALL SUAERV ( KDLON, KFLEV , ZETAH, &
- ZCVDAES ,ZCVDAEL ,ZCVDAEU ,ZCVDAED, &
- RCTRBGA,RCVOBGA,RCSTBGA,RCAEOPS,RCAEOPL,RCAEOPU,&
- RCAEOPD,RCTRPT ,RCAEADK,RCAEADM,RCAEROS )
-!
-! modification of initial ECMWF maximum optical thickness
-! for aerosols classes in case of HAER=SURF
-! note : these variables belongs to yoeaerd module
-!
- IF ( HAER =='SURF') THEN
- RCAEOPS = 0.001 ! Sea instead 0.02 to agree with TEGEN
- RCAEOPL = 0.05 ! Land (continental)
- RCAEOPU = 0.3 ! Urban zone
- RCAEOPD = 0.5 ! Desert
- END IF
!
-! final aerosol profiles on mnh grid
-!
- ZAESEA_RAD = ZAESEA ; ZAELAN_RAD = ZAELAN ; ZAEURB_RAD = ZAEURB ; ZAEDES_RAD = ZAEDES
- CALL RADAER (1, KDLON, KDLON, 1, KFLEV, ZPRES_HL,ZT_HL, &
- ZCVDAES ,ZCVDAEL ,ZCVDAEU ,ZCVDAED, &
- ZAESEA_RAD, ZAELAN_RAD, ZAEURB_RAD, ZAEDES_RAD, &
- ZAER )
-!
-!!- VOLCANIC AEROSOL SET TO epsilon IN ABSENCE OF ERUPTION
- ZAER(:,:,5) = 1.E-12
-!
- DEALLOCATE (ZCVDAES)
- DEALLOCATE (ZCVDAEL)
- DEALLOCATE (ZCVDAEU)
- DEALLOCATE (ZCVDAED)
- DEALLOCATE (ZAESEA)
- DEALLOCATE (ZAELAN)
- DEALLOCATE (ZAEURB)
- DEALLOCATE (ZAEDES)
-
- DEALLOCATE (ZAESEA_RAD)
- DEALLOCATE (ZAELAN_RAD)
- DEALLOCATE (ZAEURB_RAD)
- DEALLOCATE (ZAEDES_RAD)
-ELSE
- ZAER(:,:,:)= 1E-12
-END IF
+!-------------------------------------------------------------------------------
!
-!* 8.4 Adaptation on mnh domain
+!* 8.4 Dusts
!
-ALLOCATE (POZON(IIU,IJU,KFLEV))
-ALLOCATE (PAER(IIU,IJU,KFLEV,KAER))
ALLOCATE (PDST_WL(IIU,IJU,KFLEV,KSWB))
!
-POZON (:,:,:)=0.
-PAER (:,:,:,:)=0.
PDST_WL (:,:,:,:)=0.
!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- DO JKRAD=1,KFLEV
- JK1 = KFLEV +1 -JKRAD
- POZON (JI,JJ,JKRAD) = ZOZON (IIJ,JK1)
- PAER (JI,JJ,JKRAD,:) = ZAER (IIJ,JK1,:)
- END DO
- END DO
-END DO
!
! Read in look up tables of dust optical properties
!No arguments, all look up tables are defined in module
@@ -727,13 +453,6 @@ IF ( LSALT .AND. CAOP=='EXPL' ) THEN
END IF
!
CALL INI_CONS_PROP_OP
-DEALLOCATE (ZPRES_HL)
-DEALLOCATE (ZPAVE)
-DEALLOCATE (ZT_HL)
-DEALLOCATE (ZETAH)
-DEALLOCATE (ZGEMU)
-DEALLOCATE (ZOZON)
-DEALLOCATE (ZAER)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_radiations_ecrad.f90 b/src/MNH/ini_radiations_ecrad.f90
index 7c9349afeb1656c871411d9b57f8d9c34ffa569d..5e3c184b1f03effecd772acfcce3b7ad0609d115 100644
--- a/src/MNH/ini_radiations_ecrad.f90
+++ b/src/MNH/ini_radiations_ecrad.f90
@@ -12,7 +12,7 @@ INTERFACE
SUBROUTINE INI_RADIATIONS_ECRAD( &
PZHAT, PPABST, PTHT, PTSRAD, PLAT, PLON, TPDTCUR, TPDTEXP, &
HLW, KDLON, KFLEV, KFLUX, KRAD, KSWB_OLD, HAER, KAER, KSTATM, &
- PSTATM, PSEA, PTOWN, PBARE, POZON, PAER, PDST_WL, OSUBG_COND )
+ PSTATM, POZON, PAER, PDST_WL, OSUBG_COND )
!
USE MODD_TYPE_DATE
@@ -23,9 +23,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST! pressure
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !Temperature
REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD ! surface radiative temperature
-REAL, DIMENSION (:,:), INTENT(IN) :: PSEA ! sea fraction
-REAL, DIMENSION (:,:), INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION (:,:), INTENT(IN) :: PBARE ! bare soil fraction
REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON ! arrays of latitude-longitude
!
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
@@ -61,7 +58,7 @@ END MODULE MODI_INI_RADIATIONS_ECRAD
SUBROUTINE INI_RADIATIONS_ECRAD( &
PZHAT, PPABST, PTHT, PTSRAD, PLAT, PLON, TPDTCUR, TPDTEXP, &
HLW, KDLON, KFLEV, KFLUX, KRAD, KSWB_OLD, HAER, KAER, KSTATM, &
- PSTATM, PSEA, PTOWN, PBARE, POZON, PAER, PDST_WL, OSUBG_COND )
+ PSTATM, POZON, PAER, PDST_WL, OSUBG_COND )
! ####################################################################
!
! INI_RADIATIONS_ECRAD - Initialization of ECRAD code
@@ -121,9 +118,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST! pressure
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !Temperature
REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD ! surface radiative temperature
-REAL, DIMENSION (:,:), INTENT(IN) :: PSEA ! sea fraction
-REAL, DIMENSION (:,:), INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION (:,:), INTENT(IN) :: PBARE ! bare soil fraction
REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON ! arrays of latitude-longitude
!
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
@@ -156,7 +150,7 @@ NULOUT = TLUOUT%NLU
CALL INI_RADIATIONS_ECMWF( &
PZHAT, PPABST, PTHT, PTSRAD, PLAT, PLON, TPDTCUR, TPDTEXP, &
HLW, KDLON, KFLEV, KFLUX, KRAD, KSWB_OLD, HAER, KAER, KSTATM, &
- PSTATM, PSEA, PTOWN, PBARE, POZON, PAER, PDST_WL, OSUBG_COND )
+ PSTATM, POZON, PAER, PDST_WL, OSUBG_COND )
! ECRAD specific variables
diff --git a/src/MNH/ini_surfstationn.f90 b/src/MNH/ini_surfstationn.f90
index c312cf819c8b45e50ab9d98bc5f955d4ab07c064..a14cc771c37a1852a1ff9cd1991400cfb71795d7 100644
--- a/src/MNH/ini_surfstationn.f90
+++ b/src/MNH/ini_surfstationn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -68,7 +68,7 @@ USE MODD_TYPE_STATPROF
!
USE MODE_MSG
USE MODE_STATPROF_READER, ONLY: STATPROF_CSV_READ
-USE MODE_STATPROF_TOOLS, ONLY: STATION_ADD, STATION_ALLOCATE, STATPROF_INI_INTERP, STATPROF_POSITION
+USE MODE_STATPROF_TOOLS, ONLY: STATION_ADD, STATPROF_INI_INTERP, STATPROF_POSITION
!
IMPLICIT NONE
!
@@ -106,20 +106,23 @@ allocate( tstations_time%tpdates(istore) )
NUMBSTAT_LOC = 0
IF (CFILE_STAT=="NO_INPUT_CSV") THEN
+ IF ( NNUMB_STAT > NNOCSVSTATIONMAX ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'INI_SURFSTATION_n', 'number of stations is limited to NNOCSVSTATIONMAX' )
+
! Treat namelist
INUMBSTAT = 0
IF ( NNUMB_STAT > 0 ) THEN
DO JI = 1, NNUMB_STAT
IF ( LCARTESIAN ) THEN
- TZSTATION%XX = XX_STAT(JI)
- TZSTATION%XY = XY_STAT(JI)
+ TZSTATION%XX_CUR = XX_STAT(JI)
+ TZSTATION%XY_CUR = XY_STAT(JI)
ELSE
- TZSTATION%XLAT = XLAT_STAT(JI)
- TZSTATION%XLON = XLON_STAT(JI)
+ TZSTATION%XLAT_CUR = XLAT_STAT(JI)
+ TZSTATION%XLON_CUR = XLON_STAT(JI)
CALL STATPROF_INI_INTERP( TZSTATION )
END IF
- TZSTATION%XZ = XZ_STAT(JI)
- TZSTATION%CNAME = CNAME_STAT(JI)
+ TZSTATION%XZ_CUR = XZ_STAT(JI)
+ TZSTATION%CNAME = CNAME_STAT(JI)
CALL STATPROF_POSITION( TZSTATION, GINSIDE, GPRESENT )
@@ -139,7 +142,8 @@ END IF
LSTATION = ( INUMBSTAT > 0 )
DO JI = 1, NUMBSTAT_LOC
- CALL STATION_ALLOCATE( TSTATIONS(JI), ISTORE )
+ TSTATIONS(JI)%LFIX = .TRUE.
+ CALL TSTATIONS(JI)%DATA_ARRAYS_ALLOCATE( ISTORE )
END DO
!----------------------------------------------------------------------------
diff --git a/src/MNH/init_salt.f90 b/src/MNH/init_salt.f90
index ab14998b35e89dc56ce1e4b224b74877ce471401..bb99ab50f8e781aa38ef3af7ddf7cb790406ad9b 100644
--- a/src/MNH/init_salt.f90
+++ b/src/MNH/init_salt.f90
@@ -45,7 +45,7 @@ XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115, 0.415,2.5, 7.0, 25.0/)
!Initial, standard deviation from Ova et al., 2014
XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85,1.7, 1.8, 2.1 /)
!Minimum allowed number concentration for any mode (#/m3)
-XN0MIN_SLT = (/1.e1 , 1.e1, 1.e1, 1., 1.e-4,1.e-20 , 1.e-20, 1.e-20 /)
+XN0MIN_SLT = (/1.e1 , 1.e1, 1.e1, 1., 1.e-4, 1.e-5, 1.e-6, 1.e-7 /)
ELSE IF ( NMODE_SLT == 3) THEN
diff --git a/src/MNH/interpol_station.f90 b/src/MNH/interpol_station.f90
index 997dea06c186035e97b5d789f6b54ae654469c38..e08146202c555b363255e7f8ce347f100f5c74c3 100644
--- a/src/MNH/interpol_station.f90
+++ b/src/MNH/interpol_station.f90
@@ -1,11 +1,10 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2008-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
+! Modifications:
+! P. Wautelet 19/07/2023: INTERPOL_STATION_2D: small optimisation
!-----------------------------------------------------------------
!###########################
MODULE MODI_INTERPOL_STATION
@@ -114,12 +113,11 @@ INTEGER, INTENT(IN) :: KJ ! the closest south-west grid point
REAL, INTENT(IN) :: PXHAT_GPS ! x positions of the GPS station
REAL, INTENT(IN) :: PYHAT_GPS ! y positions of the GPS station
REAL, INTENT(OUT) :: PSTAT_GPS ! value of the GPS parameter at the station
-REAL, DIMENSION(SIZE(PGPS,1), SIZE(PGPS,2),1) :: ZFIELD1
+
REAL, DIMENSION(1) :: ZFIELD2
!
!-------------------------------------------------------------------------------!
-ZFIELD1(:,:,1)=PGPS(:,:)
-CALL INTERPOL_STATION_3D(ZFIELD1,PXHAT,PYHAT,KI,KJ,PXHAT_GPS,PYHAT_GPS,ZFIELD2)
-PSTAT_GPS=ZFIELD2(1)
+CALL INTERPOL_STATION_3D( RESHAPE( PGPS,[ SIZE(PGPS,1), SIZE(PGPS,2), 1 ] ), PXHAT, PYHAT, KI, KJ, PXHAT_GPS, PYHAT_GPS, ZFIELD2 )
+PSTAT_GPS = ZFIELD2(1)
!
END SUBROUTINE INTERPOL_STATION_2D
diff --git a/src/MNH/lesn.f90 b/src/MNH/lesn.f90
index f66f89eae81a2f226ff87fd494f3982cc065fc61..11905f8b2cde45332f5bd6dc1223a9d428af632e 100644
--- a/src/MNH/lesn.f90
+++ b/src/MNH/lesn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -72,6 +72,11 @@ USE MODD_PARAM_ICE, ONLY: LDEPOSC,LSEDIC
USE MODD_PARAM_C2R2, ONLY: LDEPOC,LSEDC
USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC
!
+USE MODE_BL_DEPTH_DIAG
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+!
USE MODI_SHUMAN
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -84,11 +89,6 @@ USE MODI_THL_RT_FROM_TH_R
USE MODI_LES_RES_TR
USE MODI_BUDGET_FLAGS
USE MODI_LES_BUDGET_TEND_n
-USE MODE_BL_DEPTH_DIAG
-!
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
!
IMPLICIT NONE
!
@@ -878,7 +878,9 @@ END DO
!
IF (NLES_CURRENT_TCOUNT==1) THEN
ALLOCATE(ZZ_LES (IIU,IJU,NLES_K))
+ !ZZ_LES = vertical position of the mass points where data is computed
CALL LES_VER_INT( MZF(XZZ) ,ZZ_LES )
+ !XLES_Z = mean vertical altitude for each level (taking into account the mask)
CALL LES_MEAN_ll ( ZZ_LES, LLES_CURRENT_CART_MASK, XLES_Z )
DEALLOCATE(ZZ_LES)
CALL LES_MEAN_ll ( XZS, LLES_CURRENT_CART_MASK(:,:,1), XLES_ZS )
diff --git a/src/MNH/menu_diachro.f90 b/src/MNH/menu_diachro.f90
index f6d0ff1c90d5ec2142b8d5115a15e41faef833a6..dd243074351422f4ed4784e78c1b1384e44631e4 100644
--- a/src/MNH/menu_diachro.f90
+++ b/src/MNH/menu_diachro.f90
@@ -103,11 +103,15 @@ LPACK=.FALSE.
!
IF(HGROUP == 'END')THEN
- IF(IGROUP == 0)THEN
-! print *,' No record for the diachronic file' mettre les prints dans le fichier LISTING
- LPACK=GPACK
- RETURN
- ENDIF
+! The following block is commented because in some special cases (ie if flyers are present), the IGROUP value may be different
+! between the master process and the other ones (and may be 0)
+! In all cases, the master process has the correct values and is the only one to do the real writing (CDRIR='--')
+! Therefore, MENU_BUDGET.DIM is now always written in the LFI file. MENU_BUDGET is not written if empty (IO_Field_write does
+! not write a zero-size object)
+! IF(IGROUP == 0)THEN
+! LPACK=GPACK
+! RETURN
+! ENDIF
!Write only in LFI files
tzfile = tpdiafile
@@ -156,6 +160,7 @@ ELSE IF(HGROUP == 'READ')THEN
tzfile = tpdiafile
tzfile%cformat = 'LFI'
+ ILENG = 0
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'MENU_BUDGET.DIM', &
CSTDNAME = '', &
@@ -168,7 +173,9 @@ ELSE IF(HGROUP == 'READ')THEN
NDIMS = 0, &
LTIMEDEP = .FALSE. )
CALL IO_Field_read(tzfile,TZFIELD,ILENG,IRESPDIA)
- IF(IRESPDIA == -47)THEN
+ ! Note: keep check on IRESPDIA to ensure backward compatibility with older LFI files
+ ! MENU_BUDGET.DIM was not written if IGROUP=0 before MNH 5.6.1
+ IF( IRESPDIA == -47 .OR. ILENG == 0 ) THEN
! print *,' No record MENU_BUDGET '
LPACK=GPACK
RETURN
diff --git a/src/MNH/modd_aircraft_balloon.f90 b/src/MNH/modd_aircraft_balloon.f90
index 98bbd34ed663dd7037ed61a1122f139608284ae5..a5bf6a96a1edb53bf932b8160d49327571e885c5 100644
--- a/src/MNH/modd_aircraft_balloon.f90
+++ b/src/MNH/modd_aircraft_balloon.f90
@@ -42,7 +42,7 @@
!
!
use modd_parameters, only: NNEGUNDEF, XNEGUNDEF, XUNDEF
-USE MODD_TYPE_STATPROF, ONLY: TSTATPROFTIME
+use modd_sensor, only: tsensor, tsensortime
use modd_type_date, only: date_time
USE MODE_DATETIME, ONLY: TPREFERENCE_DATE
@@ -51,6 +51,9 @@ implicit none
save
+private :: DATA_ARRAYS_ALLOCATE_FLYER, DATA_ARRAYS_DEALLOCATE_FLYER
+
+
INTEGER, PARAMETER :: NCRASH_NO = 0 ! Not crashed
INTEGER, PARAMETER :: NCRASH_OUT_HORIZ = 1 ! Flyer is outside of horizontal domain
INTEGER, PARAMETER :: NCRASH_OUT_LOW = 2 ! Flyer crashed on ground (or sea!)
@@ -58,9 +61,14 @@ INTEGER, PARAMETER :: NCRASH_OUT_HIGH = 3 ! Flyer is too high (outside of domai
INTEGER, PARAMETER :: NFLYER_DEFAULT_RANK = 1
+INTEGER, PRIVATE, PARAMETER :: NMODEL_FIX = 1
+INTEGER, PRIVATE, PARAMETER :: NMODEL_MOB = 2
+
LOGICAL :: LFLYER = .FALSE. ! flag to use aircraft/balloons
-TYPE :: TFLYERDATA
+! ############################################
+TYPE, EXTENDS(TSENSOR), ABSTRACT :: TFLYERDATA
+! ############################################
!
!* general information
!
@@ -69,13 +77,6 @@ TYPE :: TFLYERDATA
! 'MOB' : change od model depends of the
! balloon/aircraft location
INTEGER :: NMODEL = 0 ! model number for each balloon/aircraft (may change if CMODEL='MOB')
- INTEGER :: NID = 0 ! Identification number
- CHARACTER(LEN=6) :: CTYPE = '' ! flyer type:
- ! 'RADIOS' : radiosounding balloon
- ! 'ISODEN' : iso-density balloon
- ! 'AIRCRA' : aircraft
- ! 'CVBALL' : Constant Volume balloon
- CHARACTER(LEN=10) :: CTITLE = '' ! title or name for the balloon/aircraft
TYPE(DATE_TIME) :: TLAUNCH = TPREFERENCE_DATE ! launch/takeoff date and time
LOGICAL :: LCRASH = .FALSE. ! occurence of crash
INTEGER :: NCRASH = NCRASH_NO
@@ -83,14 +84,9 @@ TYPE :: TFLYERDATA
!
!* storage monitoring
!
- LOGICAL :: LSTORE = .FALSE. ! Do we have to store data now
- TYPE(TSTATPROFTIME) :: TFLYER_TIME ! Time management for flyer
+ LOGICAL :: LSTORE = .FALSE. ! Do we have to store data now
+ TYPE(TSENSORTIME) :: TFLYER_TIME ! Time management for flyer
!
- !* current position of the balloon/aircraft
- !
- REAL :: XX_CUR = XNEGUNDEF ! current x
- REAL :: XY_CUR = XNEGUNDEF ! current y
- REAL :: XZ_CUR = XNEGUNDEF ! current z (if 'RADIOS' or 'AIRCRA' and 'ALTDEF' = T)
INTEGER :: NRANK_CUR = NFLYER_DEFAULT_RANK ! Rank of the process where the flyer is
!
!* data records
@@ -101,36 +97,31 @@ TYPE :: TFLYERDATA
REAL, DIMENSION(:), ALLOCATABLE :: XZ ! Z(n)
REAL, DIMENSION(:), ALLOCATABLE :: XLAT ! latitude (n)
REAL, DIMENSION(:), ALLOCATABLE :: XLON ! longitude(n)
- REAL, DIMENSION(:), ALLOCATABLE :: XZON ! zonal wind(n)
- REAL, DIMENSION(:), ALLOCATABLE :: XMER ! meridian wind(n)
- REAL, DIMENSION(:), ALLOCATABLE :: XW ! w(n) (air vertical speed)
- REAL, DIMENSION(:), ALLOCATABLE :: XP ! p(n)
- REAL, DIMENSION(:), ALLOCATABLE :: XTKE ! tke(n)
REAL, DIMENSION(:), ALLOCATABLE :: XTKE_DISS ! tke dissipation rate
- REAL, DIMENSION(:), ALLOCATABLE :: XTH ! th(n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XR ! r*(n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XSV ! Sv*(n)
REAL, DIMENSION(:,:), ALLOCATABLE :: XRTZ ! tot hydrometeor mixing ratio
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XRZ ! water vapour mixing ratio
REAL, DIMENSION(:,:), ALLOCATABLE :: XFFZ ! horizontal wind
- REAL, DIMENSION(:,:), ALLOCATABLE :: XIWCZ ! ice water content
- REAL, DIMENSION(:,:), ALLOCATABLE :: XLWCZ ! liquid water content
- REAL, DIMENSION(:,:), ALLOCATABLE :: XCIZ ! Ice concentration
- REAL, DIMENSION(:,:), ALLOCATABLE :: XCCZ ! Cloud concentration (LIMA)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XCRZ ! Rain concentration (LIMA)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XCRARE ! cloud radar reflectivity
- REAL, DIMENSION(:,:), ALLOCATABLE :: XCRARE_ATT ! attenuated (= more realistic) cloud radar reflectivity
REAL, DIMENSION(:,:), ALLOCATABLE :: XWZ ! vertical profile of vertical velocity
REAL, DIMENSION(:,:), ALLOCATABLE :: XZZ ! vertical profile of mass point altitude (above sea)
REAL, DIMENSION(:), ALLOCATABLE :: XZS ! zs(n)
- REAL, DIMENSION(:), ALLOCATABLE :: XTSRAD ! Ts(n)
!
REAL, DIMENSION(:), ALLOCATABLE :: XTHW_FLUX ! thw_flux(n)
REAL, DIMENSION(:), ALLOCATABLE :: XRCW_FLUX ! rcw_flux(n)
REAL, DIMENSION(:,:), ALLOCATABLE :: XSVW_FLUX ! psw_flux(n)
+
+ CONTAINS
+ ! Remark: DATA_ARRAYS_(DE)ALLOCATE_FLYER do not point to DATA_ARRAYS_(DE)ALLOCATE to allow other dummy arguments if needed
+ PROCEDURE :: BUFFER_PACK => BUFFER_PACK_FLYER
+ PROCEDURE :: BUFFER_UNPACK => BUFFER_UNPACK_FLYER
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_ALLOCATE_FLYER
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_DEALLOCATE_FLYER
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_PACK_FLYER
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_UNPACK_FLYER
END TYPE TFLYERDATA
+! ##########################################
TYPE, EXTENDS( TFLYERDATA ) :: TAIRCRAFTDATA
+! ##########################################
LOGICAL :: LTOOKOFF = .FALSE. ! Set to true once the aircraft takes off
!
!* aircraft flight definition
@@ -150,9 +141,21 @@ TYPE, EXTENDS( TFLYERDATA ) :: TAIRCRAFTDATA
!
LOGICAL :: LALTDEF = .FALSE. ! TRUE == altitude given in pressure
REAL :: XP_CUR = XNEGUNDEF ! current p (only if LALTDEF = F)
+
+ CONTAINS
+ PROCEDURE :: DATA_ARRAYS_ALLOCATE => DATA_ARRAYS_ALLOCATE_AIRCRAFT
+ PROCEDURE :: DATA_ARRAYS_DEALLOCATE => DATA_ARRAYS_DEALLOCATE_AIRCRAFT
+ PROCEDURE :: BUFFER_PACK => BUFFER_PACK_AIRCRAFT
+ PROCEDURE :: BUFFER_UNPACK => BUFFER_UNPACK_AIRCRAFT
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_ALLOCATE_AIRCRAFT
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_DEALLOCATE_AIRCRAFT
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_PACK_AIRCRAFT
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_UNPACK_AIRCRAFT
END TYPE TAIRCRAFTDATA
+! #########################################
TYPE, EXTENDS( TFLYERDATA ) :: TBALLOONDATA
+! #########################################
LOGICAL :: LPOSITION_INIT = .FALSE. ! True if initial position has been computed
!
!* balloon dynamical characteristics
@@ -173,6 +176,15 @@ TYPE, EXTENDS( TFLYERDATA ) :: TBALLOONDATA
TYPE(DATE_TIME) :: TPOS_CUR = TPREFERENCE_DATE ! Time corresponding to the current position (XX_CUR, XY_CUR...)
+ CONTAINS
+ PROCEDURE :: DATA_ARRAYS_ALLOCATE => DATA_ARRAYS_ALLOCATE_BALLOON
+ PROCEDURE :: DATA_ARRAYS_DEALLOCATE => DATA_ARRAYS_DEALLOCATE_BALLOON
+ PROCEDURE :: BUFFER_PACK => BUFFER_PACK_BALLOON
+ PROCEDURE :: BUFFER_UNPACK => BUFFER_UNPACK_BALLOON
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_ALLOCATE_BALLOON
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_DEALLOCATE_BALLOON
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_PACK_BALLOON
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_UNPACK_BALLOON
END TYPE TBALLOONDATA
INTEGER :: NAIRCRAFTS = 0 ! Total number of aircrafts
@@ -196,4 +208,629 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: NRANKNXT_AIRCRAFT ! Array to store the ran
INTEGER, DIMENSION(:), ALLOCATABLE :: NRANKCUR_BALLOON ! Array to store the rank of the process where a given ballon is present
INTEGER, DIMENSION(:), ALLOCATABLE :: NRANKNXT_BALLOON ! Array to store the rank of the process where a given ballon is going
+
+CONTAINS
+! #######################################################
+SUBROUTINE DATA_ARRAYS_ALLOCATE_FLYER( TPSENSOR, KSTORE )
+! #######################################################
+
+ USE MODD_CONF_n, ONLY: NRR
+ USE MODD_DIM_n, ONLY: NKMAX
+ USE MODD_DYN, ONLY: XSEGLEN
+ USE MODD_DYN_n, ONLY: DYN_MODEL
+ USE MODD_NSV, ONLY: NSV
+ USE MODD_PARAMETERS, ONLY: JPVEXT, NNEGUNDEF, XUNDEF
+ USE MODD_PARAM_n, ONLY: CCLOUD
+ USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
+
+ USE MODE_MSG
+
+
+ CLASS(TFLYERDATA), INTENT(INOUT) :: TPSENSOR
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE
+
+ INTEGER :: IKU ! number of vertical levels
+ INTEGER :: ISTORE ! number of storage instants
+ INTEGER :: IVARSIZE ! allocated size per store
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_allocate_flyer', 'flyer: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ IKU = NKMAX + 2 * JPVEXT
+ IVARSIZE = 0
+
+ IF ( PRESENT( KSTORE ) ) THEN
+ ISTORE = KSTORE
+ ELSE
+ ISTORE = NINT ( ( XSEGLEN - DYN_MODEL(1)%XTSTEP ) / TPSENSOR%TFLYER_TIME%XTSTEP ) + 1
+ END IF
+
+ CALL TPSENSOR%Data_arrays_allocate_sensor( .TRUE., KLEVELS = 1, KSTORE = ISTORE )
+
+ ALLOCATE( TPSENSOR%TFLYER_TIME%TPDATES(ISTORE) )
+ ALLOCATE( TPSENSOR%NMODELHIST(ISTORE) )
+ ALLOCATE( TPSENSOR%XX (ISTORE) )
+ ALLOCATE( TPSENSOR%XY (ISTORE) )
+ ALLOCATE( TPSENSOR%XZ (ISTORE) )
+ ALLOCATE( TPSENSOR%XLON (ISTORE) )
+ ALLOCATE( TPSENSOR%XLAT (ISTORE) )
+ IVARSIZE = IVARSIZE + 7
+
+ ALLOCATE( TPSENSOR%XRTZ (IKU, ISTORE) )
+ ALLOCATE( TPSENSOR%XRZ (IKU, ISTORE, NRR) )
+ ALLOCATE( TPSENSOR%XFFZ (IKU, ISTORE) )
+ IVARSIZE = IVARSIZE + IKU * ( 2 + NRR )
+
+ ALLOCATE( TPSENSOR%XWZ (IKU, ISTORE) )
+ ALLOCATE( TPSENSOR%XZZ (IKU, ISTORE) )
+ ALLOCATE( TPSENSOR%XTKE_DISS(ISTORE) )
+ ALLOCATE( TPSENSOR%XZS (ISTORE) )
+ IVARSIZE = IVARSIZE + IKU * 2 + 2
+
+ ALLOCATE( TPSENSOR%XTHW_FLUX(ISTORE) )
+ ALLOCATE( TPSENSOR%XRCW_FLUX(ISTORE) )
+ ALLOCATE( TPSENSOR%XSVW_FLUX(ISTORE, NSV) )
+ IVARSIZE = IVARSIZE + 2 + NSV
+
+ TPSENSOR%NBUFFER_FIXSIZE = TPSENSOR%NBUFFER_FIXSIZE + 9 + 1
+ TPSENSOR%NBUFFER_VARSIZE = TPSENSOR%NBUFFER_VARSIZE + IVARSIZE
+
+ TPSENSOR%NMODELHIST = NNEGUNDEF
+ TPSENSOR%XX = XUNDEF
+ TPSENSOR%XY = XUNDEF
+ TPSENSOR%XZ = XUNDEF
+ TPSENSOR%XLON = XUNDEF
+ TPSENSOR%XLAT = XUNDEF
+ TPSENSOR%XRTZ = XUNDEF
+ TPSENSOR%XRZ = XUNDEF
+ TPSENSOR%XFFZ = XUNDEF
+ TPSENSOR%XWZ = XUNDEF
+ TPSENSOR%XZZ = XUNDEF
+ TPSENSOR%XTKE_DISS = XUNDEF
+ TPSENSOR%XZS = XUNDEF
+
+ TPSENSOR%XTHW_FLUX = XUNDEF
+ TPSENSOR%XRCW_FLUX = XUNDEF
+ TPSENSOR%XSVW_FLUX = XUNDEF
+
+END SUBROUTINE DATA_ARRAYS_ALLOCATE_FLYER
+
+! #################################################
+SUBROUTINE DATA_ARRAYS_DEALLOCATE_FLYER( TPSENSOR )
+! #################################################
+
+ USE MODE_MSG
+
+ CLASS(TFLYERDATA), INTENT(INOUT) :: TPSENSOR
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_deallocate_flyer', 'flyer: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ CALL TPSENSOR%Data_arrays_deallocate_sensor()
+
+ DEALLOCATE( TPSENSOR%TFLYER_TIME%TPDATES )
+ DEALLOCATE( TPSENSOR%NMODELHIST )
+ DEALLOCATE( TPSENSOR%XX )
+ DEALLOCATE( TPSENSOR%XY )
+ DEALLOCATE( TPSENSOR%XZ )
+ DEALLOCATE( TPSENSOR%XLON )
+ DEALLOCATE( TPSENSOR%XLAT )
+ DEALLOCATE( TPSENSOR%XRTZ )
+ DEALLOCATE( TPSENSOR%XRZ )
+ DEALLOCATE( TPSENSOR%XFFZ )
+ DEALLOCATE( TPSENSOR%XWZ )
+ DEALLOCATE( TPSENSOR%XZZ )
+ DEALLOCATE( TPSENSOR%XTKE_DISS )
+ DEALLOCATE( TPSENSOR%XZS )
+
+ DEALLOCATE( TPSENSOR%XTHW_FLUX )
+ DEALLOCATE( TPSENSOR%XRCW_FLUX )
+ DEALLOCATE( TPSENSOR%XSVW_FLUX )
+
+ SELECT TYPE( TPSENSOR )
+ CLASS IS ( TAIRCRAFTDATA )
+ DEALLOCATE( TPSENSOR%XPOSLAT )
+ DEALLOCATE( TPSENSOR%XPOSLON )
+ DEALLOCATE( TPSENSOR%XPOSX )
+ DEALLOCATE( TPSENSOR%XPOSY )
+ IF ( TPSENSOR%LALTDEF ) THEN
+ DEALLOCATE( TPSENSOR%XPOSP )
+ ELSE
+ DEALLOCATE( TPSENSOR%XPOSZ )
+ END IF
+ DEALLOCATE( TPSENSOR%XPOSTIME )
+ END SELECT
+
+END SUBROUTINE DATA_ARRAYS_DEALLOCATE_FLYER
+
+
+! ##########################################################
+SUBROUTINE DATA_ARRAYS_ALLOCATE_AIRCRAFT( TPSENSOR, KSTORE )
+! ##########################################################
+
+ USE MODE_MSG
+
+ CLASS(TAIRCRAFTDATA), INTENT(INOUT) :: TPSENSOR
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_allocate_aircraft', 'aircraft: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ CALL DATA_ARRAYS_ALLOCATE_FLYER( TPSENSOR, KSTORE )
+
+ TPSENSOR%NBUFFER_FIXSIZE = TPSENSOR%NBUFFER_FIXSIZE + 6 + TPSENSOR%NPOS * 6
+
+END SUBROUTINE DATA_ARRAYS_ALLOCATE_AIRCRAFT
+
+
+! ####################################################
+SUBROUTINE DATA_ARRAYS_DEALLOCATE_AIRCRAFT( TPSENSOR )
+! ####################################################
+
+ USE MODE_MSG
+
+ CLASS(TAIRCRAFTDATA), INTENT(INOUT) :: TPSENSOR
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_deallocate_aircraft', 'aircraft: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ CALL DATA_ARRAYS_DEALLOCATE_FLYER( TPSENSOR )
+
+END SUBROUTINE DATA_ARRAYS_DEALLOCATE_AIRCRAFT
+
+
+! #########################################################
+SUBROUTINE DATA_ARRAYS_ALLOCATE_BALLOON( TPSENSOR, KSTORE )
+! #########################################################
+
+ USE MODE_MSG
+
+ CLASS(TBALLOONDATA), INTENT(INOUT) :: TPSENSOR
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_allocate_balloon', 'balloon: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ CALL DATA_ARRAYS_ALLOCATE_FLYER( TPSENSOR, KSTORE )
+
+ TPSENSOR%NBUFFER_FIXSIZE = TPSENSOR%NBUFFER_FIXSIZE + 15
+
+END SUBROUTINE DATA_ARRAYS_ALLOCATE_BALLOON
+
+
+! ###################################################
+SUBROUTINE DATA_ARRAYS_DEALLOCATE_BALLOON( TPSENSOR )
+! ###################################################
+
+ USE MODE_MSG
+
+ CLASS(TBALLOONDATA), INTENT(INOUT) :: TPSENSOR
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_deallocate_balloon', 'balloon: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ CALL DATA_ARRAYS_DEALLOCATE_FLYER( TPSENSOR )
+
+END SUBROUTINE DATA_ARRAYS_DEALLOCATE_BALLOON
+
+
+! #####################################################################
+SUBROUTINE BUFFER_PACK_FLYER( TPSENSOR, PBUFFER, KPOS, KSTORE_CURRENT )
+! #####################################################################
+
+ USE MODD_CONF_n, ONLY: NRR
+ USE MODD_DIM_n, ONLY: NKMAX
+ USE MODD_NSV, ONLY: NSV
+ USE MODD_PARAMETERS, ONLY: JPVEXT
+ USE MODD_PARAM_n, ONLY: CCLOUD
+
+ USE MODE_DATETIME
+ USE MODE_MSG
+
+ CLASS(TFLYERDATA), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(INOUT) :: PBUFFER ! Buffer to pack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_CURRENT ! Current number of stored instants
+
+ INTEGER :: IKU ! number of vertical levels
+ INTEGER :: ISTORES
+ INTEGER :: JI
+
+ IKU = NKMAX + 2 * JPVEXT
+
+ IF ( PRESENT( KSTORE_CURRENT ) ) THEN
+ ISTORES = KSTORE_CURRENT
+ IF ( ISTORES > TPSENSOR%NSTORE_MAX ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Buffer_pack_flyer', 'flyer: ' // TRIM(TPSENSOR%CNAME) &
+ // ': KSTORE_CURRENT>NSTORE_MAX', OLOCAL = .TRUE. )
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+ ELSE
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+
+ CALL TPSENSOR%BUFFER_PACK_SENSOR( PBUFFER, KPOS, ISTORES )
+
+ IF ( TPSENSOR%CMODEL == 'FIX' ) THEN
+ PBUFFER(KPOS) = NMODEL_FIX
+ ELSE
+ PBUFFER(KPOS) = NMODEL_MOB
+ END IF
+ KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%NMODEL ; KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%TLAUNCH - TPREFERENCE_DATE ; KPOS = KPOS + 1
+
+ IF ( TPSENSOR%LCRASH ) THEN
+ PBUFFER(KPOS) = 1.d0
+ ELSE
+ PBUFFER(KPOS) = 0.d0
+ END IF
+ KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%NCRASH ; KPOS = KPOS + 1
+
+ IF ( TPSENSOR%LFLY ) THEN
+ PBUFFER(KPOS) = 1.d0
+ ELSE
+ PBUFFER(KPOS) = 0.d0
+ END IF
+ KPOS = KPOS + 1
+
+ IF ( TPSENSOR%LSTORE ) THEN
+ PBUFFER(KPOS) = 1.d0
+ ELSE
+ PBUFFER(KPOS) = 0.d0
+ END IF
+ KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%TFLYER_TIME%N_CUR ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%TFLYER_TIME%XTSTEP ; KPOS = KPOS + 1
+ DO JI = 1, ISTORES
+ PBUFFER(KPOS) = TPSENSOR%TFLYER_TIME%TPDATES(JI) - TPREFERENCE_DATE ; KPOS = KPOS + 1
+ END DO
+
+ PBUFFER(KPOS) = TPSENSOR%NRANK_CUR; KPOS = KPOS + 1
+
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%NMODELHIST(1:ISTORES); KPOS = KPOS + ISTORES
+
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XX (1:ISTORES) ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XY (1:ISTORES) ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XZ (1:ISTORES) ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XLAT (1:ISTORES) ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XLON (1:ISTORES) ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XTKE_DISS(1:ISTORES) ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XRTZ(1:IKU,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+
+ PBUFFER(KPOS:KPOS+IKU*ISTORES*NRR-1) = RESHAPE( TPSENSOR%XRZ(1:IKU,1:ISTORES,1:NRR), [IKU*ISTORES*NRR] )
+ KPOS = KPOS + IKU * ISTORES * NRR
+
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XFFZ (1:IKU,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XWZ(1:IKU,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XZZ(1:IKU,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XZS(1:ISTORES) ; KPOS = KPOS + ISTORES
+
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XTHW_FLUX(1:ISTORES) ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XRCW_FLUX(1:ISTORES) ; KPOS = KPOS + ISTORES
+
+ PBUFFER(KPOS:KPOS+ISTORES*NSV-1) = RESHAPE( TPSENSOR%XSVW_FLUX(1:ISTORES,1:NSV), [ISTORES*NSV] )
+ KPOS = KPOS + ISTORES * NSV
+
+END SUBROUTINE BUFFER_PACK_FLYER
+
+! ########################################################################
+SUBROUTINE BUFFER_PACK_AIRCRAFT( TPSENSOR, PBUFFER, KPOS, KSTORE_CURRENT )
+! ########################################################################
+
+ USE MODE_DATETIME
+ USE MODE_MSG
+
+ CLASS(TAIRCRAFTDATA), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(INOUT) :: PBUFFER ! Buffer to pack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_CURRENT ! Current number of stored instants
+
+ INTEGER :: IPOSAIR
+ INTEGER :: ISTORES
+
+ IF ( PRESENT( KSTORE_CURRENT ) ) THEN
+ ISTORES = KSTORE_CURRENT
+ IF ( ISTORES > TPSENSOR%NSTORE_MAX ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Buffer_pack_flyer', 'flyer: ' // TRIM(TPSENSOR%CNAME) &
+ // ': KSTORE_CURRENT>NSTORE_MAX', OLOCAL = .TRUE. )
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+ ELSE
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+
+ CALL TPSENSOR%BUFFER_PACK_FLYER( PBUFFER, KPOS, ISTORES )
+
+ IF ( TPSENSOR%LTOOKOFF ) THEN
+ PBUFFER(KPOS) = 1.d0
+ ELSE
+ PBUFFER(KPOS) = 0.d0
+ END IF
+ KPOS = KPOS + 1
+
+ IF ( TPSENSOR%LALTDEF ) THEN
+ PBUFFER(KPOS) = 1.d0
+ ELSE
+ PBUFFER(KPOS) = 0.d0
+ END IF
+ KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%NPOS ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NPOSCUR ; KPOS = KPOS + 1
+
+ IPOSAIR = TPSENSOR%NPOS
+
+ PBUFFER(KPOS:KPOS+IPOSAIR-1) = TPSENSOR%XPOSLAT(1:IPOSAIR) ; KPOS = KPOS + IPOSAIR
+ PBUFFER(KPOS:KPOS+IPOSAIR-1) = TPSENSOR%XPOSLON(1:IPOSAIR) ; KPOS = KPOS + IPOSAIR
+ PBUFFER(KPOS:KPOS+IPOSAIR-1) = TPSENSOR%XPOSX (1:IPOSAIR) ; KPOS = KPOS + IPOSAIR
+ PBUFFER(KPOS:KPOS+IPOSAIR-1) = TPSENSOR%XPOSY (1:IPOSAIR) ; KPOS = KPOS + IPOSAIR
+ IF ( TPSENSOR%LALTDEF ) THEN
+ PBUFFER(KPOS:KPOS+IPOSAIR-1) = TPSENSOR%XPOSP(1:IPOSAIR) ; KPOS = KPOS + IPOSAIR
+ ELSE
+ PBUFFER(KPOS:KPOS+IPOSAIR-1) = TPSENSOR%XPOSZ(1:IPOSAIR) ; KPOS = KPOS + IPOSAIR
+ ENDIF
+ PBUFFER(KPOS:KPOS+IPOSAIR-1) = TPSENSOR%XPOSTIME(1:IPOSAIR) ; KPOS = KPOS + IPOSAIR
+
+ PBUFFER(KPOS) = TPSENSOR%TLAND - TPREFERENCE_DATE ; KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%XP_CUR ; KPOS = KPOS + 1
+
+END SUBROUTINE BUFFER_PACK_AIRCRAFT
+
+
+! #######################################################################
+SUBROUTINE BUFFER_PACK_BALLOON( TPSENSOR, PBUFFER, KPOS, KSTORE_CURRENT )
+! #######################################################################
+
+ USE MODE_DATETIME
+ USE MODE_MSG
+
+ CLASS(TBALLOONDATA), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(INOUT) :: PBUFFER ! Buffer to pack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_CURRENT ! Current number of stored instants
+
+ INTEGER :: ISTORES
+
+ IF ( PRESENT( KSTORE_CURRENT ) ) THEN
+ ISTORES = KSTORE_CURRENT
+ IF ( ISTORES > TPSENSOR%NSTORE_MAX ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Buffer_pack_flyer', 'flyer: ' // TRIM(TPSENSOR%CNAME) &
+ // ': KSTORE_CURRENT>NSTORE_MAX', OLOCAL = .TRUE. )
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+ ELSE
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+
+ CALL TPSENSOR%BUFFER_PACK_FLYER( PBUFFER, KPOS, ISTORES )
+
+ IF ( TPSENSOR%LPOSITION_INIT ) THEN
+ PBUFFER(KPOS) = 1.d0
+ ELSE
+ PBUFFER(KPOS) = 0.d0
+ END IF
+ KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%XLATLAUNCH ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XLONLAUNCH ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XXLAUNCH ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XYLAUNCH ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XALTLAUNCH ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XWASCENT ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XRHO ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XPRES ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XDIAMETER ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XAERODRAG ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XINDDRAG ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XVOLUME ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XMASS ; KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%TPOS_CUR - TPREFERENCE_DATE; KPOS = KPOS + 1
+
+END SUBROUTINE BUFFER_PACK_BALLOON
+
+
+! ###############################################################
+SUBROUTINE BUFFER_UNPACK_FLYER( TPSENSOR, PBUFFER, KPOS, KSTORE )
+! ###############################################################
+
+ USE MODD_CONF_n, ONLY: NRR
+ USE MODD_DIM_n, ONLY: NKMAX
+ USE MODD_NSV, ONLY: NSV
+ USE MODD_PARAMETERS, ONLY: JPVEXT
+ USE MODD_PARAM_n, ONLY: CCLOUD
+
+ USE MODE_DATETIME
+ USE MODE_MSG
+
+ CLASS(TFLYERDATA), INTENT(INOUT) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(IN) :: PBUFFER ! Buffer to unpack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, INTENT(IN) :: KSTORE ! Current number of stored instants
+
+ INTEGER :: IKU ! number of vertical levels
+ INTEGER :: JI
+
+ IKU = NKMAX + 2 * JPVEXT
+
+ CALL TPSENSOR%BUFFER_UNPACK_SENSOR( PBUFFER, KPOS, KSTORE )
+
+ IF ( NINT( PBUFFER(KPOS) ) == NMODEL_FIX ) THEN
+ TPSENSOR%CMODEL = 'FIX'
+ ELSE
+ TPSENSOR%CMODEL = 'MOB'
+ END IF
+ KPOS = KPOS + 1
+
+ TPSENSOR%NMODEL = NINT( PBUFFER(KPOS) ); KPOS = KPOS + 1
+
+ TPSENSOR%TLAUNCH = TPREFERENCE_DATE + PBUFFER(KPOS); KPOS = KPOS + 1
+
+ IF ( NINT( PBUFFER(KPOS) ) == 0 ) THEN
+ TPSENSOR%LCRASH = .FALSE.
+ ELSE
+ TPSENSOR%LCRASH = .TRUE.
+ END IF
+ KPOS = KPOS + 1
+
+ TPSENSOR%NCRASH = NINT( PBUFFER(KPOS) ); KPOS = KPOS + 1
+
+ IF ( NINT( PBUFFER(KPOS) ) == 0 ) THEN
+ TPSENSOR%LFLY = .FALSE.
+ ELSE
+ TPSENSOR%LFLY = .TRUE.
+ END IF
+ KPOS = KPOS + 1
+
+ IF ( NINT( PBUFFER(KPOS) ) == 0 ) THEN
+ TPSENSOR%LSTORE = .FALSE.
+ ELSE
+ TPSENSOR%LSTORE = .TRUE.
+ END IF
+ KPOS = KPOS + 1
+
+ TPSENSOR%TFLYER_TIME%N_CUR = NINT( PBUFFER(KPOS) ); KPOS = KPOS + 1
+ TPSENSOR%TFLYER_TIME%XTSTEP = PBUFFER(KPOS); KPOS = KPOS + 1
+
+ DO JI = 1, KSTORE
+ TPSENSOR%TFLYER_TIME%TPDATES(JI) = TPREFERENCE_DATE + PBUFFER(KPOS); KPOS = KPOS + 1
+ END DO
+
+ TPSENSOR%NRANK_CUR = NINT( PBUFFER(KPOS) ); KPOS = KPOS + 1
+
+ TPSENSOR%NMODELHIST(1:KSTORE) = NINT( PBUFFER(KPOS:KPOS+KSTORE-1) ) ; KPOS = KPOS + KSTORE
+
+ TPSENSOR%XX(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XY(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XZ(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XLAT(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XLON(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XTKE_DISS(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XRTZ(1:IKU,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+KSTORE*IKU-1), [IKU,KSTORE] ) ; KPOS = KPOS + KSTORE * IKU
+
+ TPSENSOR%XRZ(1:IKU,1:KSTORE,1:NRR) = RESHAPE( PBUFFER(KPOS:KPOS+(KSTORE*IKU*NRR)-1), [IKU,KSTORE,NRR] )
+ KPOS = KPOS + KSTORE * IKU * NRR
+
+ TPSENSOR%XFFZ (1:IKU,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+KSTORE*IKU-1), [IKU,KSTORE] ) ; KPOS = KPOS + KSTORE * IKU
+
+ TPSENSOR%XWZ(1:IKU,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+KSTORE*IKU-1), [IKU,KSTORE] ) ; KPOS = KPOS + KSTORE * IKU
+ TPSENSOR%XZZ(1:IKU,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+KSTORE*IKU-1), [IKU,KSTORE] ) ; KPOS = KPOS + KSTORE * IKU
+
+ TPSENSOR%XZS(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+
+ TPSENSOR%XTHW_FLUX(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XRCW_FLUX(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+
+ TPSENSOR%XSVW_FLUX(1:KSTORE,1:NSV) = RESHAPE( PBUFFER(KPOS:KPOS+KSTORE*NSV-1), [KSTORE,NSV] )
+ KPOS = KPOS + KSTORE * NSV
+
+END SUBROUTINE BUFFER_UNPACK_FLYER
+
+! ##################################################################
+SUBROUTINE BUFFER_UNPACK_AIRCRAFT( TPSENSOR, PBUFFER, KPOS, KSTORE )
+! ##################################################################
+
+ USE MODE_DATETIME
+ USE MODE_MSG
+
+ CLASS(TAIRCRAFTDATA), INTENT(INOUT) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(IN) :: PBUFFER ! Buffer to unpack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, INTENT(IN) :: KSTORE ! Current number of stored instants
+
+ INTEGER :: IPOSAIR
+
+ CALL TPSENSOR%BUFFER_UNPACK_FLYER( PBUFFER, KPOS, KSTORE )
+
+ IF ( NINT( PBUFFER(KPOS) ) == 0 ) THEN
+ TPSENSOR%LTOOKOFF = .FALSE.
+ ELSE
+ TPSENSOR%LTOOKOFF = .TRUE.
+ END IF
+ KPOS = KPOS + 1
+
+ IF ( NINT( PBUFFER(KPOS) ) == 0 ) THEN
+ TPSENSOR%LALTDEF = .FALSE.
+ ELSE
+ TPSENSOR%LALTDEF = .TRUE.
+ END IF
+ KPOS = KPOS + 1
+
+ TPSENSOR%NPOS = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NPOSCUR = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+
+ IPOSAIR = TPSENSOR%NPOS
+
+ ALLOCATE( TPSENSOR%XPOSLAT(IPOSAIR) )
+ ALLOCATE( TPSENSOR%XPOSLON(IPOSAIR) )
+ ALLOCATE( TPSENSOR%XPOSX(IPOSAIR) )
+ ALLOCATE( TPSENSOR%XPOSY(IPOSAIR) )
+ IF ( TPSENSOR%LALTDEF ) THEN
+ ALLOCATE( TPSENSOR%XPOSP(IPOSAIR) )
+ ELSE
+ ALLOCATE( TPSENSOR%XPOSZ(IPOSAIR) )
+ END IF
+ ALLOCATE( TPSENSOR%XPOSTIME(IPOSAIR) )
+
+ TPSENSOR%XPOSLAT (1:IPOSAIR) = PBUFFER(KPOS:KPOS+IPOSAIR-1) ; KPOS = KPOS + IPOSAIR
+ TPSENSOR%XPOSLON (1:IPOSAIR) = PBUFFER(KPOS:KPOS+IPOSAIR-1) ; KPOS = KPOS + IPOSAIR
+ TPSENSOR%XPOSX (1:IPOSAIR) = PBUFFER(KPOS:KPOS+IPOSAIR-1) ; KPOS = KPOS + IPOSAIR
+ TPSENSOR%XPOSY (1:IPOSAIR) = PBUFFER(KPOS:KPOS+IPOSAIR-1) ; KPOS = KPOS + IPOSAIR
+ IF ( TPSENSOR%LALTDEF ) THEN
+ TPSENSOR%XPOSP (1:IPOSAIR) = PBUFFER(KPOS:KPOS+IPOSAIR-1) ; KPOS = KPOS + IPOSAIR
+ ELSE
+ TPSENSOR%XPOSZ (1:IPOSAIR) = PBUFFER(KPOS:KPOS+IPOSAIR-1) ; KPOS = KPOS + IPOSAIR
+ END IF
+ TPSENSOR%XPOSTIME(1:IPOSAIR) = PBUFFER(KPOS:KPOS+IPOSAIR-1) ; KPOS = KPOS + IPOSAIR
+
+ TPSENSOR%TLAND = TPREFERENCE_DATE + PBUFFER(KPOS) ; KPOS = KPOS + 1
+
+ TPSENSOR%XP_CUR = PBUFFER(KPOS) ; KPOS = KPOS + 1
+
+END SUBROUTINE BUFFER_UNPACK_AIRCRAFT
+
+
+! #################################################################
+SUBROUTINE BUFFER_UNPACK_BALLOON( TPSENSOR, PBUFFER, KPOS, KSTORE )
+! #################################################################
+
+ USE MODE_DATETIME
+ USE MODE_MSG
+
+ CLASS(TBALLOONDATA), INTENT(INOUT) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(IN) :: PBUFFER ! Buffer to unpack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, INTENT(IN) :: KSTORE ! Current number of stored instants
+
+ CALL TPSENSOR%BUFFER_UNPACK_FLYER( PBUFFER, KPOS, KSTORE )
+
+ IF ( NINT( PBUFFER(KPOS) ) == 0 ) THEN
+ TPSENSOR%LPOSITION_INIT = .FALSE.
+ ELSE
+ TPSENSOR%LPOSITION_INIT = .TRUE.
+ END IF
+ KPOS = KPOS + 1
+
+ TPSENSOR%XLATLAUNCH = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XLONLAUNCH = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XXLAUNCH = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XYLAUNCH = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XALTLAUNCH = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XWASCENT = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XRHO = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XPRES = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XDIAMETER = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XAERODRAG = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XINDDRAG = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XVOLUME = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XMASS = PBUFFER(KPOS) ; KPOS = KPOS + 1
+
+ TPSENSOR%TPOS_CUR = TPREFERENCE_DATE + PBUFFER(KPOS) ; KPOS = KPOS + 1
+
+END SUBROUTINE BUFFER_UNPACK_BALLOON
+
+
END MODULE MODD_AIRCRAFT_BALLOON
diff --git a/src/MNH/modd_allprofilern.f90 b/src/MNH/modd_allprofilern.f90
index 176c5560f14d458f5e7f09bf68aec00432563029..cb9c527440c0a70e7949058d339a5b1c320ca6ce 100644
--- a/src/MNH/modd_allprofilern.f90
+++ b/src/MNH/modd_allprofilern.f90
@@ -37,7 +37,7 @@
! ------------
!
!
-USE MODD_PARAMETERS, ONLY: JPMODELMAX, NFILENAMELGTMAX, NSTATPROFNAMELGTMAX
+USE MODD_PARAMETERS, ONLY: JPMODELMAX, NFILENAMELGTMAX, NSENSORNAMELGTMAX
IMPLICIT NONE
@@ -48,14 +48,17 @@ PUBLIC :: CNAME_PROF, CFILE_PROF, LDIAG_SURFRAD_PROF
PUBLIC :: ALLPROFILER_GOTO_MODEL
+
+INTEGER, PUBLIC, PARAMETER :: NNOCSVPROFILERMAX = 100
+
TYPE ALLPROFILER_t
!
!-------------------------------------------------------------------------------------------
!
!
INTEGER :: NNUMB_PROF !Number of stations as defined in namelist
- REAL, DIMENSION(100) :: XX_PROF, XY_PROF, XZ_PROF, XLAT_PROF, XLON_PROF
- CHARACTER(LEN=NSTATPROFNAMELGTMAX), DIMENSION(100) :: CNAME_PROF
+ REAL, DIMENSION(NNOCSVPROFILERMAX) :: XX_PROF, XY_PROF, XZ_PROF, XLAT_PROF, XLON_PROF
+ CHARACTER(LEN=NSENSORNAMELGTMAX), DIMENSION(NNOCSVPROFILERMAX) :: CNAME_PROF
CHARACTER(LEN=NFILENAMELGTMAX) :: CFILE_PROF
REAL :: XSTEP_PROF
LOGICAL :: LDIAG_SURFRAD_PROF
@@ -72,7 +75,7 @@ REAL, DIMENSION(:), POINTER :: XY_PROF=>NULL()
REAL, DIMENSION(:), POINTER :: XLAT_PROF=>NULL()
REAL, DIMENSION(:), POINTER :: XLON_PROF=>NULL()
REAL, DIMENSION(:), POINTER :: XZ_PROF=>NULL()
-CHARACTER (LEN=NSTATPROFNAMELGTMAX),DIMENSION(:), POINTER :: CNAME_PROF=>NULL()
+CHARACTER (LEN=NSENSORNAMELGTMAX),DIMENSION(:), POINTER :: CNAME_PROF=>NULL()
CHARACTER (LEN=NFILENAMELGTMAX),POINTER :: CFILE_PROF=>NULL()
LOGICAL, POINTER :: LDIAG_SURFRAD_PROF => NULL()
CONTAINS
diff --git a/src/MNH/modd_allstationn.f90 b/src/MNH/modd_allstationn.f90
index 463e5a811a2d7361b4bf0d07d51b9ce1a4e71515..f36f760b251653dafeb767f994a759866cd7b338 100644
--- a/src/MNH/modd_allstationn.f90
+++ b/src/MNH/modd_allstationn.f90
@@ -36,7 +36,7 @@
! ------------
!
!
-USE MODD_PARAMETERS, ONLY: JPMODELMAX, NFILENAMELGTMAX, NSTATPROFNAMELGTMAX
+USE MODD_PARAMETERS, ONLY: JPMODELMAX, NFILENAMELGTMAX, NSENSORNAMELGTMAX
IMPLICIT NONE
@@ -47,14 +47,17 @@ PUBLIC :: CNAME_STAT, CFILE_STAT, LDIAG_SURFRAD_STAT
PUBLIC :: ALLSTATION_GOTO_MODEL
+
+INTEGER, PUBLIC, PARAMETER :: NNOCSVSTATIONMAX = 100
+
TYPE ALLSTATION_t
!
!-------------------------------------------------------------------------------------------
!
!
INTEGER :: NNUMB_STAT !Number of stations as defined in namelist
- REAL, DIMENSION(100) :: XX_STAT, XY_STAT, XZ_STAT, XLAT_STAT, XLON_STAT
- CHARACTER(LEN=NSTATPROFNAMELGTMAX), DIMENSION(100) :: CNAME_STAT
+ REAL, DIMENSION(NNOCSVSTATIONMAX) :: XX_STAT, XY_STAT, XZ_STAT, XLAT_STAT, XLON_STAT
+ CHARACTER(LEN=NSENSORNAMELGTMAX), DIMENSION(NNOCSVSTATIONMAX) :: CNAME_STAT
CHARACTER(LEN=NFILENAMELGTMAX) :: CFILE_STAT
REAL :: XSTEP_STAT
LOGICAL :: LDIAG_SURFRAD_STAT
@@ -71,7 +74,7 @@ REAL, DIMENSION(:), POINTER :: XY_STAT=>NULL()
REAL, DIMENSION(:), POINTER :: XLAT_STAT=>NULL()
REAL, DIMENSION(:), POINTER :: XLON_STAT=>NULL()
REAL, DIMENSION(:), POINTER :: XZ_STAT=>NULL()
-CHARACTER (LEN=NSTATPROFNAMELGTMAX),DIMENSION(:), POINTER :: CNAME_STAT=>NULL()
+CHARACTER (LEN=NSENSORNAMELGTMAX),DIMENSION(:), POINTER :: CNAME_STAT=>NULL()
CHARACTER (LEN=NFILENAMELGTMAX),POINTER :: CFILE_STAT=>NULL()
LOGICAL, POINTER :: LDIAG_SURFRAD_STAT=>NULL()
CONTAINS
diff --git a/src/MNH/modd_budget.f90 b/src/MNH/modd_budget.f90
index 0270f474a0e5b53d71ccc86620c9c9bcafefd866..3b413d569b327ee0666fef3544ba3ac37891174b 100644
--- a/src/MNH/modd_budget.f90
+++ b/src/MNH/modd_budget.f90
@@ -124,7 +124,6 @@ type, extends( tfieldmetadata_base ) :: tburhodata
real, dimension(:,:,:), allocatable :: xdata ! Array to store the budget data
end type tburhodata
-!PW: a commenter + renommer???
type :: tbudiachrometadata
character(len=NBUNAMELGTMAX), dimension(NMAXLEVELS) :: clevels = '' !Name of the different groups/levels in the netCDF file
character(len=NCOMMENTLGTMAX), dimension(NMAXLEVELS) :: ccomments ='' !Comments for the different groups/levels in the netCDF file
diff --git a/src/MNH/modd_diag_flag.f90 b/src/MNH/modd_diag_flag.f90
index a7eaf4b92f2d868c23c4df9d87abd2fac95b50ee..3115f14260767f60d010c5ecf7d427d6fd95c643 100644
--- a/src/MNH/modd_diag_flag.f90
+++ b/src/MNH/modd_diag_flag.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC 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_diag_flag.f90,v $ $Revision: 1.2.4.1.2.2.10.2.2.2.2.2 $
-! masdev4_8 modd 2008/06/30 15:13:13
-!-----------------------------------------------------------------
! #####################
MODULE MODD_DIAG_FLAG
! ######################
@@ -43,7 +38,8 @@
!! T. Dauhut 10/2017 add parallel 3D clustering
!! J.-P. Chaboureau 01/2018 add altitude interpolation
!! J.-P. Chaboureau 01/2018 add coarse graining
-!!
+! P. Wautelet 15/09/2023: remove offline balloons
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -109,13 +105,6 @@ LOGICAL :: LCHAQDIAG ! flag for aqueous phase chemistry
REAL, DIMENSION(10) :: XCHEMLAT,XCHEMLON ! positions of vertical profiles written by routine write_ts1d
CHARACTER (LEN=1024) :: CSPEC_BU_DIAG
CHARACTER (LEN=1024) :: CSPEC_DIAG
-LOGICAL :: LAIRCRAFT_BALLOON ! aircraft and balloon trajectories
-INTEGER :: NTIME_AIRCRAFT_BALLOON ! time in seconds of trajectories computing
-REAL :: XSTEP_AIRCRAFT_BALLOON ! minimum time step for trajectories calculations (s)
-REAL, DIMENSION(9) :: XLAT_BALLOON ! initial latitudes of the balloons
- !(at file time minus NTIME_AIRCRAFT_BALLOON/2)
-REAL, DIMENSION(9) :: XLON_BALLOON ! initial longitudes of the balloons
-REAL, DIMENSION(9) :: XALT_BALLOON ! initial altitude of the balloons (m)
LOGICAL :: LC2R2
LOGICAL :: LC3R5
LOGICAL :: LELECDIAG ! flag for atmospheric electricity
diff --git a/src/MNH/modd_dust.f90 b/src/MNH/modd_dust.f90
index 540de108e225683892178339a0ca054f7064f0c2..2f2a7dca2de875bddd3dd308f7aa875cc26c8d21 100644
--- a/src/MNH/modd_dust.f90
+++ b/src/MNH/modd_dust.f90
@@ -100,7 +100,7 @@ REAL, DIMENSION(3) :: XINIRADIUS= 0.5*(/0.078, 0.641, 5.00 /)
!Initial, standard deviation from Alfaro et al 1998
REAL, DIMENSION(3) :: XINISIG = (/1.75, 1.76, 1.70/)
!Minimum allowed number concentration for any mode (#/m3)
-REAL, DIMENSION(3) :: XN0MIN = (/1.e3 , 1.e1 , 1.e-2 /)
+REAL, DIMENSION(3) :: XN0MIN = (/1.e1 , 1.e-1 , 1.e-4 /)
CHARACTER(LEN=9),DIMENSION(:),ALLOCATABLE :: CDEDSTNAMES
CHARACTER(LEN=9),DIMENSION(6), PARAMETER :: YPDEDST_INI = &
(/'DEDSTM31C','DEDSTM32C','DEDSTM33C' &
diff --git a/src/MNH/modd_parameters.f90 b/src/MNH/modd_parameters.f90
index c848073f93201f6d291e7003dba2fa21601ae5aa..3b477bf0de8858f0c40452e51a9876c6f610cd79 100644
--- a/src/MNH/modd_parameters.f90
+++ b/src/MNH/modd_parameters.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -86,8 +86,8 @@ INTEGER, PARAMETER :: NMNHNAMELGTMAX = 32 ! Maximum length of a MNH variable n
INTEGER, PARAMETER :: NSTDNAMELGTMAX = 64 ! Maximum length of the standard name of a variable (CF convention)
INTEGER, PARAMETER :: NLONGNAMELGTMAX = 32 ! Maximum length of the long name of a variable (CF convention)
INTEGER, PARAMETER :: NUNITLGTMAX = 40 ! Maximum length of the canonical units of a variable (CF convention)
-!
-INTEGER, PARAMETER :: NSTATPROFNAMELGTMAX = 8 ! Maximum length for the name of a station or profiler
+
+INTEGER, PARAMETER :: NSENSORNAMELGTMAX = 10 ! Maximum length for the name of a sensor (aircraft, balloon, station, profiler...)
INTEGER, PARAMETER :: NDIRNAMELGTMAX = 512 ! Maximum length of a directory name
INTEGER, PARAMETER :: NFILENAMELGTMAX = 32 ! Maximum length of a file name (must be at least NFILENAMELGTMAXLFI)
diff --git a/src/MNH/modd_profilern.f90 b/src/MNH/modd_profilern.f90
index 3abfe6611c28229209d7ccd573edb89995900643..96b70fb2e76c2cbe7ee4e6d2a964f6ff525f7ef4 100644
--- a/src/MNH/modd_profilern.f90
+++ b/src/MNH/modd_profilern.f90
@@ -37,7 +37,8 @@
!
!
USE MODD_PARAMETERS, ONLY: JPMODELMAX
-USE MODD_TYPE_STATPROF, ONLY: TPROFILERDATA, TSTATPROFTIME
+USE MODD_TYPE_STATPROF, ONLY: TPROFILERDATA
+USE MODD_SENSOR, ONLY: TSENSORTIME
IMPLICIT NONE
@@ -54,7 +55,7 @@ TYPE PROFILER_t
LOGICAL :: LPROFILER ! flag to use profilers
INTEGER :: NUMBPROFILER_LOC = 0 ! number of profilers on this process
!
- TYPE(TSTATPROFTIME) :: TPROFILERS_TIME
+ TYPE(TSENSORTIME) :: TPROFILERS_TIME
TYPE(TPROFILERDATA), DIMENSION(:), POINTER :: TPROFILERS ! characteristics and records of the profilers
!
END TYPE PROFILER_t
@@ -63,7 +64,7 @@ TYPE(PROFILER_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: PROFILER_MODEL
LOGICAL, POINTER :: LPROFILER=>NULL()
INTEGER, POINTER :: NUMBPROFILER_LOC=>NULL()
-TYPE(TSTATPROFTIME), POINTER :: TPROFILERS_TIME => NULL()
+TYPE(TSENSORTIME), POINTER :: TPROFILERS_TIME => NULL()
TYPE(TPROFILERDATA), DIMENSION(:), POINTER :: TPROFILERS => NULL()
CONTAINS
diff --git a/src/MNH/modd_salt.f90 b/src/MNH/modd_salt.f90
index e111b15db085287e012c5afaf137f9be3bd03185..c8ebbebd09a3525e588a3ce3b226f22ac60aaa44 100644
--- a/src/MNH/modd_salt.f90
+++ b/src/MNH/modd_salt.f90
@@ -83,7 +83,7 @@ REAL,DIMENSION(8) :: XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115,0.415,2.5,
REAL,DIMENSION(8) :: XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85,1.7,1.8, 2.9 /)
!Minimum allowed number concentration for any mode (#/m3)
-REAL,DIMENSION(8) :: XN0MIN_SLT = (/1.e1 , 1.e1, 1.e1, 1., 1.e-4,1.e-20, 1.e-20,1.e-20 /)
+REAL,DIMENSION(8) :: XN0MIN_SLT = (/1.e1 , 1.e1, 1.e1, 1., 1.e-4,1.e-5, 1.e-6,1.e-7 /)
!Test Thomas
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XSLTMSS ! [kg/m3] total mass concentration of sea salt
!
diff --git a/src/MNH/modd_sensor.f90 b/src/MNH/modd_sensor.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b780c39137fc86ee7ed5d63c5a9af8921b9b8c04
--- /dev/null
+++ b/src/MNH/modd_sensor.f90
@@ -0,0 +1,1436 @@
+!MNH_LIC Copyright 2023-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Original version:
+! P. Wautelet: 27/04/2023
+! Modifications:
+!-----------------------------------------------------------------
+MODULE MODD_SENSOR
+ USE MODD_PARAMETERS, ONLY: NSENSORNAMELGTMAX, NNEGUNDEF, XNEGUNDEF, XUNDEF
+ USE MODD_TYPE_DATE, ONLY: DATE_TIME
+ USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: TSENSOR
+ PUBLIC :: TSENSORTIME
+
+ INTEGER, PARAMETER :: NTAG_NCUR = 145
+ INTEGER, PARAMETER :: NTAG_PACK = 245
+
+ INTEGER, PARAMETER :: NEMPTYDATA = -1 ! Size to communicate if exchange of no sensor data
+ TYPE :: TSENSORTIME
+ INTEGER :: N_CUR = 0 ! current step of storage
+ REAL :: XTSTEP = 60. ! storage time step (default reset later)
+ TYPE(DATE_TIME), DIMENSION(:), ALLOCATABLE :: TPDATES ! dates(n) (n: recording instants)
+
+ CONTAINS
+ PROCEDURE :: STORESTEP_CHECK_AND_SET
+ END TYPE TSENSORTIME
+
+ TYPE, ABSTRACT :: TSENSOR
+ CHARACTER(LEN=NSENSORNAMELGTMAX) :: CNAME = '' ! Title or name of the sensor
+ CHARACTER(LEN=NSENSORNAMELGTMAX) :: CTYPE = '' ! Sensor type:
+ ! 'AIRCRAFT' : aircraft
+ ! 'RADIOS' : radiosounding balloon, 'ISODEN' : iso-density balloon, 'CVBALL' : Constant Volume balloon
+ ! 'STATION', 'PROFILER',...
+ INTEGER :: NID = 0 ! Identification number of the sensor (from 1 to total number,
+ ! separate numbering for separate sensor types)
+ INTEGER :: NSTORE_CUR = 0 ! Current store instant
+ INTEGER :: NSTORE_MAX = -1 ! Maximum number of store instants (negative if arrays not allocated)
+
+ INTEGER :: NBUFFER_FIXSIZE = 43 + 2 * NSENSORNAMELGTMAX ! Memory size required for exchange buffer (fixed part)
+ INTEGER :: NBUFFER_VARSIZE = 0 ! Memory size required for exchange buffer (part per store instant)
+
+ LOGICAL :: LFIX ! true if sensor is fix (can not move)
+
+ ! Current position of sensor
+ REAL :: XX_CUR = XNEGUNDEF ! x position
+ REAL :: XY_CUR = XNEGUNDEF ! y position
+ REAL :: XZ_CUR = XNEGUNDEF ! z position
+ REAL :: XLAT_CUR = XNEGUNDEF ! latitude
+ REAL :: XLON_CUR = XNEGUNDEF ! longitude
+
+ ! Position in the mesh
+ INTEGER :: NI_M = NNEGUNDEF ! X position for mass-point axis (between this one and the next one)
+ INTEGER :: NJ_M = NNEGUNDEF ! Y position for mass-point axis (between this one and the next one)
+ INTEGER :: NI_U = NNEGUNDEF ! X position for u-point axis (between this one and the next one)
+ INTEGER :: NJ_V = NNEGUNDEF ! Y position for v-point axis (between this one and the next one)
+
+ INTEGER :: NK00 = NNEGUNDEF ! Z position for ni_m , nj_m
+ INTEGER :: NK01 = NNEGUNDEF ! Z position for ni_m , nj_m+1
+ INTEGER :: NK10 = NNEGUNDEF ! Z position for ni_m+1, nj_m
+ INTEGER :: NK11 = NNEGUNDEF ! Z position for ni_m+1, nj_m+1
+ INTEGER :: NU00 = NNEGUNDEF ! Z position for ni_u , nj_m
+ INTEGER :: NU01 = NNEGUNDEF ! Z position for ni_u , nj_m+1
+ INTEGER :: NU10 = NNEGUNDEF ! Z position for ni_u+1, nj_m
+ INTEGER :: NU11 = NNEGUNDEF ! Z position for ni_u+1, nj_m+1
+ INTEGER :: NV00 = NNEGUNDEF ! Z position for ni_m , nj_v
+ INTEGER :: NV01 = NNEGUNDEF ! Z position for ni_m , nj_v+1
+ INTEGER :: NV10 = NNEGUNDEF ! Z position for ni_m+1, nj_v
+ INTEGER :: NV11 = NNEGUNDEF ! Z position for ni_m+1, nj_v+1
+
+ ! Coefficient to interpolate values (sensors are usually not exactly on mesh points)
+ REAL :: XXMCOEF = XUNDEF ! Interpolation coefficient for X (mass-point)
+ REAL :: XYMCOEF = XUNDEF ! Interpolation coefficient for Y (mass-point)
+ REAL :: XXUCOEF = XUNDEF ! Interpolation coefficient for X (U-point)
+ REAL :: XYVCOEF = XUNDEF ! Interpolation coefficient for Y (V-point)
+
+ ! Coefficient to interpolate vertically
+ REAL :: XZCOEF00 = XUNDEF ! Interpolation coefficient in Z direction for ni_m , nj_m
+ REAL :: XZCOEF01 = XUNDEF ! Interpolation coefficient in Z direction for ni_m , nj_m+1
+ REAL :: XZCOEF10 = XUNDEF ! Interpolation coefficient in Z direction for ni_m+1, nj_m
+ REAL :: XZCOEF11 = XUNDEF ! Interpolation coefficient in Z direction for ni_m+1, nj_m+1
+ REAL :: XUCOEF00 = XUNDEF ! Interpolation coefficient in Z direction for ni_u , nj_m
+ REAL :: XUCOEF01 = XUNDEF ! Interpolation coefficient in Z direction for ni_u , nj_m+1
+ REAL :: XUCOEF10 = XUNDEF ! Interpolation coefficient in Z direction for ni_u+1, nj_m
+ REAL :: XUCOEF11 = XUNDEF ! Interpolation coefficient in Z direction for ni_u+1, nj_m+1
+ REAL :: XVCOEF00 = XUNDEF ! Interpolation coefficient in Z direction for ni_m , nj_v
+ REAL :: XVCOEF01 = XUNDEF ! Interpolation coefficient in Z direction for ni_m , nj_v+1
+ REAL :: XVCOEF10 = XUNDEF ! Interpolation coefficient in Z direction for ni_m+1, nj_v
+ REAL :: XVCOEF11 = XUNDEF ! Interpolation coefficient in Z direction for ni_m+1, nj_v+1
+
+ ! Data records (at recording instants)
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XZON ! zonal wind(n)
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XMER ! meridian wind(n)
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XW ! w(n) (air vertical speed)
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XP ! p(n)
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XTKE ! tke(n)
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XTH ! th(n)
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: XR ! r*(n)
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: XSV ! Sv*(n)
+ REAL, DIMENSION(:), ALLOCATABLE :: XTSRAD ! surface temperature Ts(n)
+ REAL, DIMENSION(:), ALLOCATABLE :: XRHOD_SENSOR ! density of dry air at sensor position
+
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XRHOD ! density of dry air
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XCIZ ! Ice concentration
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XCCZ ! Cloud concentration (LIMA)
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XCRZ ! Rain concentration (LIMA)
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XIWCZ ! ice water content
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XLWCZ ! liquid water content
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XCRARE ! cloud radar reflectivity
+ REAL, DIMENSION(:,:), ALLOCATABLE :: XCRARE_ATT ! attenuated (= more realistic) cloud radar reflectivity
+
+
+ CONTAINS
+ PROCEDURE(TSENSOR_ALLOCATION), DEFERRED :: DATA_ARRAYS_ALLOCATE
+ PROCEDURE(TSENSOR_DEALLOCATION), DEFERRED :: DATA_ARRAYS_DEALLOCATE
+ ! Remark: data_arrays_(de)allocate_sensor do not point to data_arrays_(de)allocate to allow other dummy arguments
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_ALLOCATE_SENSOR
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_DEALLOCATE_SENSOR
+
+ PROCEDURE :: COMPUTE_VERTICAL_INTERP_COEFF
+ PROCEDURE :: INTERP_FROM_MASSPOINT
+ PROCEDURE :: INTERP_FROM_UPOINT
+ PROCEDURE :: INTERP_FROM_VPOINT
+ PROCEDURE :: INTERP_HOR_FROM_MASSPOINT_0D
+ PROCEDURE :: INTERP_HOR_FROM_UPOINT_0D
+ PROCEDURE :: INTERP_HOR_FROM_VPOINT_0D
+ PROCEDURE :: INTERP_HOR_FROM_MASSPOINT_1D
+ PROCEDURE :: INTERP_HOR_FROM_UPOINT_1D
+ PROCEDURE :: INTERP_HOR_FROM_VPOINT_1D
+
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_SIZE_COMPUTE
+ ! 2 procedures pointing to the same one: necessary to allow overload for extended types (limitation of Fortran standard)
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_PACK_SENSOR
+ PROCEDURE :: BUFFER_PACK => BUFFER_PACK_SENSOR
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_UNPACK_SENSOR
+ PROCEDURE :: BUFFER_UNPACK => BUFFER_UNPACK_SENSOR
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_SIZE_SEND
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_SIZE_RECV
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_SEND
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_RECV
+ PROCEDURE, NON_OVERRIDABLE :: SEND => SENSOR_COMM_SEND
+ PROCEDURE, NON_OVERRIDABLE :: SEND_DEALLOCATE => SENSOR_COMM_SEND_DEALLOCATE
+ PROCEDURE, NON_OVERRIDABLE :: RECV_ALLOCATE => SENSOR_COMM_RECV_ALLOCATE
+
+ GENERIC :: INTERP_HOR_FROM_MASSPOINT => INTERP_HOR_FROM_MASSPOINT_0D, INTERP_HOR_FROM_MASSPOINT_1D
+ GENERIC :: INTERP_HOR_FROM_UPOINT => INTERP_HOR_FROM_UPOINT_0D, INTERP_HOR_FROM_UPOINT_1D
+ GENERIC :: INTERP_HOR_FROM_VPOINT => INTERP_HOR_FROM_VPOINT_0D, INTERP_HOR_FROM_VPOINT_1D
+
+ END TYPE TSENSOR
+
+ ABSTRACT INTERFACE
+ SUBROUTINE TSENSOR_ALLOCATION( TPSENSOR, KSTORE )
+ IMPORT TSENSOR
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE
+ END SUBROUTINE
+
+ SUBROUTINE TSENSOR_DEALLOCATION( TPSENSOR )
+ IMPORT TSENSOR
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+ END SUBROUTINE
+ END INTERFACE
+
+
+ CONTAINS
+ ! ############################################################################
+ SUBROUTINE DATA_ARRAYS_ALLOCATE_SENSOR( TPSENSOR, OVERTPROF, KLEVELS, KSTORE )
+ ! ############################################################################
+
+ USE MODD_CONF_N, ONLY: NRR
+ USE MODD_DIM_N, ONLY: NKMAX
+ USE MODD_NSV, ONLY: NSV
+ USE MODD_PARAMETERS, ONLY: JPVEXT
+ USE MODD_PARAM_N, ONLY: CCLOUD, CRAD, CTURB
+
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+ LOGICAL, INTENT(IN) :: OVERTPROF ! vertical profile or not
+ INTEGER, INTENT(IN) :: KLEVELS ! number of vertical levels
+ INTEGER, INTENT(IN) :: KSTORE ! number of storage instants
+
+ INTEGER :: IKU ! number of vertical levels for profile
+ INTEGER :: IVARSIZE ! total allocated size per store
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_allocate_sensor', 'sensor: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ IKU = NKMAX + 2 * JPVEXT
+ IVARSIZE = 0
+
+ IF ( TPSENSOR%NSTORE_MAX >= 0 ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Data_arrays_allocate_sensor', 'sensor: ' // TRIM(TPSENSOR%CNAME) &
+ // ' already allocated', OLOCAL = .TRUE. )
+ RETURN
+ END IF
+
+ TPSENSOR%NSTORE_MAX = KSTORE
+
+ ALLOCATE( TPSENSOR%XZON (KLEVELS, KSTORE) ) ; IVARSIZE = IVARSIZE + KLEVELS
+ ALLOCATE( TPSENSOR%XMER (KLEVELS, KSTORE) ) ; IVARSIZE = IVARSIZE + KLEVELS
+ ALLOCATE( TPSENSOR%XW (KLEVELS, KSTORE) ) ; IVARSIZE = IVARSIZE + KLEVELS
+ ALLOCATE( TPSENSOR%XP (KLEVELS, KSTORE) ) ; IVARSIZE = IVARSIZE + KLEVELS
+ IF ( CTURB == 'TKEL' ) THEN
+ ALLOCATE( TPSENSOR%XTKE(KLEVELS, KSTORE) ) ; IVARSIZE = IVARSIZE + KLEVELS
+ ELSE
+ ALLOCATE( TPSENSOR%XTKE(0, 0) )
+ END IF
+ ALLOCATE( TPSENSOR%XTH (KLEVELS, KSTORE) ) ; IVARSIZE = IVARSIZE + KLEVELS
+ ALLOCATE( TPSENSOR%XR (KLEVELS, KSTORE, NRR) ) ; IVARSIZE = IVARSIZE + KLEVELS * NRR
+ ALLOCATE( TPSENSOR%XSV (KLEVELS, KSTORE, NSV) ) ; IVARSIZE = IVARSIZE + KLEVELS * NSV
+ IF ( CRAD /= 'NONE' ) THEN
+ ALLOCATE( TPSENSOR%XTSRAD(KSTORE) ) ; IVARSIZE = IVARSIZE + 1
+ ELSE
+ ALLOCATE( TPSENSOR%XTSRAD(0) )
+ END IF
+ ALLOCATE( TPSENSOR%XRHOD_SENSOR(KSTORE) ) ; IVARSIZE = IVARSIZE + 1
+
+ IF ( OVERTPROF ) THEN
+ ALLOCATE( TPSENSOR%XRHOD(IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+
+ IF ( CCLOUD == 'LIMA') THEN
+ ALLOCATE( TPSENSOR%XCIZ (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ALLOCATE( TPSENSOR%XCCZ (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ALLOCATE( TPSENSOR%XCRZ (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ELSE IF ( CCLOUD(1:3) == 'ICE') THEN
+ ALLOCATE( TPSENSOR%XCIZ (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ALLOCATE( TPSENSOR%XCCZ (0, 0) )
+ ALLOCATE( TPSENSOR%XCRZ (0, 0) )
+ ELSE
+ ALLOCATE( TPSENSOR%XCIZ (0, 0) )
+ ALLOCATE( TPSENSOR%XCCZ (0, 0) )
+ ALLOCATE( TPSENSOR%XCRZ (0, 0) )
+ END IF
+
+ ALLOCATE( TPSENSOR%XIWCZ (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ALLOCATE( TPSENSOR%XLWCZ (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ALLOCATE( TPSENSOR%XCRARE (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ALLOCATE( TPSENSOR%XCRARE_ATT(IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ELSE
+ ALLOCATE( TPSENSOR%XRHOD (0, 0) )
+ ALLOCATE( TPSENSOR%XCIZ (0, 0) )
+ ALLOCATE( TPSENSOR%XCCZ (0, 0) )
+ ALLOCATE( TPSENSOR%XCRZ (0, 0) )
+ ALLOCATE( TPSENSOR%XIWCZ (0, 0) )
+ ALLOCATE( TPSENSOR%XLWCZ (0, 0) )
+ ALLOCATE( TPSENSOR%XCRARE (0, 0) )
+ ALLOCATE( TPSENSOR%XCRARE_ATT(0, 0) )
+ END IF
+
+ TPSENSOR%NBUFFER_VARSIZE = TPSENSOR%NBUFFER_VARSIZE + IVARSIZE
+
+ TPSENSOR%XZON (:,:) = XUNDEF
+ TPSENSOR%XMER (:,:) = XUNDEF
+ TPSENSOR%XW (:,:) = XUNDEF
+ TPSENSOR%XP (:,:) = XUNDEF
+ TPSENSOR%XTKE (:,:) = XUNDEF
+ TPSENSOR%XTH (:,:) = XUNDEF
+ TPSENSOR%XR (:,:,:) = XUNDEF
+ TPSENSOR%XSV (:,:,:) = XUNDEF
+ TPSENSOR%XTSRAD (:) = XUNDEF_SFX
+ TPSENSOR%XRHOD_SENSOR(:) = XNEGUNDEF
+ TPSENSOR%XRHOD (:,:) = XNEGUNDEF
+ TPSENSOR%XCIZ (:,:) = XUNDEF
+ TPSENSOR%XCCZ (:,:) = XUNDEF
+ TPSENSOR%XCRZ (:,:) = XUNDEF
+ TPSENSOR%XIWCZ (:,:) = XUNDEF
+ TPSENSOR%XLWCZ (:,:) = XUNDEF
+ TPSENSOR%XCRARE (:,:) = XUNDEF
+ TPSENSOR%XCRARE_ATT(:,:) = XUNDEF
+
+ END SUBROUTINE DATA_ARRAYS_ALLOCATE_SENSOR
+
+
+ ! ##################################################
+ SUBROUTINE DATA_ARRAYS_DEALLOCATE_SENSOR( TPSENSOR )
+ ! ##################################################
+
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_deallocate_sensor', 'sensor: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ ! nstore_max set to negative value to inform that arrays are not allocated
+ TPSENSOR%NSTORE_MAX = -1
+
+ DEALLOCATE( TPSENSOR%XZON )
+ DEALLOCATE( TPSENSOR%XMER )
+ DEALLOCATE( TPSENSOR%XW )
+ DEALLOCATE( TPSENSOR%XP )
+ DEALLOCATE( TPSENSOR%XTKE )
+ DEALLOCATE( TPSENSOR%XTH )
+ DEALLOCATE( TPSENSOR%XR )
+ DEALLOCATE( TPSENSOR%XSV )
+ DEALLOCATE( TPSENSOR%XTSRAD )
+ DEALLOCATE( TPSENSOR%XRHOD_SENSOR )
+ DEALLOCATE( TPSENSOR%XRHOD )
+ DEALLOCATE( TPSENSOR%XCIZ )
+ DEALLOCATE( TPSENSOR%XCCZ )
+ DEALLOCATE( TPSENSOR%XCRZ )
+ DEALLOCATE( TPSENSOR%XIWCZ )
+ DEALLOCATE( TPSENSOR%XLWCZ )
+ DEALLOCATE( TPSENSOR%XCRARE )
+ DEALLOCATE( TPSENSOR%XCRARE_ATT )
+
+ END SUBROUTINE DATA_ARRAYS_DEALLOCATE_SENSOR
+
+
+ ! ###########################################################################
+ FUNCTION STORESTEP_CHECK_AND_SET( TPSENSOR_TIME, KSTORE_ID ) RESULT( OSTORE )
+ ! ###########################################################################
+
+ USE MODD_TIME_N, ONLY: TDTCUR
+
+ USE MODE_DATETIME
+ USE MODE_MSG
+
+ CLASS(TSENSORTIME), INTENT(INOUT) :: TPSENSOR_TIME
+ INTEGER, INTENT(OUT) :: KSTORE_ID ! current step of storage
+ LOGICAL :: OSTORE
+
+ OSTORE = .FALSE.
+
+ IF ( .NOT.ALLOCATED( TPSENSOR_TIME%TPDATES ) ) &
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'Storestep_check_and_set', 'tpdates not allocated for tpsensor_time' )
+
+ IF ( TPSENSOR_TIME%N_CUR == 0 ) THEN
+ IF ( SIZE( TPSENSOR_TIME%TPDATES ) < 1 ) &
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'Storestep_check_and_set', 'tpdates too small' )
+
+ ! First store
+ TPSENSOR_TIME%N_CUR = 1
+ TPSENSOR_TIME%TPDATES(1) = TDTCUR
+ KSTORE_ID = 1
+ OSTORE = .TRUE.
+ ELSE IF ( TPSENSOR_TIME%N_CUR > 0 ) THEN
+ IF ( TDTCUR - TPSENSOR_TIME%TPDATES(TPSENSOR_TIME%N_CUR) >= TPSENSOR_TIME%XTSTEP - 1.E-6 ) THEN
+ TPSENSOR_TIME%N_CUR = TPSENSOR_TIME%N_CUR + 1
+ KSTORE_ID = TPSENSOR_TIME%N_CUR
+
+ IF ( KSTORE_ID < 1 .OR. KSTORE_ID > SIZE( TPSENSOR_TIME%TPDATES ) ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Storestep_check_and_set', 'problem with step of storage' )
+ KSTORE_ID = -2
+ ELSE
+ TPSENSOR_TIME%TPDATES(KSTORE_ID) = TDTCUR
+ OSTORE = .TRUE.
+ END IF
+ ELSE
+ ! Return an invalid step number
+ ! This is not an instant to do a store
+ KSTORE_ID = -1
+ END IF
+ ELSE
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Storestep_check_and_set', 'n_cur cannot be negative' )
+ KSTORE_ID = -3
+ END IF
+
+ END FUNCTION STORESTEP_CHECK_AND_SET
+
+
+ ! ##############################################################################################
+ SUBROUTINE COMPUTE_VERTICAL_INTERP_COEFF( TPSENSOR, HPOS, PALT, PZ, OLOW, OHIGH, ODONOLOWCRASH )
+ ! ##############################################################################################
+ USE MODD_PARAMETERS, ONLY: JPVEXT
+ USE MODD_TIME_N, ONLY: TDTCUR
+
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+ CHARACTER(LEN=*), INTENT(IN) :: HPOS ! Compute interpolation coefficients for Arakawa points ('MASS', 'U' or 'V')
+ REAL, INTENT(IN) :: PALT ! Altitude to which compute interpolation coefficients
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! Altitudes around point
+ LOGICAL, INTENT(OUT) :: OLOW ! true if sensor is too low
+ LOGICAL, INTENT(OUT) :: OHIGH ! true if sensor is too high
+ LOGICAL, OPTIONAL, INTENT(IN) :: ODONOLOWCRASH ! if true, force position to ground when sensor is below it
+
+ INTEGER :: IK00, IK01, IK10, IK11
+ INTEGER :: IKB, IKE, IKU
+ INTEGER :: JI, JJ
+ LOGICAL :: GDONE ! set to true if coefficient computation has been done
+ LOGICAL :: GDONOLOWCRASH
+ REAL :: ZZCOEF00, ZZCOEF01, ZZCOEF10, ZZCOEF11
+
+ OLOW = .FALSE.
+ OHIGH = .FALSE.
+
+ GDONE = .FALSE.
+
+ IKB = 1 + JPVEXT
+ IKE = SIZE( PZ, 3 ) - JPVEXT
+ IKU = SIZE( PZ, 3 )
+
+ IF ( PRESENT( ODONOLOWCRASH ) ) THEN
+ GDONOLOWCRASH = ODONOLOWCRASH
+ ELSE
+ GDONOLOWCRASH = .FALSE.
+ END IF
+ ! Interpolation coefficients for the 4 suroundings verticals
+
+ ! Determine ik?? coefficients depending on the level ordering
+ ! (altitudes can also be based on pressure that decreaze with heigth)
+ IF ( PZ(1,1,2) > PZ(1,1,1) ) THEN
+ IK00 = MAX( COUNT (PALT >= PZ(1,1,:)), 1)
+ IK01 = MAX( COUNT (PALT >= PZ(1,2,:)), 1)
+ IK10 = MAX( COUNT (PALT >= PZ(2,1,:)), 1)
+ IK11 = MAX( COUNT (PALT >= PZ(2,2,:)), 1)
+ ELSE
+ IK00 = MAX( COUNT (PALT <= PZ(1,1,:)), 1)
+ IK01 = MAX( COUNT (PALT <= PZ(1,2,:)), 1)
+ IK10 = MAX( COUNT (PALT <= PZ(2,1,:)), 1)
+ IK11 = MAX( COUNT (PALT <= PZ(2,2,:)), 1)
+ END IF
+
+ IF ( ANY( [ IK00, IK01, IK10, IK11 ] < IKB ) ) THEN
+ ! Sensor is low (too near the ground or below it)
+ OLOW = .TRUE.
+
+ IF ( GDONOLOWCRASH ) THEN
+ ! Do not allow crash on the ground: set position on the ground if too low
+ !Minimum altitude is on the ground at ikb (no crash if too low)
+ IK00 = MAX ( IK00, IKB )
+ IK01 = MAX ( IK01, IKB )
+ IK10 = MAX ( IK10, IKB )
+ IK11 = MAX ( IK11, IKB )
+
+ ZZCOEF00 = ( PALT - PZ(1,1,IK00) ) / ( PZ(1,1,IK00+1) - PZ(1,1,IK00) )
+ ZZCOEF01 = ( PALT - PZ(1,2,IK01) ) / ( PZ(1,2,IK01+1) - PZ(1,2,IK01) )
+ ZZCOEF10 = ( PALT - PZ(2,1,IK10) ) / ( PZ(2,1,IK10+1) - PZ(2,1,IK10) )
+ ZZCOEF11 = ( PALT - PZ(2,2,IK11) ) / ( PZ(2,2,IK11+1) - PZ(2,2,IK11) )
+
+ CMNHMSG(1) = 'sensor ' // TRIM( TPSENSOR%CNAME ) // ' is near the ground'
+ WRITE( CMNHMSG(2), "( 'at ', I2, '/', I2, '/', I4, ' ', F18.12, 's' )" ) &
+ TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'Compute_vertical_interp_coeff', OLOCAL = .TRUE. )
+ ELSE
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'Compute_vertical_interp_coeff', &
+ 'sensor ' // TRIM( TPSENSOR%CNAME ) // ' is too low', OLOCAL = .TRUE. )
+ ZZCOEF00 = XUNDEF
+ ZZCOEF01 = XUNDEF
+ ZZCOEF10 = XUNDEF
+ ZZCOEF11 = XUNDEF
+ END IF
+ GDONE = .TRUE.
+ END IF
+
+ ! In a separate if (compared to olow detection) to allow olow and ohigh=true simultaneaously (very rare event!)
+ IF ( ANY( [ IK00, IK01, IK10, IK11 ] >= IKE ) ) THEN
+ ! Sensor is high (above physical domain)
+ OHIGH = .TRUE.
+
+ ! Limit ik?? indices to prevent out of bound accesses
+ IK00 = MIN( IK00, IKE )
+ IK01 = MIN( IK01, IKE )
+ IK10 = MIN( IK10, IKE )
+ IK11 = MIN( IK11, IKE )
+
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'Compute_vertical_interp_coeff', &
+ 'sensor ' // TRIM( TPSENSOR%CNAME ) // ' is too high', OLOCAL = .TRUE. )
+
+ ZZCOEF00 = XUNDEF
+ ZZCOEF01 = XUNDEF
+ ZZCOEF10 = XUNDEF
+ ZZCOEF11 = XUNDEF
+
+ GDONE = .TRUE.
+ END IF
+
+ IF ( .NOT. GDONE ) THEN
+ ZZCOEF00 = ( PALT - PZ(1,1,IK00) ) / ( PZ(1,1,IK00+1) - PZ(1,1,IK00) )
+ ZZCOEF01 = ( PALT - PZ(1,2,IK01) ) / ( PZ(1,2,IK01+1) - PZ(1,2,IK01) )
+ ZZCOEF10 = ( PALT - PZ(2,1,IK10) ) / ( PZ(2,1,IK10+1) - PZ(2,1,IK10) )
+ ZZCOEF11 = ( PALT - PZ(2,2,IK11) ) / ( PZ(2,2,IK11+1) - PZ(2,2,IK11) )
+ END IF
+
+
+ SELECT CASE ( HPOS )
+ CASE ( 'MASS' )
+ TPSENSOR%NK00 = IK00
+ TPSENSOR%NK01 = IK01
+ TPSENSOR%NK10 = IK10
+ TPSENSOR%NK11 = IK11
+
+ TPSENSOR%XZCOEF00 = ZZCOEF00
+ TPSENSOR%XZCOEF01 = ZZCOEF01
+ TPSENSOR%XZCOEF10 = ZZCOEF10
+ TPSENSOR%XZCOEF11 = ZZCOEF11
+
+ CASE ( 'U' )
+ TPSENSOR%NU00 = IK00
+ TPSENSOR%NU01 = IK01
+ TPSENSOR%NU10 = IK10
+ TPSENSOR%NU11 = IK11
+
+ TPSENSOR%XUCOEF00 = ZZCOEF00
+ TPSENSOR%XUCOEF01 = ZZCOEF01
+ TPSENSOR%XUCOEF10 = ZZCOEF10
+ TPSENSOR%XUCOEF11 = ZZCOEF11
+
+ CASE ( 'V' )
+ TPSENSOR%NV00 = IK00
+ TPSENSOR%NV01 = IK01
+ TPSENSOR%NV10 = IK10
+ TPSENSOR%NV11 = IK11
+
+ TPSENSOR%XVCOEF00 = ZZCOEF00
+ TPSENSOR%XVCOEF01 = ZZCOEF01
+ TPSENSOR%XVCOEF10 = ZZCOEF10
+ TPSENSOR%XVCOEF11 = ZZCOEF11
+
+ CASE DEFAULT
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Compute_vertical_interp_coeff', 'invalid hpos', OLOCAL = .TRUE. )
+
+ END SELECT
+ END SUBROUTINE COMPUTE_VERTICAL_INTERP_COEFF
+
+
+ ! #######################################################
+ FUNCTION INTERP_FROM_MASSPOINT( TPSENSOR, PA ) RESULT( PB )
+ ! #######################################################
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
+ REAL :: PB
+
+ INTEGER :: JI, JJ
+ INTEGER :: IK00, IK01, IK10, IK11
+ REAL :: ZXMCOEF, ZYMCOEF
+ REAL :: ZZCOEF00, ZZCOEF01, ZZCOEF10, ZZCOEF11
+
+ IF ( SIZE( PA, 1 ) == 2 ) THEN
+ JI = 1
+ JJ = 1
+ ELSE
+ JI = TPSENSOR%NI_M
+ JJ = TPSENSOR%NJ_M
+ END IF
+
+ IK00 = TPSENSOR%NK00
+ IK01 = TPSENSOR%NK01
+ IK10 = TPSENSOR%NK10
+ IK11 = TPSENSOR%NK11
+
+ ZXMCOEF = TPSENSOR%XXMCOEF
+ ZYMCOEF = TPSENSOR%XYMCOEF
+
+ ZZCOEF00 = TPSENSOR%XZCOEF00
+ ZZCOEF01 = TPSENSOR%XZCOEF01
+ ZZCOEF10 = TPSENSOR%XZCOEF10
+ ZZCOEF11 = TPSENSOR%XZCOEF11
+
+ IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
+ .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) &
+ .AND. ALL( [IK00,IK01,IK10,IK11] >= 1 ) .AND. ALL( [IK00,IK01,IK10,IK11] < SIZE( PA, 3 ) ) ) THEN
+ PB = (1.-ZXMCOEF) * (1.-ZYMCOEF) * ( (1.-ZZCOEF00) * PA(JI ,JJ ,IK00) + ZZCOEF00 * PA(JI ,JJ ,IK00+1) ) + &
+ ( ZXMCOEF) * (1.-ZYMCOEF) * ( (1.-ZZCOEF10) * PA(JI+1,JJ ,IK10) + ZZCOEF10 * PA(JI+1,JJ ,IK10+1) ) + &
+ (1.-ZXMCOEF) * ( ZYMCOEF) * ( (1.-ZZCOEF01) * PA(JI ,JJ+1,IK01) + ZZCOEF01 * PA(JI ,JJ+1,IK01+1) ) + &
+ ( ZXMCOEF) * ( ZYMCOEF) * ( (1.-ZZCOEF11) * PA(JI+1,JJ+1,IK11) + ZZCOEF11 * PA(JI+1,JJ+1,IK11+1) )
+ ELSE
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Interp_from_masspoint', 'value can not be interpolated', OLOCAL = .TRUE. )
+ PB = XUNDEF
+ END IF
+
+ END FUNCTION INTERP_FROM_MASSPOINT
+
+
+ ! ######################################################
+ FUNCTION INTERP_FROM_UPOINT( TPSENSOR, PA ) RESULT( PB )
+ ! ######################################################
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
+ REAL :: PB
+
+ INTEGER :: JI, JJ
+ INTEGER :: IU00, IU01, IU10, IU11
+ REAL :: ZXUCOEF, ZYUCOEF
+ REAL :: ZUCOEF00, ZUCOEF01, ZUCOEF10, ZUCOEF11
+
+ IF ( SIZE( PA, 1 ) == 2 ) THEN
+ JI = 1
+ JJ = 1
+ ELSE
+ JI = TPSENSOR%NI_U
+ JJ = TPSENSOR%NJ_M
+ END IF
+
+ IU00 = TPSENSOR%NU00
+ IU01 = TPSENSOR%NU01
+ IU10 = TPSENSOR%NU10
+ IU11 = TPSENSOR%NU11
+
+ ZXUCOEF = TPSENSOR%XXUCOEF
+ ZYUCOEF = TPSENSOR%XYMCOEF
+
+ ZUCOEF00 = TPSENSOR%XUCOEF00
+ ZUCOEF01 = TPSENSOR%XUCOEF01
+ ZUCOEF10 = TPSENSOR%XUCOEF10
+ ZUCOEF11 = TPSENSOR%XUCOEF11
+
+ IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
+ .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) &
+ .AND. ALL( [IU00,IU01,IU10,IU11] >= 1 ) .AND. ALL( [IU00,IU01,IU10,IU11] < SIZE( PA, 3 ) ) ) THEN
+ PB = (1.-ZXUCOEF) * (1.-ZYUCOEF) * ( (1.-ZUCOEF00) * PA(JI ,JJ ,IU00) + ZUCOEF00 * PA(JI ,JJ ,IU00+1) ) + &
+ ( ZXUCOEF) * (1.-ZYUCOEF) * ( (1.-ZUCOEF10) * PA(JI+1,JJ ,IU10) + ZUCOEF10 * PA(JI+1,JJ ,IU10+1) ) + &
+ (1.-ZXUCOEF) * ( ZYUCOEF) * ( (1.-ZUCOEF01) * PA(JI ,JJ+1,IU01) + ZUCOEF01 * PA(JI ,JJ+1,IU01+1) ) + &
+ ( ZXUCOEF) * ( ZYUCOEF) * ( (1.-ZUCOEF11) * PA(JI+1,JJ+1,IU11) + ZUCOEF11 * PA(JI+1,JJ+1,IU11+1) )
+ ELSE
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Interp_from_upoint', 'value can not be interpolated', OLOCAL = .TRUE. )
+ PB = XUNDEF
+ END IF
+
+ END FUNCTION INTERP_FROM_UPOINT
+
+
+ ! ######################################################
+ FUNCTION INTERP_FROM_VPOINT( TPSENSOR, PA ) RESULT( PB )
+ ! ######################################################
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
+ REAL :: PB
+
+ INTEGER :: JI, JJ
+ INTEGER :: IV00, IV01, IV10, IV11
+ REAL :: ZXVCOEF, ZYVCOEF
+ REAL :: ZVCOEF00, ZVCOEF01, ZVCOEF10, ZVCOEF11
+
+ IF ( SIZE( PA, 1 ) == 2 ) THEN
+ JI = 1
+ JJ = 1
+ ELSE
+ JI = TPSENSOR%NI_M
+ JJ = TPSENSOR%NJ_V
+ END IF
+
+ IV00 = TPSENSOR%NV00
+ IV01 = TPSENSOR%NV01
+ IV10 = TPSENSOR%NV10
+ IV11 = TPSENSOR%NV11
+
+ ZXVCOEF = TPSENSOR%XXMCOEF
+ ZYVCOEF = TPSENSOR%XYVCOEF
+
+ ZVCOEF00 = TPSENSOR%XVCOEF00
+ ZVCOEF01 = TPSENSOR%XVCOEF01
+ ZVCOEF10 = TPSENSOR%XVCOEF10
+ ZVCOEF11 = TPSENSOR%XVCOEF11
+
+ IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
+ .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) &
+ .AND. ALL( [IV00,IV01,IV10,IV11] >= 1 ) .AND. ALL( [IV00,IV01,IV10,IV11] < SIZE( PA, 3 ) ) ) THEN
+ PB = (1.-ZXVCOEF) * (1.-ZYVCOEF) * ( (1.-ZVCOEF00) * PA(JI ,JJ ,IV00) + ZVCOEF00 * PA(JI ,JJ ,IV00+1) ) + &
+ ( ZXVCOEF) * (1.-ZYVCOEF) * ( (1.-ZVCOEF10) * PA(JI+1,JJ ,IV10) + ZVCOEF10 * PA(JI+1,JJ ,IV10+1) ) + &
+ (1.-ZXVCOEF) * ( ZYVCOEF) * ( (1.-ZVCOEF01) * PA(JI ,JJ+1,IV01) + ZVCOEF01 * PA(JI ,JJ+1,IV01+1) ) + &
+ ( ZXVCOEF) * ( ZYVCOEF) * ( (1.-ZVCOEF11) * PA(JI+1,JJ+1,IV11) + ZVCOEF11 * PA(JI+1,JJ+1,IV11+1) )
+ ELSE
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Interp_from_vpoint', 'value can not be interpolated', OLOCAL = .TRUE. )
+ PB = XUNDEF
+ END IF
+
+ END FUNCTION INTERP_FROM_VPOINT
+
+
+ ! ################################################################
+ FUNCTION INTERP_HOR_FROM_MASSPOINT_0D( TPSENSOR, PA ) RESULT( PB )
+ ! ################################################################
+ USE MODD_CONF, ONLY: L1D
+ USE MODD_PARAMETERS, ONLY: XUNDEF
+
+ USE MODE_MSG
+
+ IMPLICIT NONE
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:,:), INTENT(IN) :: PA
+ REAL :: PB
+
+ REAL, DIMENSION(1) :: ZB
+
+ ZB = INTERP_HOR_FROM_MASSPOINT_1D( TPSENSOR, RESHAPE( PA, [ SIZE(PA,1), SIZE(PA,2), 1 ] ) )
+ PB = ZB(1)
+
+ END FUNCTION INTERP_HOR_FROM_MASSPOINT_0D
+
+
+ ! #############################################################
+ FUNCTION INTERP_HOR_FROM_UPOINT_0D( TPSENSOR, PA ) RESULT( PB )
+ ! #############################################################
+ USE MODD_CONF, ONLY: L1D
+
+ USE MODE_MSG
+
+ IMPLICIT NONE
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:,:), INTENT(IN) :: PA
+ REAL :: PB
+
+ REAL, DIMENSION(1) :: ZB
+
+ ZB = INTERP_HOR_FROM_UPOINT_1D( TPSENSOR, RESHAPE( PA, [ SIZE(PA,1), SIZE(PA,2), 1 ] ) )
+ PB = ZB(1)
+
+ END FUNCTION INTERP_HOR_FROM_UPOINT_0D
+
+
+ ! #############################################################
+ FUNCTION INTERP_HOR_FROM_VPOINT_0D( TPSENSOR, PA ) RESULT( PB )
+ ! #############################################################
+ USE MODD_CONF, ONLY: L1D
+
+ USE MODE_MSG
+
+ IMPLICIT NONE
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:,:), INTENT(IN) :: PA
+ REAL :: PB
+
+ REAL, DIMENSION(1) :: ZB
+
+ ZB = INTERP_HOR_FROM_VPOINT_1D( TPSENSOR, RESHAPE( PA, [ SIZE(PA,1), SIZE(PA,2), 1 ] ) )
+ PB = ZB(1)
+
+ END FUNCTION INTERP_HOR_FROM_VPOINT_0D
+
+
+ ! ################################################################
+ FUNCTION INTERP_HOR_FROM_MASSPOINT_1D( TPSENSOR, PA ) RESULT( PB )
+ ! ################################################################
+ USE MODD_CONF, ONLY: L1D
+
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
+ REAL, DIMENSION( SIZE( PA, 3 ) ) :: PB
+
+ INTEGER :: JI, JJ, JK
+
+ IF ( SIZE( PA, 1 ) == 2 ) THEN
+ JI = 1
+ JJ = 1
+ ELSE IF ( L1D ) THEN
+ JI = 2
+ JJ = 2
+ ELSE
+ JI = TPSENSOR%NI_M
+ JJ = TPSENSOR%NJ_M
+ END IF
+
+ IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
+ .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) ) THEN
+ DO JK = 1, SIZE( PA, 3 )
+ IF ( PA(JI, JJ, JK) /= XUNDEF .AND. PA(JI+1, JJ, JK) /= XUNDEF .AND. &
+ PA(JI, JJ+1, JK) /= XUNDEF .AND. PA(JI+1, JJ+1, JK) /= XUNDEF ) THEN
+ PB(JK) = (1.-TPSENSOR%XXMCOEF) * (1.-TPSENSOR%XYMCOEF) * PA(JI, JJ, JK) + &
+ ( TPSENSOR%XXMCOEF) * (1.-TPSENSOR%XYMCOEF) * PA(JI+1, JJ, JK) + &
+ (1.-TPSENSOR%XXMCOEF) * ( TPSENSOR%XYMCOEF) * PA(JI, JJ+1, JK) + &
+ ( TPSENSOR%XXMCOEF) * ( TPSENSOR%XYMCOEF) * PA(JI+1, JJ+1, JK)
+ ELSE
+ PB(JK) = XUNDEF
+ END IF
+ END DO
+ ELSE
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Interp_hor_from_masspoint', 'value can not be interpolated', OLOCAL = .TRUE. )
+ PB(:) = XUNDEF
+ END IF
+
+ END FUNCTION INTERP_HOR_FROM_MASSPOINT_1D
+
+
+ ! #############################################################
+ FUNCTION INTERP_HOR_FROM_UPOINT_1D( TPSENSOR, PA ) RESULT( PB )
+ ! #############################################################
+ USE MODD_CONF, ONLY: L1D
+
+ USE MODE_MSG
+
+ IMPLICIT NONE
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
+ REAL, DIMENSION( SIZE( PA, 3 ) ) :: PB
+
+ INTEGER :: JI, JJ
+
+ IF ( SIZE( PA, 1 ) == 2 ) THEN
+ JI = 1
+ JJ = 1
+ ELSE IF ( L1D ) THEN
+ JI = 2
+ JJ = 2
+ ELSE
+ JI = TPSENSOR%NI_U
+ JJ = TPSENSOR%NJ_M
+ END IF
+
+ IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
+ .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) ) THEN
+ PB(:) = (1.-TPSENSOR%XXUCOEF) * (1.-TPSENSOR%XYMCOEF) * PA(JI, JJ, :) + &
+ ( TPSENSOR%XXUCOEF) * (1.-TPSENSOR%XYMCOEF) * PA(JI+1, JJ, :) + &
+ (1.-TPSENSOR%XXUCOEF) * ( TPSENSOR%XYMCOEF) * PA(JI, JJ+1, :) + &
+ ( TPSENSOR%XXUCOEF) * ( TPSENSOR%XYMCOEF) * PA(JI+1, JJ+1, :)
+ ELSE
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Interp_hor_from_upoint', 'value can not be interpolated', OLOCAL = .TRUE. )
+ PB(:) = XUNDEF
+ END IF
+
+ END FUNCTION INTERP_HOR_FROM_UPOINT_1D
+
+
+ ! #############################################################
+ FUNCTION INTERP_HOR_FROM_VPOINT_1D( TPSENSOR, PA ) RESULT( PB )
+ ! #############################################################
+ USE MODD_CONF, ONLY: L1D
+
+ USE MODE_MSG
+
+ IMPLICIT NONE
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
+ REAL, DIMENSION( SIZE( PA, 3 ) ) :: PB
+
+ INTEGER :: JI, JJ
+
+ IF ( SIZE( PA, 1 ) == 2 ) THEN
+ JI = 1
+ JJ = 1
+ ELSE IF ( L1D ) THEN
+ JI = 2
+ JJ = 2
+ ELSE
+ JI = TPSENSOR%NI_M
+ JJ = TPSENSOR%NJ_V
+ END IF
+ IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
+ .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) ) THEN
+ PB(:) = (1.-TPSENSOR%XXMCOEF) * (1.-TPSENSOR%XYVCOEF) * PA(JI, JJ, :) + &
+ ( TPSENSOR%XXMCOEF) * (1.-TPSENSOR%XYVCOEF) * PA(JI+1, JJ, :) + &
+ (1.-TPSENSOR%XXMCOEF) * ( TPSENSOR%XYVCOEF) * PA(JI, JJ+1, :) + &
+ ( TPSENSOR%XXMCOEF) * ( TPSENSOR%XYVCOEF) * PA(JI+1, JJ+1, :)
+ ELSE
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Interp_hor_from_vpoint', 'value can not be interpolated', OLOCAL = .TRUE. )
+ PB(:) = XUNDEF
+ END IF
+
+ END FUNCTION INTERP_HOR_FROM_VPOINT_1D
+
+ ! ######################################################################
+ FUNCTION BUFFER_SIZE_COMPUTE( TPSENSOR, KSTORE_CURRENT ) RESULT( KSIZE )
+ ! ######################################################################
+
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_CURRENT ! Current number of stored instants
+ INTEGER :: KSIZE
+
+ INTEGER :: ISTORES
+
+ IF ( PRESENT( KSTORE_CURRENT ) ) THEN
+ ISTORES = KSTORE_CURRENT
+ IF ( ISTORES > TPSENSOR%NSTORE_MAX ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Buffer_size_compute', 'sensor: ' // TRIM(TPSENSOR%CNAME) &
+ // ': kstore_current>nstore_max', OLOCAL = .TRUE. )
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+ ELSE
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+
+ KSIZE = TPSENSOR%NBUFFER_FIXSIZE + ISTORES * TPSENSOR%NBUFFER_VARSIZE
+
+ END FUNCTION BUFFER_SIZE_COMPUTE
+
+
+ ! ######################################################################
+ SUBROUTINE BUFFER_PACK_SENSOR( TPSENSOR, PBUFFER, KPOS, KSTORE_CURRENT )
+ ! ######################################################################
+
+ USE MODD_CONF_N, ONLY: NRR
+ USE MODD_DIM_N, ONLY: NKMAX
+ USE MODD_NSV, ONLY: NSV
+ USE MODD_PARAMETERS, ONLY: JPVEXT
+ USE MODD_PARAM_N, ONLY: CCLOUD, CRAD, CTURB
+
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(INOUT) :: PBUFFER ! Buffer to pack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_CURRENT ! Current number of stored instants
+
+ INTEGER :: IKU ! number of vertical levels for profile
+ INTEGER :: ILEVELS
+ INTEGER :: ISTORES
+ INTEGER :: ILVST ! =ilevels*istores
+ INTEGER :: JI
+
+ IKU = NKMAX + 2 * JPVEXT
+ ILEVELS = SIZE( TPSENSOR%XZON, 1 )
+
+ IF ( PRESENT( KSTORE_CURRENT ) ) THEN
+ ISTORES = KSTORE_CURRENT
+ IF ( ISTORES > TPSENSOR%NSTORE_MAX ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Buffer_pack_sensor', 'sensor: ' // TRIM(TPSENSOR%CNAME) &
+ // ': kstore_current>nstore_max', OLOCAL = .TRUE. )
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+ ELSE
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+
+ IF ( KPOS /= 1 ) &
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'Buffer_pack_sensor', 'sensor: ' // TRIM(TPSENSOR%CNAME) &
+ // ': initial position of buffer not at its beginning', OLOCAL = .TRUE. )
+
+ ILVST = ILEVELS * ISTORES
+
+ ! Convert title characters to integers
+ DO JI = 1, LEN( TPSENSOR%CNAME )
+ PBUFFER(KPOS) = ICHAR( TPSENSOR%CNAME(JI:JI) )
+ KPOS = KPOS + 1
+ END DO
+
+ DO JI = 1, LEN( TPSENSOR%CTYPE )
+ PBUFFER(KPOS) = ICHAR( TPSENSOR%CTYPE(JI:JI) )
+ KPOS = KPOS + 1
+ END DO
+
+ PBUFFER(KPOS) = TPSENSOR%NID ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NSTORE_CUR ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NSTORE_MAX ; KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%NBUFFER_FIXSIZE ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NBUFFER_VARSIZE ; KPOS = KPOS + 1
+
+ IF ( TPSENSOR%LFIX ) THEN
+ PBUFFER(KPOS) = 1.D0
+ ELSE
+ PBUFFER(KPOS) = 0.D0
+ END IF
+ KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%XX_CUR ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XY_CUR ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XZ_CUR ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XLAT_CUR ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XLON_CUR ; KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%NI_M ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NJ_M ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NI_U ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NJ_V ; KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%NK00 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NK01 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NK10 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NK11 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NU00 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NU01 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NU10 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NU11 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NV00 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NV01 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NV10 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%NV11 ; KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%XXMCOEF ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XYMCOEF ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XXUCOEF ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XYVCOEF ; KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%XZCOEF00 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XZCOEF01 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XZCOEF10 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XZCOEF11 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XUCOEF00 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XUCOEF01 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XUCOEF10 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XUCOEF11 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XVCOEF00 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XVCOEF01 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XVCOEF10 ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XVCOEF11 ; KPOS = KPOS + 1
+
+ PBUFFER(KPOS:KPOS+ILVST-1) = RESHAPE( TPSENSOR%XZON(:,1:ISTORES), [ILVST] ) ; KPOS = KPOS + ILVST
+ PBUFFER(KPOS:KPOS+ILVST-1) = RESHAPE( TPSENSOR%XMER(:,1:ISTORES), [ILVST] ) ; KPOS = KPOS + ILVST
+ PBUFFER(KPOS:KPOS+ILVST-1) = RESHAPE( TPSENSOR%XW (:,1:ISTORES), [ILVST] ) ; KPOS = KPOS + ILVST
+ PBUFFER(KPOS:KPOS+ILVST-1) = RESHAPE( TPSENSOR%XP (:,1:ISTORES), [ILVST] ) ; KPOS = KPOS + ILVST
+ IF ( CTURB == 'TKEL') THEN
+ PBUFFER(KPOS:KPOS+ILVST-1) = RESHAPE( TPSENSOR%XTKE(:,1:ISTORES), [ILVST] ) ; KPOS = KPOS + ILVST
+ END IF
+ PBUFFER(KPOS:KPOS+ILVST-1) = RESHAPE( TPSENSOR%XTH(:,1:ISTORES), [ILVST] ) ; KPOS = KPOS + ILVST
+ PBUFFER(KPOS:KPOS+ILVST*NRR-1) = RESHAPE( TPSENSOR%XR (:,1:ISTORES,:), [ILVST*NRR] ) ; KPOS = KPOS + ILVST * NRR
+ PBUFFER(KPOS:KPOS+ILVST*NSV-1) = RESHAPE( TPSENSOR%XSV(:,1:ISTORES,:), [ILVST*NSV] ) ; KPOS = KPOS + ILVST * NSV
+ IF ( CRAD /= 'NONE' ) THEN
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XTSRAD(1:ISTORES) ; KPOS = KPOS + ISTORES
+ END IF
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XRHOD_SENSOR(1:ISTORES) ; KPOS = KPOS + ISTORES
+
+ IF ( SIZE( TPSENSOR%XRHOD ) > 0 ) THEN
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XRHOD (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ IF ( CCLOUD(1:3) == 'ICE') THEN
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XCIZ (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ END IF
+ IF ( CCLOUD == 'LIMA') THEN
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XCIZ (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XCCZ (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XCRZ (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ END IF
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XIWCZ (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XLWCZ (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XCRARE (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XCRARE_ATT(:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ END IF
+
+ END SUBROUTINE BUFFER_PACK_SENSOR
+
+
+ ! ################################################################
+ SUBROUTINE BUFFER_UNPACK_SENSOR( TPSENSOR, PBUFFER, KPOS, KSTORE )
+ ! ################################################################
+
+ USE MODD_CONF_N, ONLY: NRR
+ USE MODD_DIM_N, ONLY: NKMAX
+ USE MODD_NSV, ONLY: NSV
+ USE MODD_PARAMETERS, ONLY: JPVEXT
+ USE MODD_PARAM_N, ONLY: CCLOUD, CRAD, CTURB
+
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(IN) :: PBUFFER ! Buffer to unpack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, INTENT(IN) :: KSTORE ! Current number of stored instants
+
+ INTEGER :: IKU ! number of vertical levels for profile
+ INTEGER :: ILEVELS
+ INTEGER :: ILVST ! =ilevels*kstore_cur
+ INTEGER :: JI
+
+ IKU = NKMAX + 2 * JPVEXT
+ ILEVELS = SIZE( TPSENSOR%XZON, 1 )
+ ILVST = ILEVELS * KSTORE
+
+ ! Convert integers to characters for title
+ DO JI = 1, LEN( TPSENSOR%CNAME )
+ TPSENSOR%CNAME(JI:JI) = ACHAR( NINT( PBUFFER(KPOS) ) )
+ KPOS = KPOS + 1
+ END DO
+
+ DO JI = 1, LEN( TPSENSOR%CTYPE )
+ TPSENSOR%CTYPE(JI:JI) = ACHAR( NINT( PBUFFER(KPOS) ) )
+ KPOS = KPOS + 1
+ END DO
+
+ TPSENSOR%NID = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NSTORE_CUR = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NSTORE_MAX = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+
+ TPSENSOR%NBUFFER_FIXSIZE = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NBUFFER_VARSIZE = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+
+ IF ( NINT( PBUFFER(KPOS) ) == 0 ) THEN
+ TPSENSOR%LFIX = .FALSE.
+ ELSE
+ TPSENSOR%LFIX = .TRUE.
+ END IF
+ KPOS = KPOS + 1
+
+ TPSENSOR%XX_CUR = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XY_CUR = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XZ_CUR = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XLAT_CUR = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XLON_CUR = PBUFFER(KPOS) ; KPOS = KPOS + 1
+
+ TPSENSOR%NI_M = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NJ_M = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NI_U = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NJ_V = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+
+ TPSENSOR%NK00 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NK01 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NK10 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NK11 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NU00 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NU01 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NU10 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NU11 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NV00 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NV01 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NV10 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+ TPSENSOR%NV11 = NINT( PBUFFER(KPOS) ) ; KPOS = KPOS + 1
+
+ TPSENSOR%XXMCOEF = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XYMCOEF = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XXUCOEF = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XYVCOEF = PBUFFER(KPOS) ; KPOS = KPOS + 1
+
+ TPSENSOR%XZCOEF00 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XZCOEF01 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XZCOEF10 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XZCOEF11 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XUCOEF00 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XUCOEF01 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XUCOEF10 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XUCOEF11 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XVCOEF00 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XVCOEF01 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XVCOEF10 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XVCOEF11 = PBUFFER(KPOS) ; KPOS = KPOS + 1
+
+ TPSENSOR%XZON(:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+ILVST-1), [ ILEVELS, KSTORE ] ) ; KPOS = KPOS + ILVST
+ TPSENSOR%XMER(:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+ILVST-1), [ ILEVELS, KSTORE ] ) ; KPOS = KPOS + ILVST
+ TPSENSOR%XW (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+ILVST-1), [ ILEVELS, KSTORE ] ) ; KPOS = KPOS + ILVST
+ TPSENSOR%XP (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+ILVST-1), [ ILEVELS, KSTORE ] ) ; KPOS = KPOS + ILVST
+ IF ( CTURB == 'TKEL') THEN
+ TPSENSOR%XTKE(:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+ILVST-1), [ ILEVELS, KSTORE ] ) ; KPOS = KPOS + ILVST
+ END IF
+ TPSENSOR%XTH(:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+ILVST-1), [ ILEVELS, KSTORE ] ) ; KPOS = KPOS + ILVST
+ TPSENSOR%XR (:,1:KSTORE,:) = RESHAPE( PBUFFER(KPOS:KPOS+ILVST*NRR-1), [ ILEVELS, KSTORE, NRR ] ) ; KPOS = KPOS + ILVST * NRR
+ TPSENSOR%XSV(:,1:KSTORE,:) = RESHAPE( PBUFFER(KPOS:KPOS+ILVST*NSV-1), [ ILEVELS, KSTORE, NSV ] ) ; KPOS = KPOS + ILVST * NSV
+ IF ( CRAD /= 'NONE' ) THEN
+ TPSENSOR%XTSRAD(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ END IF
+ TPSENSOR%XRHOD_SENSOR(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+
+ IF ( SIZE( TPSENSOR%XRHOD ) > 0 ) THEN
+ TPSENSOR%XRHOD (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ IF ( CCLOUD(1:3) == 'ICE' ) THEN
+ TPSENSOR%XCIZ (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ END IF
+ IF ( CCLOUD == 'LIMA' ) THEN
+ TPSENSOR%XCIZ (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ TPSENSOR%XCCZ (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ TPSENSOR%XCRZ (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ END IF
+ TPSENSOR%XIWCZ (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ TPSENSOR%XLWCZ (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ TPSENSOR%XCRARE (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ TPSENSOR%XCRARE_ATT(:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ END IF
+
+ END SUBROUTINE BUFFER_UNPACK_SENSOR
+
+
+ ! #################################################################
+ SUBROUTINE BUFFER_SIZE_SEND( TPSENSOR, KSTORE_CUR, KPACKSIZE, KTO )
+ ! #################################################################
+
+ !Workaround problem with Intel MPI module (do not use only for MPI subroutines)
+ ! use modd_mpif, only: MPI_SEND
+ USE MODD_MPIF
+ USE MODD_PRECISION, ONLY: MNHINT_MPI
+ USE MODD_VAR_LL, ONLY: NMNH_COMM_WORLD
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ INTEGER, INTENT(IN) :: KSTORE_CUR
+ INTEGER, INTENT(IN) :: KPACKSIZE
+ INTEGER, INTENT(IN) :: KTO ! Process to which to send sensor data
+
+ INTEGER :: IERR
+ INTEGER, DIMENSION(3) :: ISTORES
+
+ ISTORES(1) = KSTORE_CUR ! Number of currently used store-positions
+ ISTORES(2) = TPSENSOR%NSTORE_MAX ! Total number of store positions
+ ISTORES(3) = KPACKSIZE ! Total size of the buffer
+
+ CALL MPI_SEND( ISTORES, 3, MNHINT_MPI, KTO-1, NTAG_NCUR, NMNH_COMM_WORLD, IERR )
+
+ END SUBROUTINE BUFFER_SIZE_SEND
+
+
+ ! ###############################################################################
+ SUBROUTINE BUFFER_SIZE_RECV( TPSENSOR, KSTORE_CUR, KSTORE_TOT, KPACKSIZE, KFROM )
+ ! ###############################################################################
+
+ !Workaround problem with Intel MPI module (do not use only for MPI subroutines)
+ ! USE MODD_MPIF, ONLY: MPI_RECV, MPI_STATUS_IGNORE
+ USE MODD_MPIF
+ USE MODD_PRECISION, ONLY: MNHINT_MPI
+ USE MODD_VAR_LL, ONLY: NMNH_COMM_WORLD
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ INTEGER, INTENT(OUT) :: KSTORE_CUR
+ INTEGER, INTENT(OUT) :: KSTORE_TOT
+ INTEGER, INTENT(OUT) :: KPACKSIZE
+ INTEGER, INTENT(IN) :: KFROM ! Process from which to receive sensor data
+
+ INTEGER :: IERR
+ INTEGER, DIMENSION(3) :: ISTORES
+
+ CALL MPI_RECV( ISTORES, 3, MNHINT_MPI, KFROM-1, NTAG_NCUR, NMNH_COMM_WORLD, MPI_STATUS_IGNORE, IERR )
+
+ KSTORE_CUR = ISTORES(1)
+ KSTORE_TOT = ISTORES(2)
+ KPACKSIZE = ISTORES(3)
+
+ END SUBROUTINE BUFFER_SIZE_RECV
+
+
+ ! ##############################################
+ SUBROUTINE BUFFER_SEND( TPSENSOR, PBUFFER, KTO )
+ ! ##############################################
+
+ !Workaround problem with Intel MPI module (do not use only for MPI subroutines)
+ ! USE MODD_MPIF, ONLY: MPI_SEND
+ USE MODD_MPIF
+ USE MODD_PRECISION, ONLY: MNHREAL_MPI
+ USE MODD_VAR_LL, ONLY: NMNH_COMM_WORLD
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(IN) :: PBUFFER
+ INTEGER, INTENT(IN) :: KTO ! Process to which to send buffer
+
+ INTEGER :: IERR
+
+ ! Send packed data
+ CALL MPI_SEND( PBUFFER, SIZE( PBUFFER ), MNHREAL_MPI, KTO-1, NTAG_PACK, NMNH_COMM_WORLD, IERR )
+
+ END SUBROUTINE BUFFER_SEND
+
+
+ ! ################################################
+ SUBROUTINE BUFFER_RECV( TPSENSOR, PBUFFER, KFROM )
+ ! ################################################
+
+ !Workaround problem with Intel MPI module (do not use only for MPI subroutines)
+ ! USE MODD_MPIF, ONLY: MPI_RECV, MPI_STATUS_IGNORE
+ USE MODD_MPIF
+ USE MODD_PRECISION, ONLY: MNHREAL_MPI
+ USE MODD_VAR_LL, ONLY: NMNH_COMM_WORLD
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(OUT) :: PBUFFER
+ INTEGER, INTENT(IN) :: KFROM ! Process from which to receive buffer
+
+ INTEGER :: IERR
+
+ ! Receive packed data
+ CALL MPI_RECV( PBUFFER, SIZE( PBUFFER ), MNHREAL_MPI, KFROM-1, NTAG_PACK, NMNH_COMM_WORLD, MPI_STATUS_IGNORE, IERR )
+
+ END SUBROUTINE BUFFER_RECV
+
+ ! ##############################################################################
+ SUBROUTINE SENSOR_COMM_SEND( TPSENSOR, KTO, OSEND_SIZE_TO_RECEIVER, OEMPTYSEND )
+ ! ##############################################################################
+
+ USE MODD_IO, ONLY: ISP
+
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+ INTEGER, INTENT(IN) :: KTO ! Process to which to send data
+ LOGICAL, OPTIONAL, INTENT(IN) :: OSEND_SIZE_TO_RECEIVER ! If the buffer size has to be send to the receiver
+ LOGICAL, OPTIONAL, INTENT(IN) :: OEMPTYSEND ! True if the sensor data has not to be sent
+
+ CHARACTER(LEN=10) :: YFROM, YTO
+ INTEGER :: IPACKSIZE
+ INTEGER :: IPOS
+ LOGICAL :: GEMPTYSEND
+ LOGICAL :: GSEND_SIZE_TO_RECEIVER
+ REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! buffer to store raw data of the sensor
+
+ WRITE( YFROM, '( i10 )' ) ISP
+ WRITE( YTO, '( i10 )' ) KTO
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Sensor_comm_send', &
+ 'send sensor ' // TRIM(TPSENSOR%CNAME) // ': ' // TRIM(YFROM) // '->' // TRIM(YTO), OLOCAL = .TRUE. )
+
+ IF ( PRESENT( OEMPTYSEND ) ) THEN
+ GEMPTYSEND = OEMPTYSEND
+ ELSE
+ GEMPTYSEND = .FALSE.
+ END IF
+
+ IF ( PRESENT( OSEND_SIZE_TO_RECEIVER ) ) THEN
+ GSEND_SIZE_TO_RECEIVER = OSEND_SIZE_TO_RECEIVER
+ ELSE
+ GSEND_SIZE_TO_RECEIVER = .FALSE.
+ END IF
+
+ IF ( GEMPTYSEND .AND. .NOT.GSEND_SIZE_TO_RECEIVER ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_send', &
+ 'incompatible options: gemptysend=T and gsend_size_to_receiver=F', OLOCAL = .TRUE. )
+
+ IF ( GEMPTYSEND ) THEN
+ ! If 'empty send', ipacksize is set to NEMPTYDATA
+ ! This will allow the receiver to know that no sensor data will be sent
+ IPACKSIZE = NEMPTYDATA
+ ELSE
+ IPACKSIZE = TPSENSOR%BUFFER_SIZE_COMPUTE( TPSENSOR%NSTORE_CUR )
+ END IF
+
+ IF ( GSEND_SIZE_TO_RECEIVER ) CALL TPSENSOR%BUFFER_SIZE_SEND( TPSENSOR%NSTORE_CUR, IPACKSIZE, KTO )
+
+ IF ( .NOT. GEMPTYSEND ) THEN
+ ALLOCATE( ZPACK(IPACKSIZE) )
+
+ IPOS = 1
+ CALL TPSENSOR%BUFFER_PACK( ZPACK, IPOS, TPSENSOR%NSTORE_CUR )
+
+ IF ( IPOS-1 /= IPACKSIZE ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_send', 'IPOS-1 /= IPACKSIZE', OLOCAL = .TRUE. )
+
+ CALL TPSENSOR%BUFFER_SEND( ZPACK, KTO )
+
+ DEALLOCATE( ZPACK )
+ END IF
+
+ END SUBROUTINE SENSOR_COMM_SEND
+
+ ! #############################################################################
+ SUBROUTINE SENSOR_COMM_SEND_DEALLOCATE( TPSENSOR, KTO, OSEND_SIZE_TO_RECEIVER )
+ ! #############################################################################
+
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+ INTEGER, INTENT(IN) :: KTO ! Process to which to send data
+ LOGICAL, OPTIONAL, INTENT(IN) :: OSEND_SIZE_TO_RECEIVER ! If the buffer size has to be send to the receiver
+
+ CALL SENSOR_COMM_SEND( TPSENSOR, KTO, OSEND_SIZE_TO_RECEIVER )
+
+ ! Deallocate sensor data once not needed anymore
+ IF ( TPSENSOR%NSTORE_MAX >= 0 ) CALL TPSENSOR%DATA_ARRAYS_DEALLOCATE( )
+
+ END SUBROUTINE SENSOR_COMM_SEND_DEALLOCATE
+
+ ! ################################################################################################################
+ SUBROUTINE SENSOR_COMM_RECV_ALLOCATE( TPSENSOR, KFROM, KSTORE_CUR, KSTORE_MAX, ORECV_SIZE_FROM_OWNER, OEMPTYRECV )
+ ! ################################################################################################################
+
+ USE MODD_IO, ONLY: ISP
+
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+ INTEGER, INTENT(IN) :: KFROM ! Process from which to receive data
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_CUR ! Number of storage steps to receive
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_MAX ! Maximum number of storage steps to store in sensor
+ ! (if not provided, kstore_* size must be given by the sender)
+ LOGICAL, OPTIONAL, INTENT(IN) :: ORECV_SIZE_FROM_OWNER ! If the buffer size has to be send to the receiver
+ LOGICAL, OPTIONAL, INTENT(OUT) :: OEMPTYRECV ! True if the sensor data has not been received
+
+ CHARACTER(LEN=10) :: YFROM, YTO
+ INTEGER :: IPACKSIZE
+ INTEGER :: IPOS
+ INTEGER :: ISTORE_CUR
+ INTEGER :: ISTORE_MAX
+ LOGICAL :: GEMPTYRECV
+ LOGICAL :: GRECV_SIZE_FROM_OWNER
+ REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! buffer to store raw data of the sensor
+
+ WRITE( YFROM, '( i10 )' ) KFROM
+ WRITE( YTO, '( i10 )' ) ISP
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'receive sensor (name not yet known): ' // TRIM(YFROM) // '->' // TRIM(YTO), OLOCAL = .TRUE. )
+
+ GEMPTYRECV = .FALSE.
+
+ IF ( PRESENT( ORECV_SIZE_FROM_OWNER ) ) THEN
+ GRECV_SIZE_FROM_OWNER = ORECV_SIZE_FROM_OWNER
+ ELSE
+ GRECV_SIZE_FROM_OWNER = .FALSE.
+ END IF
+
+ IF ( PRESENT( KSTORE_CUR ) ) THEN
+ IF ( GRECV_SIZE_FROM_OWNER ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'kstore_cur may not be provided if size is received from owner', OLOCAL = .TRUE. )
+ ISTORE_CUR = KSTORE_CUR
+ ELSE
+ IF ( .NOT. GRECV_SIZE_FROM_OWNER ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'kstore_cur must be provided if size is not received from owner', OLOCAL = .TRUE. )
+ ! istore_cur will be received from owner
+ ISTORE_CUR = 0
+ END IF
+
+ IF ( PRESENT( KSTORE_MAX ) ) THEN
+ IF ( GRECV_SIZE_FROM_OWNER ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'kstore_max may not be provided if size is received from owner', OLOCAL = .TRUE. )
+ ISTORE_MAX = KSTORE_MAX
+ ELSE
+ IF ( .NOT. GRECV_SIZE_FROM_OWNER ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'kstore_max must be provided if size is not received from owner', OLOCAL = .TRUE. )
+
+ ! istore_max will be received from owner
+ ISTORE_MAX = 0
+ END IF
+
+ IF ( GRECV_SIZE_FROM_OWNER ) THEN
+ CALL TPSENSOR%BUFFER_SIZE_RECV( ISTORE_CUR, ISTORE_MAX, IPACKSIZE, KFROM )
+ ELSE
+ IPACKSIZE = TPSENSOR%BUFFER_SIZE_COMPUTE( ISTORE_CUR )
+ END IF
+
+ IF ( IPACKSIZE == NEMPTYDATA ) THEN
+ GEMPTYRECV = .TRUE.
+ !call Print_msg( NVERB_DEBUG, 'GEN', 'Sensor_comm_recv_allocate', 'empty receive', olocal = .true. )
+ IF ( .NOT. PRESENT( OEMPTYRECV) ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'optional dummy argument oemptyrecv must be provided in case of empty communication', OLOCAL = .TRUE. )
+ ELSE
+ ! Allocate receive buffer
+ ALLOCATE( ZPACK(IPACKSIZE) )
+
+ ! Allocation of sensor must be done only once the total number of stores is known (and only if not yet allocated)
+ IF (TPSENSOR%NSTORE_MAX < 0 ) CALL TPSENSOR%DATA_ARRAYS_ALLOCATE( ISTORE_MAX )
+
+ CALL TPSENSOR%BUFFER_RECV( ZPACK, KFROM )
+
+ IPOS = 1
+ CALL TPSENSOR%BUFFER_UNPACK( ZPACK, IPOS, ISTORE_CUR )
+
+ IF ( IPOS-1 /= IPACKSIZE ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', 'IPOS-1 /= IPACKSIZE', OLOCAL = .TRUE. )
+ END IF
+
+ IF ( PRESENT( OEMPTYRECV) ) OEMPTYRECV = GEMPTYRECV
+
+ END SUBROUTINE SENSOR_COMM_RECV_ALLOCATE
+
+END MODULE MODD_SENSOR
diff --git a/src/MNH/modd_stationn.f90 b/src/MNH/modd_stationn.f90
index 406d14909bec8ed563486f0ec51262b8f52ead70..63d8aac039185fc3ff61ee681e1885d6fadd8dad 100644
--- a/src/MNH/modd_stationn.f90
+++ b/src/MNH/modd_stationn.f90
@@ -37,7 +37,8 @@
!
!
USE MODD_PARAMETERS, ONLY: JPMODELMAX
-USE MODD_TYPE_STATPROF, ONLY: TSTATIONDATA, TSTATPROFTIME
+USE MODD_TYPE_STATPROF, ONLY: TSTATIONDATA
+USE MODD_SENSOR, ONLY: TSENSORTIME
IMPLICIT NONE
@@ -54,7 +55,7 @@ TYPE STATION_t
LOGICAL :: LSTATION ! flag to use stations
INTEGER :: NUMBSTAT_LOC = 0 ! number of stations on this process
!
- TYPE(TSTATPROFTIME) :: TSTATIONS_TIME
+ TYPE(TSENSORTIME) :: TSTATIONS_TIME
TYPE(TSTATIONDATA), DIMENSION(:), POINTER :: TSTATIONS ! characteristics and records of the stations
!
END TYPE STATION_t
@@ -63,7 +64,7 @@ TYPE(STATION_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: STATION_MODEL
LOGICAL, POINTER :: LSTATION=>NULL()
INTEGER, POINTER :: NUMBSTAT_LOC=>NULL()
-TYPE(TSTATPROFTIME), POINTER :: TSTATIONS_TIME => NULL()
+TYPE(TSENSORTIME), POINTER :: TSTATIONS_TIME => NULL()
TYPE(TSTATIONDATA), DIMENSION(:), POINTER :: TSTATIONS => NULL()
CONTAINS
diff --git a/src/MNH/modd_type_statprof.f90 b/src/MNH/modd_type_statprof.f90
index c113913dea706432d942f5f630cc7fd9e4327796..0e7b81bb08c323592b33882e5df07a13315d8072 100644
--- a/src/MNH/modd_type_statprof.f90
+++ b/src/MNH/modd_type_statprof.f90
@@ -36,47 +36,20 @@
!* 0. DECLARATIONS
! ------------
!
-use modd_type_date, only: date_time
-use modd_parameters, only: NNEGUNDEF, NSTATPROFNAMELGTMAX, XUNDEF
+use modd_parameters, only: NNEGUNDEF, NSENSORNAMELGTMAX, XUNDEF
+use modd_sensor, only: tsensor
+use modd_type_date, only: date_time
implicit none
private
-public :: TSTATPROFTIME
public :: TPROFILERDATA, TSTATIONDATA, TSTATPROFDATA
-TYPE :: TSTATPROFTIME
- INTEGER :: N_CUR = 0 ! current step of storage
- REAL :: XTSTEP = 60. ! storage time step (default reset later by INI_STATION_n)
- type(date_time), dimension(:), ALLOCATABLE :: tpdates ! dates(n) (n: recording instants)
-END TYPE TSTATPROFTIME
-
-TYPE :: TSTATPROFDATA
+TYPE, EXTENDS(TSENSOR), ABSTRACT :: TSTATPROFDATA
! Type to store data common to stations and profilers
! It is used as a basis for the TSTATIONDATA and TPROFILERDATA
! and for common procedures for these 2 types
- CHARACTER(LEN=NSTATPROFNAMELGTMAX) :: CNAME = '' ! Station/profiler name
-
- INTEGER :: NID = 0 ! Global identification number of the station/profiler (from 1 to total number)
-
- REAL :: XX = XUNDEF ! X(n)
- REAL :: XY = XUNDEF ! Y(n)
- REAL :: XZ = XUNDEF ! Z(n)
- REAL :: XLON = XUNDEF ! longitude(n)
- REAL :: XLAT = XUNDEF ! latitude (n)
-
- ! Position in the mesh
- INTEGER :: NI_M = NNEGUNDEF ! X position for mass-point axis (between this one and the next one)
- INTEGER :: NJ_M = NNEGUNDEF ! Y position for mass-point axis (between this one and the next one)
- INTEGER :: NI_U = NNEGUNDEF ! X position for u-point axis (between this one and the next one)
- INTEGER :: NJ_V = NNEGUNDEF ! Y position for v-point axis (between this one and the next one)
-
- ! Coefficient to interpolate values (stations are usually not exactly on mesh points)
- REAL :: XXMCOEF = XUNDEF ! Interpolation coefficient for X (mass-point)
- REAL :: XYMCOEF = XUNDEF ! Interpolation coefficient for Y (mass-point)
- REAL :: XXUCOEF = XUNDEF ! Interpolation coefficient for X (U-point)
- REAL :: XYVCOEF = XUNDEF ! Interpolation coefficient for Y (V-point)
! Dimension corresponds to recording instants
REAL, DIMENSION(:), ALLOCATABLE :: XT2M ! 2 m air temperature (C)
@@ -98,6 +71,15 @@ TYPE :: TSTATPROFDATA
REAL, DIMENSION(:), ALLOCATABLE :: XDSTAOD ! Dust Aerosol Optical Depth (m)
REAL, DIMENSION(:), ALLOCATABLE :: XSLTAOD ! Salt Aerosol Optical Depth (m)
REAL, DIMENSION(:), ALLOCATABLE :: XSFCO2 ! CO2 surface flux (mg/m2/s)
+
+ CONTAINS
+ ! Remark: DATA_ARRAYS_(DE)ALLOCATE_STATPROF do not point to DATA_ARRAYS_(DE)ALLOCATE to allow other dummy arguments
+ PROCEDURE :: BUFFER_PACK => BUFFER_PACK_STATPROF
+ PROCEDURE :: BUFFER_UNPACK => BUFFER_UNPACK_STATPROF
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_ALLOCATE_STATPROF
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_DEALLOCATE_STATPROF
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_PACK_STATPROF
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_UNPACK_STATPROF
END TYPE
TYPE, EXTENDS( TSTATPROFDATA ) :: TSTATIONDATA
@@ -107,43 +89,27 @@ TYPE, EXTENDS( TSTATPROFDATA ) :: TSTATIONDATA
REAL :: XZS = XUNDEF ! zs(n)
REAL :: XZMEAS = XUNDEF ! interpolated altitude used for measurements
- ! (n: recording instants)
- REAL, DIMENSION(:), ALLOCATABLE :: XZON ! zonal wind(n)
- REAL, DIMENSION(:), ALLOCATABLE :: XMER ! meridian wind(n)
- REAL, DIMENSION(:), ALLOCATABLE :: XW ! w(n) (air vertical speed)
- REAL, DIMENSION(:), ALLOCATABLE :: XP ! p(n)
- REAL, DIMENSION(:), ALLOCATABLE :: XTKE ! tke(n)
- REAL, DIMENSION(:), ALLOCATABLE :: XTH ! th(n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XR ! r*(n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XSV ! Sv*(n)
- REAL, DIMENSION(:), ALLOCATABLE :: XTSRAD ! Ts(n)
-END TYPE TSTATIONDATA
+ CONTAINS
+ PROCEDURE :: DATA_ARRAYS_ALLOCATE => DATA_ARRAYS_ALLOCATE_STATION
+ PROCEDURE :: DATA_ARRAYS_DEALLOCATE => DATA_ARRAYS_DEALLOCATE_STATION
+ PROCEDURE :: BUFFER_PACK => BUFFER_PACK_STATION
+ PROCEDURE :: BUFFER_UNPACK => BUFFER_UNPACK_STATION
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_ALLOCATE_STATION
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_DEALLOCATE_STATION
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_PACK_STATION
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_UNPACK_STATION
+ END TYPE TSTATIONDATA
TYPE, EXTENDS( TSTATPROFDATA ) :: TPROFILERDATA
! Type to store all the data of 1 profiler
- CHARACTER(LEN=NSTATPROFNAMELGTMAX) :: CTYPE = '' ! Profiler type
! (n: recording instants)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XZON ! zonal wind(n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XMER ! meridian wind(n)
REAL, DIMENSION(:,:), ALLOCATABLE :: XFF ! wind intensity
REAL, DIMENSION(:,:), ALLOCATABLE :: XDD ! wind direction
- REAL, DIMENSION(:,:), ALLOCATABLE :: XW ! w(n) (air vertical speed)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XP ! p(n)
REAL, DIMENSION(:,:), ALLOCATABLE :: XZZ ! altitude(n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XTKE ! tke(n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XTH ! th(n)
REAL, DIMENSION(:,:), ALLOCATABLE :: XTHV ! thv(n)
REAL, DIMENSION(:,:), ALLOCATABLE :: XVISIGUL ! VISI GULTEPE(n)
REAL, DIMENSION(:,:), ALLOCATABLE :: XVISIKUN ! VISI KUNKEL(n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XCRARE ! radar reflectivity (n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XCRARE_ATT ! radar attenuated reflectivity (n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XCIZ ! Ice number concentration ICE3 (n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XLWCZ ! liquid water content (n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XIWCZ ! ice water content (n)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XRHOD ! density of dry air/moist air
- REAL, DIMENSION(:,:,:), ALLOCATABLE :: XR ! r*(n)
- REAL, DIMENSION(:,:,:), ALLOCATABLE :: XSV ! Sv*(n)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAER ! AER*(n) aerosol extinction
REAL, DIMENSION(:), ALLOCATABLE :: XIWV ! integrated water vpour(n)
@@ -152,6 +118,563 @@ TYPE, EXTENDS( TSTATPROFDATA ) :: TPROFILERDATA
REAL, DIMENSION(:), ALLOCATABLE :: XZHD ! GPS zenith hydro delay(n)
REAL, DIMENSION(:,:), ALLOCATABLE :: XTKE_DISS ! TKE dissipation rate
+
+ CONTAINS
+ PROCEDURE :: DATA_ARRAYS_ALLOCATE => DATA_ARRAYS_ALLOCATE_PROFILER
+ PROCEDURE :: DATA_ARRAYS_DEALLOCATE => DATA_ARRAYS_DEALLOCATE_PROFILER
+ PROCEDURE :: BUFFER_PACK => BUFFER_PACK_PROFILER
+ PROCEDURE :: BUFFER_UNPACK => BUFFER_UNPACK_PROFILER
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_ALLOCATE_PROFILER
+ PROCEDURE, NON_OVERRIDABLE :: DATA_ARRAYS_DEALLOCATE_PROFILER
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_PACK_PROFILER
+ PROCEDURE, NON_OVERRIDABLE :: BUFFER_UNPACK_PROFILER
END TYPE
+
+CONTAINS
+
+! #############################################################################################
+SUBROUTINE DATA_ARRAYS_ALLOCATE_STATPROF( TPSENSOR, OVERTPROF, KLEVELS, KSTORE, ODIAG_SURFRAD )
+! #############################################################################################
+
+ USE MODD_PARAMETERS, ONLY: XUNDEF
+ USE MODD_PARAM_n, ONLY: CRAD
+ USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
+
+ USE MODE_MSG
+
+ CLASS(TSTATPROFDATA), INTENT(INOUT) :: TPSENSOR
+ LOGICAL, INTENT(IN) :: OVERTPROF ! vertical profile or not
+ INTEGER, INTENT(IN) :: KLEVELS ! number of vertical levels
+ INTEGER, INTENT(IN) :: KSTORE
+ LOGICAL, INTENT(IN) :: ODIAG_SURFRAD
+
+ INTEGER :: IVARSIZE ! allocated size per store
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_allocate_statprof', 'statprof: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ CALL TPSENSOR%DATA_ARRAYS_ALLOCATE_SENSOR( OVERTPROF, KLEVELS, KSTORE )
+
+ IVARSIZE = 0
+
+ IF ( ODIAG_SURFRAD ) THEN
+ ALLOCATE( TPSENSOR%XT2M (KSTORE) )
+ ALLOCATE( TPSENSOR%XQ2M (KSTORE) )
+ ALLOCATE( TPSENSOR%XHU2M (KSTORE) )
+ ALLOCATE( TPSENSOR%XZON10M(KSTORE) )
+ ALLOCATE( TPSENSOR%XMER10M(KSTORE) )
+ ALLOCATE( TPSENSOR%XRN (KSTORE) )
+ ALLOCATE( TPSENSOR%XH (KSTORE) )
+ ALLOCATE( TPSENSOR%XLE (KSTORE) )
+ ALLOCATE( TPSENSOR%XLEI (KSTORE) )
+ ALLOCATE( TPSENSOR%XGFLUX (KSTORE) )
+ IVARSIZE = IVARSIZE + 10
+ IF ( CRAD /= 'NONE' ) THEN
+ ALLOCATE( TPSENSOR%XSWD (KSTORE) )
+ ALLOCATE( TPSENSOR%XSWU (KSTORE) )
+ ALLOCATE( TPSENSOR%XLWD (KSTORE) )
+ ALLOCATE( TPSENSOR%XLWU (KSTORE) )
+ ALLOCATE( TPSENSOR%XSWDIR (KSTORE) )
+ ALLOCATE( TPSENSOR%XSWDIFF(KSTORE) )
+ ALLOCATE( TPSENSOR%XDSTAOD(KSTORE) )
+ ALLOCATE( TPSENSOR%XSLTAOD(KSTORE) )
+ IVARSIZE = IVARSIZE + 8
+ ELSE
+ ALLOCATE( TPSENSOR%XSWD (0) )
+ ALLOCATE( TPSENSOR%XSWU (0) )
+ ALLOCATE( TPSENSOR%XLWD (0) )
+ ALLOCATE( TPSENSOR%XLWU (0) )
+ ALLOCATE( TPSENSOR%XSWDIR (0) )
+ ALLOCATE( TPSENSOR%XSWDIFF(0) )
+ ALLOCATE( TPSENSOR%XDSTAOD(0) )
+ ALLOCATE( TPSENSOR%XSLTAOD(0) )
+ END IF
+ ALLOCATE( TPSENSOR%XSFCO2 (KSTORE) )
+ IVARSIZE = IVARSIZE + 1
+ ELSE
+ ALLOCATE( TPSENSOR%XT2M (0) )
+ ALLOCATE( TPSENSOR%XQ2M (0) )
+ ALLOCATE( TPSENSOR%XHU2M (0) )
+ ALLOCATE( TPSENSOR%XZON10M(0) )
+ ALLOCATE( TPSENSOR%XMER10M(0) )
+ ALLOCATE( TPSENSOR%XRN (0) )
+ ALLOCATE( TPSENSOR%XH (0) )
+ ALLOCATE( TPSENSOR%XLE (0) )
+ ALLOCATE( TPSENSOR%XLEI (0) )
+ ALLOCATE( TPSENSOR%XGFLUX (0) )
+ ALLOCATE( TPSENSOR%XSWD (0) )
+ ALLOCATE( TPSENSOR%XSWU (0) )
+ ALLOCATE( TPSENSOR%XLWD (0) )
+ ALLOCATE( TPSENSOR%XLWU (0) )
+ ALLOCATE( TPSENSOR%XSWDIR (0) )
+ ALLOCATE( TPSENSOR%XSWDIFF(0) )
+ ALLOCATE( TPSENSOR%XDSTAOD(0) )
+ ALLOCATE( TPSENSOR%XSLTAOD(0) )
+ ALLOCATE( TPSENSOR%XSFCO2 (0) )
+ END IF
+
+ IF ( ODIAG_SURFRAD ) THEN
+ TPSENSOR%XT2M (:) = XUNDEF_SFX
+ TPSENSOR%XQ2M (:) = XUNDEF_SFX
+ TPSENSOR%XHU2M (:) = XUNDEF_SFX
+ TPSENSOR%XZON10M(:) = XUNDEF_SFX
+ TPSENSOR%XMER10M(:) = XUNDEF_SFX
+ TPSENSOR%XRN (:) = XUNDEF_SFX
+ TPSENSOR%XH (:) = XUNDEF_SFX
+ TPSENSOR%XLE (:) = XUNDEF_SFX
+ TPSENSOR%XLEI (:) = XUNDEF_SFX
+ TPSENSOR%XGFLUX (:) = XUNDEF_SFX
+ IF ( CRAD /= 'NONE' ) THEN
+ TPSENSOR%XSWD (:) = XUNDEF
+ TPSENSOR%XSWU (:) = XUNDEF
+ TPSENSOR%XLWD (:) = XUNDEF
+ TPSENSOR%XLWU (:) = XUNDEF
+ TPSENSOR%XSWDIR (:) = XUNDEF
+ TPSENSOR%XSWDIFF(:) = XUNDEF
+ TPSENSOR%XDSTAOD(:) = XUNDEF
+ TPSENSOR%XSLTAOD(:) = XUNDEF
+ END IF
+ TPSENSOR%XSFCO2(:) = XUNDEF
+ END IF
+
+ ! TPSENSOR%NBUFFER_FIXSIZE = TPSENSOR%NBUFFER_FIXSIZE +
+ TPSENSOR%NBUFFER_VARSIZE = TPSENSOR%NBUFFER_VARSIZE + IVARSIZE
+
+END SUBROUTINE DATA_ARRAYS_ALLOCATE_STATPROF
+
+
+! ####################################################
+SUBROUTINE DATA_ARRAYS_DEALLOCATE_STATPROF( TPSENSOR )
+! ####################################################
+
+ USE MODE_MSG
+
+ CLASS(TSTATPROFDATA), INTENT(INOUT) :: TPSENSOR
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_deallocate_statprof', 'statprof: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ CALL TPSENSOR%DATA_ARRAYS_DEALLOCATE_SENSOR()
+
+ DEALLOCATE( TPSENSOR%XT2M )
+ DEALLOCATE( TPSENSOR%XQ2M )
+ DEALLOCATE( TPSENSOR%XHU2M )
+ DEALLOCATE( TPSENSOR%XZON10M )
+ DEALLOCATE( TPSENSOR%XMER10M )
+ DEALLOCATE( TPSENSOR%XRN )
+ DEALLOCATE( TPSENSOR%XH )
+ DEALLOCATE( TPSENSOR%XLE )
+ DEALLOCATE( TPSENSOR%XLEI )
+ DEALLOCATE( TPSENSOR%XGFLUX )
+ DEALLOCATE( TPSENSOR%XSWD )
+ DEALLOCATE( TPSENSOR%XSWU )
+ DEALLOCATE( TPSENSOR%XLWD )
+ DEALLOCATE( TPSENSOR%XLWU )
+ DEALLOCATE( TPSENSOR%XSWDIR )
+ DEALLOCATE( TPSENSOR%XSWDIFF )
+ DEALLOCATE( TPSENSOR%XDSTAOD )
+ DEALLOCATE( TPSENSOR%XSLTAOD )
+ DEALLOCATE( TPSENSOR%XSFCO2 )
+
+END SUBROUTINE DATA_ARRAYS_DEALLOCATE_STATPROF
+
+
+! ##########################################################
+SUBROUTINE DATA_ARRAYS_ALLOCATE_PROFILER( TPSENSOR, KSTORE )
+! ##########################################################
+
+ USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
+ USE MODD_DIM_n, ONLY: NKMAX
+ USE MODD_PARAMETERS, ONLY: JPVEXT
+ USE MODD_PARAM_n, ONLY: CCLOUD
+ USE MODD_RADIATIONS_n, ONLY: NAER
+
+ USE MODE_MSG
+
+ CLASS(TPROFILERDATA), INTENT(INOUT) :: TPSENSOR
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE ! number of moments to store
+
+ INTEGER :: IKU
+ INTEGER :: IVARSIZE ! allocated size per store
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_allocate_profiler', 'profiler: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ IF ( .NOT.PRESENT( KSTORE ) ) &
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'Data_arrays_allocate_profiler', 'KSTORE not provided', OLOCAL = .TRUE. )
+
+ IKU = NKMAX + 2 * JPVEXT
+ IVARSIZE = 0
+
+ CALL DATA_ARRAYS_ALLOCATE_STATPROF( TPSENSOR, OVERTPROF = .TRUE., KLEVELS = IKU, KSTORE = KSTORE, &
+ ODIAG_SURFRAD = LDIAG_SURFRAD_PROF )
+
+ ALLOCATE( TPSENSOR%XFF (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ALLOCATE( TPSENSOR%XDD (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ALLOCATE( TPSENSOR%XZZ (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ALLOCATE( TPSENSOR%XTHV (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) THEN
+ ALLOCATE( TPSENSOR%XVISIGUL (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ELSE
+ ALLOCATE( TPSENSOR%XVISIGUL (0, 0) )
+ END IF
+ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
+ ALLOCATE( TPSENSOR%XVISIKUN (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ ELSE
+ ALLOCATE( TPSENSOR%XVISIKUN (0, 0) )
+ END IF
+ ALLOCATE( TPSENSOR%XAER (IKU, KSTORE, NAER ) ) ; IVARSIZE = IVARSIZE + IKU * NAER
+
+ ALLOCATE( TPSENSOR%XIWV(KSTORE) ) ; IVARSIZE = IVARSIZE + 1
+ ALLOCATE( TPSENSOR%XZTD(KSTORE) ) ; IVARSIZE = IVARSIZE + 1
+ ALLOCATE( TPSENSOR%XZWD(KSTORE) ) ; IVARSIZE = IVARSIZE + 1
+ ALLOCATE( TPSENSOR%XZHD(KSTORE) ) ; IVARSIZE = IVARSIZE + 1
+
+ ALLOCATE( TPSENSOR%XTKE_DISS(IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+
+ TPSENSOR%NBUFFER_FIXSIZE = TPSENSOR%NBUFFER_FIXSIZE
+ TPSENSOR%NBUFFER_VARSIZE = TPSENSOR%NBUFFER_VARSIZE + IVARSIZE
+
+ TPSENSOR%XFF (:,:) = XUNDEF
+ TPSENSOR%XDD (:,:) = XUNDEF
+ TPSENSOR%XZZ (:,:) = XUNDEF
+ TPSENSOR%XTHV (:,:) = XUNDEF
+ IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) TPSENSOR%XVISIGUL(:,:) = XUNDEF
+ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) TPSENSOR%XVISIKUN(:,:) = XUNDEF
+ TPSENSOR%XAER (:,:,:) = XUNDEF
+
+ TPSENSOR%XIWV(:) = XUNDEF
+ TPSENSOR%XZTD(:) = XUNDEF
+ TPSENSOR%XZWD(:) = XUNDEF
+ TPSENSOR%XZHD(:) = XUNDEF
+
+ TPSENSOR%XTKE_DISS(:,:) = XUNDEF
+
+ END SUBROUTINE DATA_ARRAYS_ALLOCATE_PROFILER
+
+ ! ####################################################
+ SUBROUTINE DATA_ARRAYS_DEALLOCATE_PROFILER( TPSENSOR )
+ ! ####################################################
+ USE MODE_MSG
+
+ CLASS(TPROFILERDATA), INTENT(INOUT) :: TPSENSOR
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_deallocate_profiler', 'profiler: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ CALL DATA_ARRAYS_DEALLOCATE_STATPROF( TPSENSOR )
+
+ DEALLOCATE( TPSENSOR%XFF )
+ DEALLOCATE( TPSENSOR%XDD )
+ DEALLOCATE( TPSENSOR%XZZ )
+ DEALLOCATE( TPSENSOR%XTHV )
+ DEALLOCATE( TPSENSOR%XVISIGUL )
+ DEALLOCATE( TPSENSOR%XVISIKUN )
+ DEALLOCATE( TPSENSOR%XAER )
+
+ DEALLOCATE( TPSENSOR%XIWV )
+ DEALLOCATE( TPSENSOR%XZTD )
+ DEALLOCATE( TPSENSOR%XZWD )
+ DEALLOCATE( TPSENSOR%XZHD )
+
+ DEALLOCATE( TPSENSOR%XTKE_DISS )
+
+ END SUBROUTINE DATA_ARRAYS_DEALLOCATE_PROFILER
+
+ ! #########################################################
+ SUBROUTINE DATA_ARRAYS_ALLOCATE_STATION( TPSENSOR, KSTORE )
+ ! #########################################################
+
+ USE MODD_ALLSTATION_n, ONLY: LDIAG_SURFRAD_STAT
+
+ USE MODE_MSG
+
+ CLASS(TSTATIONDATA), INTENT(INOUT) :: TPSENSOR
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE ! number of moments to store
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_allocate_station', 'station: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ IF ( .NOT.PRESENT( KSTORE ) ) &
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'Data_arrays_allocate_station', 'KSTORE not provided', OLOCAL = .TRUE. )
+
+ CALL DATA_ARRAYS_ALLOCATE_STATPROF( TPSENSOR, OVERTPROF = .FALSE., KLEVELS = 1, KSTORE = KSTORE, &
+ ODIAG_SURFRAD = LDIAG_SURFRAD_STAT )
+
+ TPSENSOR%NBUFFER_FIXSIZE = TPSENSOR%NBUFFER_FIXSIZE + 3
+ ! TPSENSOR%NBUFFER_VARSIZE = TPSENSOR%NBUFFER_VARSIZE + IVARSIZE
+
+ END SUBROUTINE DATA_ARRAYS_ALLOCATE_STATION
+
+ ! ###################################################
+ SUBROUTINE DATA_ARRAYS_DEALLOCATE_STATION( TPSENSOR )
+ ! ###################################################
+
+ USE MODE_MSG
+
+ CLASS(TSTATIONDATA), INTENT(INOUT) :: TPSENSOR
+
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Data_arrays_deallocate_station', 'station: ' // TRIM(TPSENSOR%CNAME), OLOCAL = .TRUE. )
+
+ CALL DATA_ARRAYS_DEALLOCATE_STATPROF( TPSENSOR )
+
+ END SUBROUTINE DATA_ARRAYS_DEALLOCATE_STATION
+
+ ! ########################################################################
+ SUBROUTINE BUFFER_PACK_STATPROF( TPSENSOR, PBUFFER, KPOS, KSTORE_CURRENT )
+ ! ########################################################################
+
+ USE MODD_PARAM_n, ONLY: CRAD
+
+ USE MODE_MSG
+
+ CLASS(TSTATPROFDATA), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(INOUT) :: PBUFFER ! Buffer to pack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_CURRENT ! Current number of stored instants
+
+ INTEGER :: ISTORES
+ LOGICAL :: GISALLOC
+
+ IF ( PRESENT( KSTORE_CURRENT ) ) THEN
+ ISTORES = KSTORE_CURRENT
+ IF ( ISTORES > TPSENSOR%NSTORE_MAX ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Buffer_pack_statprof', 'statprof: ' // TRIM(TPSENSOR%CNAME) &
+ // ': KSTORE_CURRENT>NSTORE_MAX', OLOCAL = .TRUE. )
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+ ELSE
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+
+ CALL TPSENSOR%BUFFER_PACK_SENSOR( PBUFFER, KPOS, ISTORES )
+
+ ! Check if the arrays are allocated with a size > 0
+ GISALLOC = ( SIZE( TPSENSOR%XT2M ) > 0 )
+
+ IF ( GISALLOC ) THEN
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XT2M ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XQ2M ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XHU2M ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XZON10M ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XMER10M ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XRN ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XH ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XLE ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XLEI ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XGFLUX ; KPOS = KPOS + ISTORES
+ IF ( CRAD /= 'NONE' ) THEN
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XSWD ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XSWU ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XLWD ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XLWU ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XSWDIR ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XSWDIFF ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XDSTAOD ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XSLTAOD ; KPOS = KPOS + ISTORES
+ END IF
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XSFCO2 ; KPOS = KPOS + ISTORES
+ END IF
+
+ END SUBROUTINE BUFFER_PACK_STATPROF
+
+
+ ! ########################################################################
+ SUBROUTINE BUFFER_PACK_PROFILER( TPSENSOR, PBUFFER, KPOS, KSTORE_CURRENT )
+ ! ########################################################################
+
+ USE MODD_DIM_n, ONLY: NKMAX
+ USE MODD_PARAMETERS, ONLY: JPVEXT
+ USE MODD_PARAM_n, ONLY: CCLOUD
+ USE MODD_RADIATIONS_n, ONLY: NAER
+
+ USE MODE_MSG
+
+ CLASS(TPROFILERDATA), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(INOUT) :: PBUFFER ! Buffer to pack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_CURRENT ! Current number of stored instants
+
+ INTEGER :: IKU ! number of vertical levels
+ INTEGER :: ISTORES
+ INTEGER :: JI
+
+ IKU = NKMAX + 2 * JPVEXT
+
+ IF ( PRESENT( KSTORE_CURRENT ) ) THEN
+ ISTORES = KSTORE_CURRENT
+ IF ( ISTORES > TPSENSOR%NSTORE_MAX ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Buffer_pack_flyer', 'flyer: ' // TRIM(TPSENSOR%CNAME) &
+ // ': KSTORE_CURRENT>NSTORE_MAX', OLOCAL = .TRUE. )
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+ ELSE
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+
+ CALL TPSENSOR%BUFFER_PACK_STATPROF( PBUFFER, KPOS, ISTORES )
+
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XFF (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XDD (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XZZ (:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XTHV(:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) THEN
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XVISIGUL(:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ END IF
+ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XVISIKUN(:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ END IF
+ PBUFFER(KPOS:KPOS+IKU*ISTORES*NAER-1) = RESHAPE( TPSENSOR%XAER(:,1:ISTORES,:), [IKU*ISTORES*NAER] )
+ KPOS = KPOS + IKU * ISTORES * NAER
+
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XIWV(1:ISTORES) ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XZTD(1:ISTORES) ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XZWD(1:ISTORES) ; KPOS = KPOS + ISTORES
+ PBUFFER(KPOS:KPOS+ISTORES-1) = TPSENSOR%XZHD(1:ISTORES) ; KPOS = KPOS + ISTORES
+
+ PBUFFER(KPOS:KPOS+IKU*ISTORES-1) = RESHAPE( TPSENSOR%XTKE_DISS(:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+
+ END SUBROUTINE BUFFER_PACK_PROFILER
+
+
+ ! #######################################################################
+ SUBROUTINE BUFFER_PACK_STATION( TPSENSOR, PBUFFER, KPOS, KSTORE_CURRENT )
+ ! #######################################################################
+
+ USE MODE_MSG
+
+ CLASS(TSTATIONDATA), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(INOUT) :: PBUFFER ! Buffer to pack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_CURRENT ! Current number of stored instants
+
+ INTEGER :: ISTORES
+
+ IF ( PRESENT( KSTORE_CURRENT ) ) THEN
+ ISTORES = KSTORE_CURRENT
+ IF ( ISTORES > TPSENSOR%NSTORE_MAX ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Buffer_pack_flyer', 'flyer: ' // TRIM(TPSENSOR%CNAME) &
+ // ': KSTORE_CURRENT>NSTORE_MAX', OLOCAL = .TRUE. )
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+ ELSE
+ ISTORES = TPSENSOR%NSTORE_MAX
+ END IF
+
+ CALL TPSENSOR%BUFFER_PACK_STATPROF( PBUFFER, KPOS, ISTORES )
+
+ PBUFFER(KPOS) = TPSENSOR%NK ; KPOS = KPOS + 1
+
+ PBUFFER(KPOS) = TPSENSOR%XZS ; KPOS = KPOS + 1
+ PBUFFER(KPOS) = TPSENSOR%XZMEAS ; KPOS = KPOS + 1
+
+ END SUBROUTINE BUFFER_PACK_STATION
+
+
+ ! ##################################################################
+ SUBROUTINE BUFFER_UNPACK_STATPROF( TPSENSOR, PBUFFER, KPOS, KSTORE )
+ ! ##################################################################
+
+ USE MODD_PARAM_n, ONLY: CRAD
+
+ CLASS(TSTATPROFDATA), INTENT(INOUT) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(IN) :: PBUFFER ! Buffer to unpack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, INTENT(IN) :: KSTORE ! Current number of stored instants
+
+ LOGICAL :: GISALLOC
+
+ CALL TPSENSOR%BUFFER_UNPACK_SENSOR( PBUFFER, KPOS, KSTORE )
+
+ ! Check if the arrays are allocated with a size > 0
+ GISALLOC = ( SIZE( TPSENSOR%XT2M ) > 0 )
+
+ IF ( GISALLOC ) THEN
+ TPSENSOR%XT2M = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XQ2M = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XHU2M = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XZON10M = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XMER10M = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XRN = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XH = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XLE = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XLEI = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XGFLUX = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ IF ( CRAD /= 'NONE' ) THEN
+ TPSENSOR%XSWD = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XSWU = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XLWD = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XLWU = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XSWDIR = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XSWDIFF = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XDSTAOD = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XSLTAOD = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ END IF
+ TPSENSOR%XSFCO2 = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ END IF
+
+ END SUBROUTINE BUFFER_UNPACK_STATPROF
+
+
+ ! ##################################################################
+ SUBROUTINE BUFFER_UNPACK_PROFILER( TPSENSOR, PBUFFER, KPOS, KSTORE )
+ ! ##################################################################
+
+ USE MODD_DIM_n, ONLY: NKMAX
+ USE MODD_PARAMETERS, ONLY: JPVEXT
+ USE MODD_PARAM_n, ONLY: CCLOUD
+ USE MODD_RADIATIONS_n, ONLY: NAER
+
+ USE MODE_MSG
+
+ CLASS(TPROFILERDATA), INTENT(INOUT) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(IN) :: PBUFFER ! Buffer to unpack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, INTENT(IN) :: KSTORE ! Current number of stored instants
+
+ INTEGER :: IKU
+ INTEGER :: JI
+
+ IKU = NKMAX + 2 * JPVEXT
+
+ CALL TPSENSOR%BUFFER_UNPACK_STATPROF( PBUFFER, KPOS, KSTORE )
+
+ TPSENSOR%XFF (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ TPSENSOR%XDD (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ TPSENSOR%XZZ (:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ TPSENSOR%XTHV(:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) THEN
+ TPSENSOR%XVISIGUL(:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ END IF
+ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
+ TPSENSOR%XVISIKUN(:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ END IF
+ TPSENSOR%XAER(:,1:KSTORE,:) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE*NAER-1), [ IKU, KSTORE, NAER ] )
+ KPOS = KPOS + IKU * KSTORE * NAER
+
+ TPSENSOR%XIWV(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XZTD(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XZWD(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+ TPSENSOR%XZHD(1:KSTORE) = PBUFFER(KPOS:KPOS+KSTORE-1) ; KPOS = KPOS + KSTORE
+
+ TPSENSOR%XTKE_DISS(:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+
+ END SUBROUTINE BUFFER_UNPACK_PROFILER
+
+ ! #################################################################
+ SUBROUTINE BUFFER_UNPACK_STATION( TPSENSOR, PBUFFER, KPOS, KSTORE )
+ ! #################################################################
+
+ USE MODE_MSG
+
+ CLASS(TSTATIONDATA), INTENT(INOUT) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(IN) :: PBUFFER ! Buffer to unpack
+ INTEGER, INTENT(INOUT) :: KPOS ! Position in the buffer
+ INTEGER, INTENT(IN) :: KSTORE ! Current number of stored instants
+
+ CALL TPSENSOR%BUFFER_UNPACK_STATPROF( PBUFFER, KPOS, KSTORE )
+
+ TPSENSOR%NK = PBUFFER(KPOS) ; KPOS = KPOS + 1
+
+ TPSENSOR%XZS = PBUFFER(KPOS) ; KPOS = KPOS + 1
+ TPSENSOR%XZMEAS = PBUFFER(KPOS) ; KPOS = KPOS + 1
+
+ END SUBROUTINE BUFFER_UNPACK_STATION
+
END MODULE MODD_TYPE_STATPROF
diff --git a/src/MNH/mode_aero_psd.f90 b/src/MNH/mode_aero_psd.f90
index d5d72fd29799702f2504a7badf56c22b208b1800..f03bdfcee1b9b84623a350d908857a96eff8ec4d 100644
--- a/src/MNH/mode_aero_psd.f90
+++ b/src/MNH/mode_aero_psd.f90
@@ -101,6 +101,7 @@ REAL :: ZDEN2MOL
REAL,DIMENSION(JPMODE*3) :: ZPMIN ! [aerosol units] minimum values for N, sigma, M
INTEGER :: JI,JJ,JK,JSV, JN ! [idx] loop counters
REAL :: ZINIRADIUSI, ZINIRADIUSJ
+INTEGER :: II,IJ,IK
!
!-------------------------------------------------------------------------------
!
@@ -253,6 +254,7 @@ END IF
!
!* 5 set moment 6 ==> um6_{aer}/m3_{air}
!
+
IF (LVARSIGI) THEN ! set M6 variable standard deviation
IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) THEN
ZM(:,:,:,3)= ZM(:,:,:,1) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2)
@@ -328,6 +330,7 @@ DO JN=1,JPMODE
ENDDO
!
+
IF(PRESENT(PCTOTA)) PCTOTA(:,:,:,:,:) = ZCTOTA(:,:,:,:,:)
IF(PRESENT(PM3D)) PM3D(:,:,:,:) = ZM(:,:,:,:)
!
@@ -463,7 +466,9 @@ ENDDO
ZCTOTA(:,:,:,JP_AER_SOA10,1) = PSVT(:,:,:,JP_CH_SOA10i)
ZCTOTA(:,:,:,JP_AER_SOA10,2) = PSVT(:,:,:,JP_CH_SOA10j)
END IF
- ZCTOTA(:,:,:,:,:) = MAX(ZCTOTA(:,:,:,:,:),XMNH_TINY)
+ ZCTOTA(:,:,:,:,1) = MAX(ZCTOTA(:,:,:,:,1),1E-6)
+ ZCTOTA(:,:,:,:,2) = MAX(ZCTOTA(:,:,:,:,2),1E-4)
+
!
!* 3 calculate moment 3 from total aerosol mass
@@ -547,8 +552,6 @@ IF (LVARSIGJ) PSVT(:,:,:,JP_CH_M6j) = ZM(:,:,:,6)
DO JJ=1,SIZE(PSVT,4)
PSVT(:,:,:,JJ) = PSVT(:,:,:,JJ) / (ZDEN2MOL * PRHODREF(:,:,:))
ENDDO
-
-
END SUBROUTINE CON2MIX
! ############################################################
diff --git a/src/MNH/mode_fscatter.f90 b/src/MNH/mode_fscatter.f90
index 3e66e3a4394b708b49acc9dbe6c7c4d65a37ef1c..160e427ecf118d394c8b1584abd4f458529d352f 100644
--- a/src/MNH/mode_fscatter.f90
+++ b/src/MNH/mode_fscatter.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2004-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
! ######spl
MODULE MODE_FSCATTER
! ####################
@@ -37,7 +33,8 @@
!! MODIFICATIONS
!! -------------
!! Original 26/03/2004
-!! 27/05/2014 (O. Caumont) Added Maxwell Garnett equation
+! O. Caumont 27/05/2014: added Maxwell Garnett equation
+! P. Wautelet 26/05/2023: add elemental attributes
!--------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -81,10 +78,10 @@ CONTAINS
!* 2. FUNCTION QEPSW
! -------------------
!-------------------------------------------------------------------------------
-! ###########################################
- FUNCTION QEPSW(PTEMP,PFREQ) RESULT(PQEPSW)
-! ###########################################
- ! water complex dielectric function (Liebe et al., 1991)
+! #########################################################
+ ELEMENTAL FUNCTION QEPSW( PTEMP, PFREQ ) RESULT( PQEPSW )
+! #########################################################
+ ! water complex dielectric function (Liebe et al., 1991)
! electromagnetic fields in exp(-i*omega*t), i.e. Im(epsw)>=0
! in : ptemp=temperature in K
! pfreq=frequency in Hz
@@ -110,9 +107,9 @@ CONTAINS
!* 3. FUNCTION QEPSI
! -------------------
!-------------------------------------------------------------------------------
-! ##########################################
- FUNCTION QEPSI(PTEMP,PFREQ) RESULT(PQEPSI)
-! ##########################################
+! #########################################################
+ ELEMENTAL FUNCTION QEPSI( PTEMP, PFREQ ) RESULT( PQEPSI )
+! #########################################################
! ice complex dielectric function (Hufford, 1991)
! electromagnetic fields in exp(-i*omega*t), i.e. Im(epsi)>=0
! in : ptemp=temperature in K
@@ -138,9 +135,9 @@ CONTAINS
!* 4. SUBROUTINE BHMIE
! -----------------
!-------------------------------------------------------------------------------
-! ##########################################
- SUBROUTINE BHMIE(X,REFREL,QEXT,QSCA,QBACK)
-! ##########################################
+! ##########################################################
+ ELEMENTAL SUBROUTINE BHMIE( X, REFREL, QEXT, QSCA, QBACK )
+! ##########################################################
IMPLICIT NONE
! Arguments:
REAL,INTENT(IN) :: X
@@ -206,9 +203,9 @@ CONTAINS
!* 5. SUBROUTINE BHCOAT
! -----------------
!-------------------------------------------------------------------------------
-! ######################################################
- SUBROUTINE BHCOAT(X,Y,RFREL1,RFREL2,QEXT,QSCA,QBACK)
-! ######################################################
+! ######################################################################
+ ELEMENTAL SUBROUTINE BHCOAT( X, Y, RFREL1, RFREL2, QEXT, QSCA, QBACK )
+! ######################################################################
IMPLICIT NONE
! PARAMETERS
REAL,PARAMETER :: DEL=1.e-8
@@ -331,9 +328,9 @@ CONTAINS
! -------------------
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
-! ##########################################
- FUNCTION MG(QEPSINC,QEPSMAT,PF) RESULT(PQEPS)
-! ##########################################
+! #############################################################
+ ELEMENTAL FUNCTION MG( QEPSINC, QEPSMAT, PF ) RESULT( PQEPS )
+! #############################################################
! Maxwell Garnett (1904) equation for dielectric function of effective medium (sphere inclusions in a matrix)
IMPLICIT NONE
diff --git a/src/MNH/mode_les_diachro.f90 b/src/MNH/mode_les_diachro.f90
index 8f848f4e91734d56a56461c4660af25ef0cc73ba..9b20b01f48f24cb6baa1b4382ba81691cc54b1fe 100644
--- a/src/MNH/mode_les_diachro.f90
+++ b/src/MNH/mode_les_diachro.f90
@@ -1183,7 +1183,6 @@ if ( iresp == 0 .and. any( zfield /= XUNDEF ) ) then
tzfields(jp)%ndims = tzfields(jp)%ndims - 1
tzbudiachro%clevels(NLVL_MASK) = hmasks(jp)
-!PW:TODO? necessite le transfert d'info depuis les routines appelantes ou via des structures dans les modd
tzbudiachro%ccomments(NLVL_MASK) = ''
call Write_diachro( tzfile, tzbudiachro, [ tzfields(jp) ], tzdates, zwork6(:,:,:,:,:,jp:jp) )
diff --git a/src/MNH/mode_pos.f90 b/src/MNH/mode_pos.f90
index 1a8344973bc1ae797242feb6205c49603f716d8f..eaf7b13f6ffe8e8040e421a448446c8115efd683 100644
--- a/src/MNH/mode_pos.f90
+++ b/src/MNH/mode_pos.f90
@@ -111,7 +111,7 @@ YDNAML = Upcase( HDNAML ) ! Force namelist name into upper case (read namelist n
search_nam : DO
READ ( UNIT=ILU, FMT='(A)', IOSTAT=IRET, IOMSG=YERRORMSG, END=100 ) YLINE
IF (IRET /= 0 ) THEN
- call Print_msg( NVERB_ERROR, 'IO', 'POSNAM', 'read error:' // Trim( YERRORMSG ) )
+ call Print_msg( NVERB_ERROR, 'IO', 'POSNAM', Trim( HDNAML) // ': read error:' // Trim( YERRORMSG ) )
ELSE
YLINE = Upcase( YLINE )
IND1 = INDEX( YLINE, '&'//YDNAML )
diff --git a/src/MNH/mode_sensor.f90 b/src/MNH/mode_sensor.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e3ff8bea07f207702737b2803eb8b33bbcb380fa
--- /dev/null
+++ b/src/MNH/mode_sensor.f90
@@ -0,0 +1,837 @@
+!MNH_LIC Copyright 2023-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Original version:
+! P. Wautelet: 25/05/2023
+! Modifications:
+!-----------------------------------------------------------------
+MODULE MODE_SENSOR
+
+ USE MODD_PARAMETERS, ONLY: NCOMMENTLGTMAX, NMNHNAMELGTMAX, NUNITLGTMAX
+ USE MODD_SENSOR
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: SENSOR_WC_COMPUTE
+ PUBLIC :: SENSOR_RARE_COMPUTE
+ PUBLIC :: ADD_FIXPOINT
+ PUBLIC :: ADD_POINT
+ PUBLIC :: ADD_PROFILE
+ PUBLIC :: ADD_ORILAM_DATA
+ PUBLIC :: ADD_DUST_DATA
+ PUBLIC :: ADD_SALT_DATA
+ PUBLIC :: SENSOR_WRITE_WORKARRAYS_ALLOCATE
+ PUBLIC :: SENSOR_WRITE_WORKARRAYS_DEALLOCATE
+ PUBLIC :: SENSOR_CURRENT_PROCESSES_NUMBER_GET
+
+ ! Fields to store data to write in diachro file
+ ! This data is private and should not be available outside of this module
+ INTEGER :: NPROCCUR ! Current entry
+ INTEGER :: NPROCMAX = -1 ! Maximum number of entries
+
+ CHARACTER(LEN=NCOMMENTLGTMAX), DIMENSION(:), ALLOCATABLE, PUBLIC :: CCOMMENT ! comment string
+ CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:), ALLOCATABLE, PUBLIC :: CTITLE ! title
+ CHARACTER(LEN=NUNITLGTMAX), DIMENSION(:), ALLOCATABLE, PUBLIC :: CUNIT ! physical unit
+
+ REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE, PUBLIC :: XWORK6 ! contains temporal series
+
+CONTAINS
+
+ SUBROUTINE SENSOR_WC_COMPUTE( TPSENSOR, KSTORE_ID, PR, PRHODREF )
+ USE MODD_PARAM_N, ONLY: CCLOUD
+
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+ INTEGER, INTENT(IN) :: KSTORE_ID
+
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratios
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry air density of the reference state
+
+ ! initialization LWC and IWC
+ TPSENSOR%XLWCZ(:,KSTORE_ID) = 0.
+ TPSENSOR%XIWCZ(:,KSTORE_ID) = 0.
+
+ !TODO: add ICE4?
+ IF ( CCLOUD == "LIMA" .OR. CCLOUD=="ICE3" ) THEN
+ TPSENSOR%XLWCZ(:,KSTORE_ID) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( (PR(:,:,:,2)+PR(:,:,:,3) ) * PRHODREF(:,:,:) )
+ TPSENSOR%XIWCZ(:,KSTORE_ID) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( (PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6)) * PRHODREF(:,:,:) )
+ END IF
+ END SUBROUTINE SENSOR_WC_COMPUTE
+
+
+ SUBROUTINE SENSOR_RARE_COMPUTE( TPSENSOR, KSTORE_ID, PR, PSV, PRHODREF, PCIT, PTH_EXN, PZMZ, PSEA )
+ USE MODD_CST, ONLY: XLAM_CRAD, XLIGHTSPEED, XPI, XRHOLW, XTT
+ USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
+ USE MODD_PARAMETERS, ONLY: XUNDEF
+ USE MODD_PARAM_ICE, ONLY: LSNOW_T_I => LSNOW_T
+ USE MODD_PARAM_LIMA, ONLY: LSNOW_T_L => LSNOW_T, &
+ XALPHAR_L => XALPHAR, XNUR_L => XNUR, XALPHAS_L => XALPHAS, XNUS_L => XNUS, &
+ XALPHAG_L => XALPHAG, XNUG_L => XNUG, XALPHAI_L => XALPHAI, XNUI_L => XNUI, &
+ XRTMIN_L => XRTMIN, XALPHAC_L => XALPHAC, XNUC_L => XNUC
+ USE MODD_PARAM_LIMA_COLD, ONLY: XAI_L => XAI, XBI_L => XBI, XLBEXS_L => XLBEXS, XLBS_L => XLBS, XCCS_L => XCCS, &
+ XAS_L => XAS, XBS_L => XBS, XCXS_L => XCXS, &
+ XLBDAS_MAX_L => XLBDAS_MAX, XLBDAS_MIN_L => XLBDAS_MIN, &
+ XNS_L => XNS, XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
+ USE MODD_PARAM_LIMA_MIXED, ONLY: XLBEXG_L => XLBEXG, XLBG_L => XLBG, XCCG_L => XCCG, XAG_L => XAG, XBG_L => XBG, XCXG_L => XCXG
+ USE MODD_PARAM_LIMA_WARM, ONLY: XAC_L => XAC, XAR_L => XAR, XBC_L => XBC, XBR_L => XBR
+ USE MODD_PARAM_N, ONLY: CCLOUD, CSURF
+ USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I => XLBEXR, &
+ XLBR_I => XLBR, XCCR_I => XCCR, XBR_I => XBR, XAR_I => XAR, &
+ XALPHAC_I => XALPHAC, XNUC_I => XNUC, XBC_I => XBC, XAC_I => XAC, &
+ XALPHAC2_I => XALPHAC2, XNUC2_I => XNUC2, &
+ XALPHAS_I => XALPHAS, XNUS_I => XNUS, XLBEXS_I => XLBEXS, &
+ XLBS_I => XLBS, XCCS_I => XCCS, XAS_I => XAS, XBS_I => XBS, XCXS_I => XCXS, &
+ XALPHAG_I => XALPHAG, XNUG_I => XNUG, XLBEXG_I => XLBEXG, &
+ XLBG_I => XLBG, XCCG_I => XCCG, XAG_I => XAG, XBG_I => XBG, XCXG_I => XCXG, &
+ XALPHAI_I => XALPHAI, XNUI_I => XNUI, XLBEXI_I => XLBEXI, &
+ XLBI_I => XLBI, XAI_I => XAI, XBI_I => XBI, &
+ XNS_I => XNS, XRTMIN_I => XRTMIN, XCONC_LAND, XCONC_SEA, &
+ XLBDAS_MAX_I => XLBDAS_MAX, XLBDAS_MIN_I => XLBDAS_MIN, &
+ XTRANS_MP_GAMMAS_I => XTRANS_MP_GAMMAS
+
+ USE MODE_FGAU, ONLY: GAULAG
+ USE MODE_FSCATTER, ONLY: BHMIE, QEPSI, QEPSW, MG, MOMG
+
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR ! sensor data and metadata
+ INTEGER, INTENT(IN) :: KSTORE_ID ! storage index
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratios
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSV ! scalar variables
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry air density of the reference state
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! pristine ice concentration
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH_EXN ! potential temperature multiplied by exner function
+ REAL,DIMENSION(:), INTENT(IN) :: PZMZ ! altitude of model levels at station location
+ REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
+
+
+ INTEGER, PARAMETER :: JPTS_GAULAG = 7 ! number of points for Gauss-Laguerre quadrature
+
+ COMPLEX :: QMW, QMI, QM, QEPSIW, QEPSWI ! dielectric parameters
+ INTEGER :: IKU
+ INTEGER :: ICOUNT
+ INTEGER :: JJ ! loop counter for qdrature
+ INTEGER :: JK ! loop index
+ INTEGER :: JLOOP ! loop counter
+ LOGICAL :: GCALC
+ REAL :: ZA, ZB, ZCC, ZCX, ZALPHA, ZNS, ZNU, ZLB, ZLBEX, ZRHOHYD ! generic microphysical parameters
+ REAL :: ZAETOT, ZAETMP, ZREFLOC, ZQSCA, ZQBACK, ZQEXT ! temporary scattering parameters
+ REAL :: ZLBDA ! slope distribution parameter
+ REAL :: ZDELTA_EQUIV ! mass-equivalent gauss-laguerre point
+ REAL :: ZFW ! liquid fraction
+ REAL :: ZFPW ! weight for mixed-phase reflectivity
+ REAL :: ZN ! number concentration
+ REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ ! vertical profile of temperature
+ REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
+ REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
+ REAL, DIMENSION(SIZE(PR,3)) :: ZCCI, ZCCR, ZCCC ! ice, rain, cloud concentration (LIMA)
+ REAL, DIMENSION(:), ALLOCATABLE :: ZAELOC ! temporary array
+ REAL, DIMENSION(:), ALLOCATABLE :: ZX, ZW ! Gauss-Laguerre points and weights
+ REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN ! local values for xrtmin
+ REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
+
+ IKU = SIZE( PRHODREF, 3 )
+
+ ! initialization CRARE and CRARE_ATT
+ TPSENSOR%XCRARE (:,KSTORE_ID) = 0.
+ TPSENSOR%XCRARE_ATT(:,KSTORE_ID) = 0.
+
+ !TODO: add ICE4?
+ IF ( CCLOUD == "LIMA" .OR. CCLOUD=="ICE3" ) THEN
+ ZTEMPZ(:) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( PTH_EXN(:,:,:) )
+ ZRHODREFZ(:) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( PRHODREF(:,:,:) )
+ IF ( CCLOUD == "LIMA" ) THEN
+ ZCCI(:) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NI) )
+ ZCCR(:) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NR) )
+ ZCCC(:) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NC) )
+ ELSE
+ ZCIT(:) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( PCIT(:,:,:) )
+ END IF
+ DO JLOOP = 3, 6
+ ZRZ(:,JLOOP) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,JLOOP) )
+ END DO
+ IF ( CSURF == 'EXTE' ) THEN
+ DO JK = 1, IKU
+ ZRZ(JK,2) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( PR(:,:,JK,2) * PSEA(:,:) ) ! becomes cloud mixing ratio over sea
+ ZRZ(JK,7) = TPSENSOR%INTERP_HOR_FROM_MASSPOINT( PR(:,:,JK,2) * (1.-PSEA(:,:)) ) ! becomes cloud mixing ratio over land
+ END DO
+ ELSE
+ !if csurf/='EXTE', psea is not allocated
+ DO JK=1,IKU
+ ZRZ(JK,2)=TPSENSOR%INTERP_HOR_FROM_MASSPOINT( PR(:,:,JK,2) )
+ ZRZ(JK,7) = 0.
+ END DO
+ END IF
+
+ ALLOCATE(ZAELOC(IKU))
+ ZAELOC(:) = 0.
+
+ ! initialization of quadrature points and weights
+ ALLOCATE( ZX(JPTS_GAULAG), ZW(JPTS_GAULAG) )
+ CALL GAULAG( JPTS_GAULAG, ZX, ZW ) ! for integration over diameters
+
+ ! initialize minimum values
+ ALLOCATE( ZRTMIN(SIZE( PR, 4 ) + 1) )
+ IF ( CCLOUD == 'LIMA') THEN
+ ZRTMIN(2) = XRTMIN_L(2) ! cloud water over sea
+ ZRTMIN(3) = XRTMIN_L(3)
+ ZRTMIN(4) = XRTMIN_L(4)
+ ZRTMIN(5) = 1E-10
+ ZRTMIN(6) = XRTMIN_L(6)
+ ZRTMIN(7) = XRTMIN_L(2) ! cloud water over land
+ ELSE
+ ZRTMIN(2) = XRTMIN_I(2) ! cloud water over sea
+ ZRTMIN(3) = XRTMIN_I(3)
+ ZRTMIN(4) = XRTMIN_I(4)
+ ZRTMIN(5) = 1E-10
+ ZRTMIN(6) = XRTMIN_I(6)
+ ZRTMIN(7) = XRTMIN_I(2) ! cloud water over land
+ END IF
+
+ ! compute cloud radar reflectivity from vertical profiles of temperature and mixing ratios
+ DO JK = 1, IKU
+ QMW = SQRT( QEPSW( ZTEMPZ(JK), XLIGHTSPEED / XLAM_CRAD ) )
+ QMI = SQRT( QEPSI( ZTEMPZ(JK), XLIGHTSPEED / XLAM_CRAD ) )
+ DO JLOOP = 2, 7
+ IF ( CCLOUD == 'LIMA' ) THEN
+ GCALC = ( ZRZ(JK,JLOOP) > ZRTMIN(JLOOP) ) .AND. ( JLOOP /= 4 .OR. ZCCI(JK) > 0. ) .AND. &
+ ( JLOOP /=3 .OR. ZCCR(JK) > 0. ) .AND. ( ( JLOOP /=2 .AND. JLOOP /= 7 ) .OR. ZCCC(JK) > 0. )
+ ELSE
+ GCALC = ZRZ(JK,JLOOP) > ZRTMIN(JLOOP) .AND. ( JLOOP /= 4 .OR. ZCIT(JK) > 0. )
+ END IF
+
+ IF( GCALC ) THEN
+ SELECT CASE( JLOOP )
+ CASE( 2 ) ! cloud water over sea
+ IF ( CCLOUD == 'LIMA' ) THEN
+ ZA = XAC_L
+ ZB = XBC_L
+ ZCC = ZCCC(JK) * ZRHODREFZ(JK)
+ ZCX = 0.
+ ZALPHA = XALPHAC_L
+ ZNU = XNUC_L
+ ZLBEX = 1.0 / ( ZCX - ZB )
+ ZLB =( ZA * ZCC * MOMG( ZALPHA, ZNU, ZB ) ) ** ( -ZLBEX )
+ ELSE
+ ZA = XAC_I
+ ZB = XBC_I
+ ZCC = XCONC_SEA
+ ZCX = 0.
+ ZALPHA = XALPHAC2_I
+ ZNU = XNUC2_I
+ ZLBEX = 1.0 / (ZCX - ZB )
+ ZLB = ( ZA * ZCC * MOMG( ZALPHA, ZNU, ZB ) ) ** ( -ZLBEX )
+ END IF
+
+ CASE( 3 ) ! rain water
+ IF ( CCLOUD == 'LIMA' ) THEN
+ ZA = XAR_L
+ ZB = XBR_L
+ ZCC = ZCCR(JK) * ZRHODREFZ(JK)
+ ZCX = 0.
+ ZALPHA = XALPHAR_L
+ ZNU = XNUR_L
+ ZLBEX = 1.0 / ( ZCX - ZB )
+ ZLB = ( ZA * ZCC * MOMG( ZALPHA, ZNU, ZB ) ) ** ( -ZLBEX )
+ ELSE
+ ZA = XAR_I
+ ZB = XBR_I
+ ZCC = XCCR_I
+ ZCX = -1.
+ ZALPHA = XALPHAR_I
+ ZNU = XNUR_I
+ ZLB = XLBR_I
+ ZLBEX = XLBEXR_I
+ END IF
+
+ CASE( 4 ) ! pristine ice
+ IF ( CCLOUD == 'LIMA' ) THEN
+ ZA = XAI_L
+ ZB = XBI_L
+ ZCC = ZCCI(JK) * ZRHODREFZ(JK)
+ ZCX = 0.
+ ZALPHA = XALPHAI_L
+ ZNU = XNUI_L
+ ZLBEX = 1.0 / ( ZCX - ZB )
+ ZLB = ( ZA * ZCC * MOMG( ZALPHA, ZNU, ZB ) ) ** ( -ZLBEX ) ! because zcc not included in xlbi
+ ZFW = 0.
+ ELSE
+ ZA = XAI_I
+ ZB = XBI_I
+ ZCC = ZCIT(JK)
+ ZCX = 0.
+ ZALPHA = XALPHAI_I
+ ZNU = XNUI_I
+ ZLBEX = XLBEXI_I
+ ZLB = XLBI_I * ZCC ** ( -ZLBEX ) ! because zcc not included in xlbi
+ ZFW = 0.
+ END IF
+
+ CASE( 5 ) ! snow
+ IF ( CCLOUD == 'LIMA' ) THEN
+ ZA = XAS_L
+ ZB = XBS_L
+ ZCC = XCCS_L
+ ZCX = XCXS_L
+ ZALPHA = XALPHAS_L
+ ZNU = XNUS_L
+ ZNS = XNS_L
+ ZLB = XLBS_L
+ ZLBEX = XLBEXS_L
+ ZFW = 0.
+ ELSE
+ ZA = XAS_I
+ ZB = XBS_I
+ ZCC = XCCS_I
+ ZCX = XCXS_I
+ ZALPHA = XALPHAS_I
+ ZNU = XNUS_I
+ ZNS = XNS_I
+ ZLB = XLBS_I
+ ZLBEX = XLBEXS_I
+ ZFW = 0.
+ END IF
+
+ CASE( 6 ) ! graupel
+ !if temperature between -10 and 10 C and Mr and Mg over min threshold: melting graupel
+ ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel (Fw=0)
+ IF( ZTEMPZ(JK) > XTT-10. .AND. ZTEMPZ(JK) < XTT+10. .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
+ ZFW = ZRZ(JK,3) / ( ZRZ(JK,3) + ZRZ(JK,JLOOP) )
+ ELSE
+ ZFW = 0.
+ END IF
+ IF ( CCLOUD == 'LIMA' ) THEN
+ ZA = XAG_L
+ ZB = XBG_L
+ ZCC = XCCG_L
+ ZCX = XCXG_L
+ ZALPHA = XALPHAG_L
+ ZNU = XNUG_L
+ ZLB = XLBG_L
+ ZLBEX = XLBEXG_L
+ ELSE
+ ZA = XAG_I
+ ZB = XBG_I
+ ZCC = XCCG_I
+ ZCX = XCXG_I
+ ZALPHA = XALPHAG_I
+ ZNU = XNUG_I
+ ZLB = XLBG_I
+ ZLBEX = XLBEXG_I
+ END IF
+
+ CASE( 7 ) ! cloud water over land
+ IF ( CCLOUD == 'LIMA' ) THEN
+ ZA = XAC_L
+ ZB = XBC_L
+ ZCC = ZCCC(JK) * ZRHODREFZ(JK)
+ ZCX = 0.
+ ZALPHA = XALPHAC_L
+ ZNU = XNUC_L
+ ZLBEX = 1.0 / ( ZCX - ZB )
+ ZLB = ( ZA * ZCC * MOMG( ZALPHA, ZNU, ZB ) ) ** ( -ZLBEX )
+ ELSE
+ ZA = XAC_I
+ ZB = XBC_I
+ ZCC = XCONC_LAND
+ ZCX = 0.
+ ZALPHA = XALPHAC_I
+ ZNU = XNUC_I
+ ZLBEX = 1.0 / ( ZCX - ZB )
+ ZLB = ( ZA * ZCC * MOMG( ZALPHA, ZNU, ZB ) ) ** ( -ZLBEX )
+ END IF
+
+ END SELECT
+
+ IF ( JLOOP == 5 .AND. CCLOUD == 'LIMA' .AND. LSNOW_T_L ) THEN
+ IF ( ZTEMPZ(JK) > XTT-10. ) THEN
+ ZLBDA = MAX( MIN( XLBDAS_MAX_L, 10. ** ( 14.554 - 0.0423 * ZTEMPZ(JK) ) ), XLBDAS_MIN_L ) * XTRANS_MP_GAMMAS_L
+ ELSE
+ ZLBDA = MAX( MIN( XLBDAS_MAX_L, 10. ** ( 6.226 - 0.0106 * ZTEMPZ(JK) ) ), XLBDAS_MIN_L ) * XTRANS_MP_GAMMAS_L
+ END IF
+ ZN = ZNS * ZRHODREFZ(JK) * ZRZ(JK, JLOOP) * ZLBDA ** ZB
+ ELSE IF ( JLOOP == 5 .AND. CCLOUD =='ICE3' .AND. LSNOW_T_I ) THEN
+ IF ( ZTEMPZ(JK) > XTT-10. ) THEN
+ ZLBDA = MAX( MIN( XLBDAS_MAX_I, 10. ** ( 14.554 - 0.0423 * ZTEMPZ(JK) ) ), XLBDAS_MIN_I ) * XTRANS_MP_GAMMAS_I
+ ELSE
+ ZLBDA = MAX( MIN( XLBDAS_MAX_I, 10 ** ( 6.226 - 0.0106 * ZTEMPZ(JK) ) ), XLBDAS_MIN_I ) * XTRANS_MP_GAMMAS_I
+ END IF
+ ZN = ZNS * ZRHODREFZ(JK) * ZRZ(JK, JLOOP) * ZLBDA ** ZB
+ ELSE
+ ZLBDA = ZLB * ( ZRHODREFZ(JK) * ZRZ(JK,JLOOP) ) ** ZLBEX
+ ZN = ZCC * ZLBDA ** ZCX
+ END IF
+
+ ZREFLOC = 0.
+ ZAETMP = 0.
+ DO JJ = 1, JPTS_GAULAG ! Gauss-Laguerre quadrature
+ ZDELTA_EQUIV = ZX(JJ) ** ( 1. / ZALPHA ) / ZLBDA
+ SELECT CASE( JLOOP )
+ CASE( 2, 3, 7 )
+ QM = QMW
+ CASE( 4, 5, 6 )
+ ! pristine ice, snow, dry graupel
+ ZRHOHYD = MIN( 6. * ZA * ZDELTA_EQUIV ** ( ZB - 3. ) / XPI, .92 * XRHOLW )
+ QM = SQRT( MG( QMI ** 2, CMPLX(1,0), ZRHOHYD / .92 / XRHOLW ) )
+
+ ! water inclusions in ice in air
+ QEPSWI = MG( QMW ** 2, QM ** 2, ZFW )
+ ! ice in air inclusions in water
+ QEPSIW = MG( QM ** 2, QMW ** 2, 1. - ZFW )
+
+ !MG weighted rule (Matrosov 2008)
+ IF( ZFW < 0.37 ) THEN
+ ZFPW = 0.
+ ELSE IF( ZFW > 0.63 ) THEN
+ ZFPW = 1.
+ ELSE
+ ZFPW = ( ZFW - 0.37 ) / ( 0.63 - 0.37 )
+ END IF
+ QM = SQRT( QEPSWI * ( 1. - ZFPW ) + QEPSIW * ZFPW )
+ END SELECT
+ CALL BHMIE( XPI / XLAM_CRAD * ZDELTA_EQUIV, QM, ZQEXT, ZQSCA, ZQBACK )
+ ZREFLOC = ZREFLOC + ZQBACK * ZX(JJ) ** ( ZNU - 1. ) * ZDELTA_EQUIV ** 2 * ZW(JJ)
+ ZAETMP = ZAETMP + ZQEXT * ZX(JJ) ** ( ZNU - 1. ) * ZDELTA_EQUIV ** 2 * ZW(JJ)
+ END DO
+ ZREFLOC = ZREFLOC * ( XLAM_CRAD / XPI ) ** 4 * ZN / ( 4. * GAMMA( ZNU ) * .93 )
+ ZAETMP = ZAETMP * XPI * ZN / ( 4. * GAMMA( ZNU ) )
+ TPSENSOR%XCRARE(JK, KSTORE_ID) = TPSENSOR%XCRARE(JK, KSTORE_ID) + ZREFLOC
+ ZAELOC(JK) = ZAELOC(JK) + ZAETMP
+ END IF
+ END DO
+ END DO
+
+ ! apply attenuation
+ ! nadir
+ ZAETOT = 1.
+ ICOUNT = COUNT( TPSENSOR%XZ_CUR >= PZMZ(:) )
+ DO JK = ICOUNT, 1, -1
+ IF( JK == ICOUNT ) THEN
+ IF( TPSENSOR%XZ_CUR <= PZMZ(JK) + .5 * ( PZMZ(JK+1) -PZMZ(JK) ) ) THEN
+ ! only attenuation from zaeloc(jk)
+ ZAETOT = ZAETOT * EXP( -2. * ( ZAELOC(JK) * ( TPSENSOR%XZ_CUR - PZMZ(JK) ) ) )
+ ELSE
+ ! attenuation from zaeloc(jk) and zaeloc(jk+1)
+ ZAETOT = ZAETOT * EXP( -2. * ( ZAELOC(JK+1) * (TPSENSOR%XZ_CUR - .5 * ( PZMZ(JK+1) + PZMZ(JK) ) ) &
+ + ZAELOC(JK) * .5 * ( PZMZ(JK+1) - PZMZ(JK) ) ) )
+ END IF
+ ELSE
+ ! attenuation from zaeloc(jk) and zaeloc(jk+1)
+ ZAETOT = ZAETOT * EXP( - ( ZAELOC(JK+1) + ZAELOC(JK) ) * ( PZMZ(JK+1) - PZMZ(JK) ) )
+ END IF
+ TPSENSOR%XCRARE_ATT(JK,KSTORE_ID) = TPSENSOR%XCRARE(JK,KSTORE_ID) * ZAETOT
+ END DO
+
+ ! zenith
+ ZAETOT = 1.
+ ICOUNT = MAX( COUNT( TPSENSOR%XZ_CUR >= PZMZ(:) ), 1 ) + 1
+ DO JK = ICOUNT, IKU
+ IF ( JK == ICOUNT ) THEN
+ IF( TPSENSOR%XZ_CUR >= PZMZ(JK) - .5 * ( PZMZ(JK) - PZMZ(JK-1) ) ) THEN
+ ! only attenuation from zaeloc(jk)
+ ZAETOT = ZAETOT * EXP( -2. * ( ZAELOC(JK) * ( PZMZ(JK) - TPSENSOR%XZ_CUR) ) )
+ ELSE
+ ! attenuation from zaeloc(jk) and zaeloc(jk-1)
+ ZAETOT = ZAETOT * EXP( -2. * ( ZAELOC(JK-1) * ( .5 * ( PZMZ(JK) + PZMZ(JK-1) ) - TPSENSOR%XZ_CUR ) &
+ + ZAELOC(JK) * .5 * ( PZMZ(JK) - PZMZ(JK-1) ) ) )
+ END IF
+ ELSE
+ ! attenuation from zaeloc(jk) and zaeloc(jk-1)
+ ZAETOT = ZAETOT * EXP ( - ( ZAELOC(JK-1) + ZAELOC(JK) ) * ( PZMZ(JK) - PZMZ(JK-1) ) )
+ END IF
+ TPSENSOR%XCRARE_ATT(JK,KSTORE_ID) = TPSENSOR%XCRARE(JK,KSTORE_ID) * ZAETOT
+ END DO
+
+ ! m^3 → mm^6/m^3 → dbz
+ WHERE( TPSENSOR%XCRARE(:, KSTORE_ID) > 0 )
+ TPSENSOR%XCRARE(:, KSTORE_ID) = 10. * LOG10( 1.E18 * TPSENSOR%XCRARE(:, KSTORE_ID) )
+ ELSEWHERE
+ TPSENSOR%XCRARE(:, KSTORE_ID) = XUNDEF
+ END WHERE
+ WHERE( TPSENSOR%XCRARE_ATT(:, KSTORE_ID) > 0 )
+ TPSENSOR%XCRARE_ATT(:, KSTORE_ID) = 10. * LOG10( 1.E18 * TPSENSOR%XCRARE_ATT(:, KSTORE_ID) )
+ ELSEWHERE
+ TPSENSOR%XCRARE_ATT(:, KSTORE_ID ) = XUNDEF
+ END WHERE
+ END IF ! end LIMA / ICE3
+
+ END SUBROUTINE SENSOR_RARE_COMPUTE
+
+
+ SUBROUTINE ADD_FIXPOINT( HTITLEIN, HCOMMENTIN, HUNITSIN, PFIELDIN )
+
+ CHARACTER(LEN=*), INTENT(IN) :: HTITLEIN
+ CHARACTER(LEN=*), INTENT(IN) :: HCOMMENTIN
+ CHARACTER(LEN=*), INTENT(IN) :: HUNITSIN
+ REAL, INTENT(IN) :: PFIELDIN
+
+ REAL, DIMENSION(1,1) :: PFIELD
+
+ PFIELD(1,1) = PFIELDIN
+ CALL ADD_PROFILE( HTITLEIN, HCOMMENTIN, HUNITSIN, PFIELD )
+
+ END SUBROUTINE ADD_FIXPOINT
+
+
+ SUBROUTINE ADD_POINT( HTITLEIN, HCOMMENTIN, HUNITSIN, PFIELDIN )
+
+ CHARACTER(LEN=*), INTENT(IN) :: HTITLEIN
+ CHARACTER(LEN=*), INTENT(IN) :: HCOMMENTIN
+ CHARACTER(LEN=*), INTENT(IN) :: HUNITSIN
+ REAL, DIMENSION(:), INTENT(IN) :: PFIELDIN
+
+ CALL ADD_PROFILE( HTITLEIN, HCOMMENTIN, HUNITSIN, RESHAPE( PFIELDIN, [ 1, SIZE(PFIELDIN) ] ) )
+
+ END SUBROUTINE ADD_POINT
+
+
+ SUBROUTINE ADD_PROFILE( HTITLEIN, HCOMMENTIN, HUNITSIN, PFIELDIN )
+ USE MODE_MSG
+
+ CHARACTER(LEN=*), INTENT(IN) :: HTITLEIN
+ CHARACTER(LEN=*), INTENT(IN) :: HCOMMENTIN
+ CHARACTER(LEN=*), INTENT(IN) :: HUNITSIN
+ REAL, DIMENSION(:,:), INTENT(IN) :: PFIELDIN
+
+ NPROCCUR = NPROCCUR + 1
+
+ IF ( NPROCCUR > NPROCMAX ) CALL PRINT_MSG( NVERB_FATAL, 'IO', 'Add_profile', 'more processes than expected' )
+
+ CTITLE(NPROCCUR) = TRIM( HTITLEIN)
+ IF ( LEN_TRIM( HTITLEIN ) > LEN( CTITLE(NPROCCUR) ) ) &
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'Add_profile', &
+ 'title was truncated to ' // CTITLE(NPROCCUR) // ' from ' // TRIM( HTITLEIN ) )
+
+ CCOMMENT(NPROCCUR) = TRIM( HCOMMENTIN )
+ IF ( LEN_TRIM( HCOMMENTIN ) > LEN( CCOMMENT(NPROCCUR) ) ) &
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'Add_profile', &
+ 'comment was truncated to ' // CCOMMENT(NPROCCUR) // ' from ' // TRIM( HCOMMENTIN ) )
+
+ CUNIT(NPROCCUR) = TRIM( HUNITSIN )
+ IF ( LEN_TRIM( HUNITSIN ) > LEN( CUNIT(NPROCCUR) ) ) &
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'Add_profile', &
+ 'units was truncated to ' // CUNIT(NPROCCUR) // ' from ' // TRIM( HUNITSIN ) )
+
+ XWORK6(1, 1, :, :, 1, NPROCCUR) = PFIELDIN(:, :)
+
+ END SUBROUTINE ADD_PROFILE
+
+
+ SUBROUTINE ADD_ORILAM_DATA( TPSENSOR, KLEVEL, KSTORE )
+ USE MODD_CH_AEROSOL
+ USE MODD_CONF_N, ONLY: NRR
+ USE MODD_CST, ONLY: XP00, XCPD, XRD, XRV
+ USE MODD_NSV, ONLY: NSV_AER, NSV_AERBEG, NSV_AEREND
+
+ USE MODE_AERO_PSD, ONLY: PPP2AERO
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ INTEGER, INTENT(IN) :: KLEVEL ! Number of vertical levels
+ INTEGER, INTENT(IN) :: KSTORE ! Number of store instants
+
+ INTEGER :: JRR
+ INTEGER :: JSV
+ CHARACTER(LEN=NCOMMENTLGTMAX) :: YCOMMENT
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: YTITLE
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZRG, ZSIG
+ REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZPTOTA
+
+ IF ( .NOT. LORILAM ) RETURN
+
+ ALLOCATE( ZSV (1, KLEVEL, KSTORE, NSV_AER) )
+ ALLOCATE( ZRHO(1, KLEVEL, KSTORE) )
+ ALLOCATE( ZN0 (1, KLEVEL, KSTORE, JPMODE) )
+ ALLOCATE( ZRG (1, KLEVEL, KSTORE, JPMODE) )
+ ALLOCATE( ZSIG(1, KLEVEL, KSTORE, JPMODE) )
+ ALLOCATE( ZPTOTA(1, KLEVEL, KSTORE, NSP+NCARB+NSOA, JPMODE ))
+
+ ZSV(1,:,:,1:NSV_AER) = TPSENSOR%XSV(:,:,NSV_AERBEG:NSV_AEREND)
+
+ IF ( NRR > 0 ) THEN
+ ZRHO(1,:,:) = 0.
+ DO JRR = 1, NRR
+ ZRHO(1,:,:) = ZRHO(1,:,:) + TPSENSOR%XR(:,:,JRR)
+ END DO
+ ZRHO(1,:,:) = TPSENSOR%XTH(:,:) * ( 1. + XRV / XRD * TPSENSOR%XR(:,:,1) ) / ( 1. + ZRHO(1,:,:) )
+ ELSE
+ ZRHO(1,:,:) = TPSENSOR%XTH(:,:)
+ ENDIF
+
+ ZRHO(1,:,:) = TPSENSOR%XP(:,:) / ( XRD * ZRHO(1,:,:) * ( ( TPSENSOR%XP(:,:) / XP00 ) ** ( XRD / XCPD ) ) )
+
+ CALL PPP2AERO( ZSV, ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0, PCTOTA=ZPTOTA )
+
+ DO JSV = 1, JPMODE
+ ! mean radius
+ WRITE( YTITLE, '( a6, i1 )' ) 'AERRGA', JSV
+ WRITE( YCOMMENT, '( a18, i1 )' ) 'RG (nb) AERO MODE ', JSV
+ CALL ADD_PROFILE( YTITLE, YCOMMENT, 'um', ZRG(1,:,:,JSV) )
+
+ ! standard deviation
+ WRITE( YTITLE, '( A7, I1 )' ) 'AERSIGA', JSV
+ WRITE( YCOMMENT, '( A16, I1 )' ) 'SIGMA AERO MODE ', JSV
+ CALL ADD_PROFILE( YTITLE, YCOMMENT, '1', ZSIG(1,:,:,JSV) )
+
+ ! particles number
+ WRITE( YTITLE, '( A6, I1 )' ) 'AERN0A', JSV
+ WRITE( YCOMMENT, '( A13, I1 )' ) 'N0 AERO MODE ', JSV
+ CALL ADD_PROFILE( YTITLE, YCOMMENT, 'm-3', ZN0(1,:,:,JSV) )
+
+ ! mass concentration in microg/m3
+ ! sulfate
+ WRITE( YTITLE,'(A,I1)')'MSO4',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SO4 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SO4,JSV) )
+
+ ! nitrate
+ WRITE( YTITLE,'(A,I1)')'MNO3',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS NO3 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_NO3,JSV) )
+
+ ! amoniac
+ WRITE( YTITLE,'(A,I1)')'MNH3',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS NH3 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_NH3,JSV) )
+
+ ! water
+ WRITE( YTITLE,'(A,I1)')'MH2O',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS H2O AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_H2O,JSV) )
+
+ IF ( NSOA == 10 ) THEN
+ ! SOA1
+ WRITE( YTITLE,'(A,I1)')'MSOA1',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SOA1 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SOA1,JSV) )
+
+ ! SOA2
+ WRITE( YTITLE,'(A,I1)')'MSOA2',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SOA2 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SOA2,JSV) )
+
+ ! SOA3
+ WRITE( YTITLE,'(A,I1)')'MSOA3',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SOA3 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SOA3,JSV) )
+
+ ! SOA4
+ WRITE( YTITLE,'(A,I1)')'MSOA4',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SOA4 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SOA4,JSV) )
+
+ ! SOA5
+ WRITE( YTITLE,'(A,I1)')'MSOA5',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SOA5 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SOA5,JSV) )
+
+ ! SOA6
+ WRITE( YTITLE,'(A,I1)')'MSOA6',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SOA6 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SOA6,JSV) )
+
+ ! SOA7
+ WRITE( YTITLE,'(A,I1)')'MSOA7',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SOA7 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SOA7,JSV) )
+
+ ! SOA8
+ WRITE( YTITLE,'(A,I1)')'MSOA8',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SOA8 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SOA8,JSV) )
+
+ ! SOA9
+ WRITE( YTITLE,'(A,I1)')'MSOA9',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SOA9 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SOA9,JSV) )
+
+ ! SOA10
+ WRITE( YTITLE,'(A,I1)')'MSOA10',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS SOA10 AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_SOA10,JSV) )
+ END IF
+
+ ! OC
+ WRITE( YTITLE,'(A,I1)')'MOC',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS OC AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_OC,JSV) )
+
+ ! BC
+ WRITE( YTITLE,'(A,I1)')'MBC',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS BC AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_BC,JSV) )
+
+ ! dust
+ WRITE( YTITLE,'(A,I1)')'MDUST',JSV
+ WRITE( YCOMMENT,'(A,I1)')'MASS DUST AEROSOL MODE ',JSV
+ CALL ADD_PROFILE( TRIM( YTITLE ), TRIM( YCOMMENT ), 'ug m-3', ZPTOTA(1,:,:,JP_AER_DST,JSV) )
+ END DO
+
+ DEALLOCATE( ZSV, ZRHO, ZN0, ZRG, ZSIG, ZPTOTA )
+
+ END SUBROUTINE ADD_ORILAM_DATA
+
+ SUBROUTINE ADD_DUST_DATA( TPSENSOR, KLEVEL, KSTORE )
+ USE MODD_CONF_N, ONLY: NRR
+ USE MODD_CST, ONLY: XP00, XCPD, XRD, XRV
+ USE MODD_DUST
+ USE MODD_NSV, ONLY: NSV_DST, NSV_DSTBEG, NSV_DSTEND
+
+ USE MODE_DUST_PSD, ONLY: PPP2DUST
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ INTEGER, INTENT(IN) :: KLEVEL ! Number of vertical levels
+ INTEGER, INTENT(IN) :: KSTORE ! Number of store instants
+
+ INTEGER :: JRR
+ INTEGER :: JSV
+ CHARACTER(LEN=NCOMMENTLGTMAX) :: YCOMMENT
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: YTITLE
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZRG, ZSIG
+
+ IF ( .NOT. LDUST ) RETURN
+
+ ALLOCATE( ZSV (1, KLEVEL, KSTORE, NSV_DST) )
+ ALLOCATE( ZRHO(1, KLEVEL, KSTORE) )
+ ALLOCATE( ZN0 (1, KLEVEL, KSTORE, NMODE_DST) )
+ ALLOCATE( ZRG (1, KLEVEL, KSTORE, NMODE_DST) )
+ ALLOCATE( ZSIG(1, KLEVEL, KSTORE, NMODE_DST) )
+
+ ZSV(1,:,:,1:NSV_DST) = TPSENSOR%XSV(:,:,NSV_DSTBEG:NSV_DSTEND)
+
+ IF ( NRR > 0 ) THEN
+ ZRHO(1,:,:) = 0.
+ DO JRR = 1, NRR
+ ZRHO(1,:,:) = ZRHO(1,:,:) + TPSENSOR%XR(:,:,JRR)
+ END DO
+ ZRHO(1,:,:) = TPSENSOR%XTH(:,:) * ( 1. + XRV / XRD * TPSENSOR%XR(:,:,1) ) / ( 1. + ZRHO(1,:,:) )
+ ELSE
+ ZRHO(1,:,:) = TPSENSOR%XTH(:,:)
+ ENDIF
+
+ ZRHO(1,:,:) = TPSENSOR%XP(:,:) / ( XRD * ZRHO(1,:,:) * ( ( TPSENSOR%XP(:,:) / XP00 ) ** ( XRD / XCPD ) ) )
+
+ CALL PPP2DUST( ZSV, ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0 )
+
+ DO JSV = 1, NMODE_DST
+ ! mean radius
+ WRITE( YTITLE, '( a6, i1 )' ) 'DSTRGA', JSV
+ WRITE( YCOMMENT, '( a18, i1 )' ) 'RG (nb) DUST MODE ', JSV
+ CALL ADD_PROFILE( YTITLE, YCOMMENT, 'um', ZRG(1,:,:,JSV) )
+
+ ! standard deviation
+ WRITE( YTITLE, '( A7, I1 )' ) 'DSTSIGA', JSV
+ WRITE( YCOMMENT, '( A16, I1 )' ) 'SIGMA DUST MODE ', JSV
+ CALL ADD_PROFILE( YTITLE, YCOMMENT, '', ZSIG(1,:,:,JSV) )
+
+ ! particles number
+ WRITE( YTITLE, '( A6, I1 )' ) 'DSTN0A', JSV
+ WRITE( YCOMMENT, '( A13, I1 )' ) 'N0 DUST MODE ', JSV
+ CALL ADD_PROFILE( YTITLE, YCOMMENT, 'm-3', ZN0(1,:,:,JSV) )
+ END DO
+
+ DEALLOCATE ( ZSV, ZRHO, ZN0, ZRG, ZSIG )
+
+ END SUBROUTINE ADD_DUST_DATA
+
+ SUBROUTINE ADD_SALT_DATA( TPSENSOR, KLEVEL, KSTORE )
+ USE MODD_CONF_N, ONLY: NRR
+ USE MODD_CST, ONLY: XP00, XCPD, XRD, XRV
+ USE MODD_NSV, ONLY: NSV_SLT, NSV_SLTBEG, NSV_SLTEND
+ USE MODD_SALT
+
+ USE MODE_SALT_PSD, ONLY: PPP2SALT
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ INTEGER, INTENT(IN) :: KLEVEL ! Number of vertical levels
+ INTEGER, INTENT(IN) :: KSTORE ! Number of store instants
+
+ INTEGER :: JRR
+ INTEGER :: JSV
+ CHARACTER(LEN=NCOMMENTLGTMAX) :: YCOMMENT
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: YTITLE
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZRG, ZSIG
+
+ IF ( .NOT. LSALT ) RETURN
+
+ ALLOCATE( ZSV (1, KLEVEL, KSTORE, NSV_SLT) )
+ ALLOCATE( ZRHO(1, KLEVEL, KSTORE) )
+ ALLOCATE( ZN0 (1, KLEVEL, KSTORE, NMODE_SLT) )
+ ALLOCATE( ZRG (1, KLEVEL, KSTORE, NMODE_SLT) )
+ ALLOCATE( ZSIG(1, KLEVEL, KSTORE, NMODE_SLT) )
+
+ ZSV(1,:,:,1:NSV_SLT) = TPSENSOR%XSV(:,:,NSV_SLTBEG:NSV_SLTEND)
+
+ IF ( NRR > 0 ) THEN
+ ZRHO(1,:,:) = 0.
+ DO JRR = 1, NRR
+ ZRHO(1,:,:) = ZRHO(1,:,:) + TPSENSOR%XR(:,:,JRR)
+ END DO
+ ZRHO(1,:,:) = TPSENSOR%XTH(:,:) * ( 1. + XRV / XRD * TPSENSOR%XR(:,:,1) ) / ( 1. + ZRHO(1,:,:) )
+ ELSE
+ ZRHO(1,:,:) = TPSENSOR%XTH(:,:)
+ ENDIF
+
+ ZRHO(1,:,:) = TPSENSOR%XP(:,:) / ( XRD * ZRHO(1,:,:) * ( ( TPSENSOR%XP(:,:) / XP00 ) ** ( XRD / XCPD ) ) )
+
+ CALL PPP2SALT( ZSV, ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0 )
+
+ DO JSV = 1, NMODE_SLT
+ ! mean radius
+ WRITE( YTITLE, '( a6, i1 )' ) 'SLTRGA', JSV
+ WRITE( YCOMMENT, '( a18, i1 )' ) 'RG (nb) SALT MODE ', JSV
+ CALL ADD_PROFILE( YTITLE, YCOMMENT, 'um', ZRG(1,:,:,JSV) )
+
+ ! standard deviation
+ WRITE( YTITLE, '( A7, I1 )' ) 'SLTSIGA', JSV
+ WRITE( YCOMMENT, '( A16, I1 )' ) 'SIGMA SALT MODE ', JSV
+ CALL ADD_PROFILE( YTITLE, YCOMMENT, '', ZSIG(1,:,:,JSV) )
+
+ ! particles number
+ WRITE( YTITLE, '( A6, I1 )' ) 'SLTN0A', JSV
+ WRITE( YCOMMENT, '( A13, I1 )' ) 'N0 SALT MODE ', JSV
+ CALL ADD_PROFILE( YTITLE, YCOMMENT, 'm-3', ZN0(1,:,:,JSV) )
+ END DO
+
+ DEALLOCATE ( ZSV, ZRHO, ZN0, ZRG, ZSIG )
+
+ END SUBROUTINE ADD_SALT_DATA
+
+
+ SUBROUTINE SENSOR_WRITE_WORKARRAYS_ALLOCATE( KLEVEL, KSTORE, KPROCMAX )
+ INTEGER, INTENT(IN) :: KLEVEL ! Number of vertical levels
+ INTEGER, INTENT(IN) :: KSTORE ! Number of store instants
+ INTEGER, INTENT(IN) :: KPROCMAX ! Number of different processes (aka data fields)
+
+ NPROCCUR = 0
+ NPROCMAX = KPROCMAX
+
+ ALLOCATE ( XWORK6(1, 1, KLEVEL, KSTORE, 1, KPROCMAX) )
+ ALLOCATE ( CCOMMENT(KPROCMAX) )
+ ALLOCATE ( CTITLE (KPROCMAX) )
+ ALLOCATE ( CUNIT (KPROCMAX) )
+
+ END SUBROUTINE SENSOR_WRITE_WORKARRAYS_ALLOCATE
+
+
+ SUBROUTINE SENSOR_WRITE_WORKARRAYS_DEALLOCATE( )
+
+ NPROCCUR = 0
+ NPROCMAX = 0
+
+ DEALLOCATE( XWORK6 )
+ DEALLOCATE( CCOMMENT)
+ DEALLOCATE( CTITLE )
+ DEALLOCATE( CUNIT )
+ END SUBROUTINE SENSOR_WRITE_WORKARRAYS_DEALLOCATE
+
+ PURE FUNCTION SENSOR_CURRENT_PROCESSES_NUMBER_GET( ) RESULT( KNPROCCUR )
+ INTEGER :: KNPROCCUR
+
+ KNPROCCUR = NPROCCUR
+ END FUNCTION SENSOR_CURRENT_PROCESSES_NUMBER_GET
+
+END MODULE MODE_SENSOR
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index fdc16c2787612c93c42cdc27d36dc4765282d79f..d245bf0bb3f99144a33767f2096deec24ebe2bc0 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -322,6 +322,7 @@ USE MODD_DYNZD_n
USE MODD_ELEC_DESCR
USE MODD_EOL_MAIN
USE MODD_FIELD_n
+USE MODD_FIRE_n
USE MODD_FRC
USE MODD_FRC_n
USE MODD_GET_n
@@ -398,8 +399,7 @@ USE MODE_ONE_WAY_n
USE MODE_WRITE_AIRCRAFT_BALLOON
use mode_write_les_n, only: Write_les_n
use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
-USE MODE_WRITE_PROFILER_n, ONLY: WRITE_PROFILER_n
-USE MODE_WRITE_STATION_n, ONLY: WRITE_STATION_n
+USE MODE_WRITE_STATPROF_n, ONLY: WRITE_STATPROF_n
!
USE MODI_ADDFLUCTUATIONS
USE MODI_ADVECTION_METSV
@@ -467,7 +467,6 @@ USE MODI_WRITE_LFIFM_n
USE MODI_WRITE_SERIES_n
USE MODI_WRITE_SURF_ATM_N
!
-USE MODD_FIRE_n
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -2263,7 +2262,7 @@ END IF
! --------------------------------
!
IF ( LSTATION ) &
- CALL STATION_n( XZZ, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
+ CALL STATION_n( XZZ, XRHODREF, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
!
!---------------------------------------------------------
!
@@ -2343,8 +2342,8 @@ IF (OEXIT) THEN
IF ( .NOT. LIO_NO_WRITE ) THEN
IF (LSERIES) CALL WRITE_SERIES_n(TDIAFILE)
CALL WRITE_AIRCRAFT_BALLOON(TDIAFILE)
- CALL WRITE_STATION_n(TDIAFILE)
- CALL WRITE_PROFILER_n(TDIAFILE)
+ CALL WRITE_STATPROF_n( TDIAFILE, TSTATIONS )
+ CALL WRITE_STATPROF_n( TDIAFILE, TPROFILERS )
call Write_les_n( tdiafile )
#ifdef MNH_IOLFI
CALL MENU_DIACHRO(TDIAFILE,'END')
diff --git a/src/MNH/modn_aircrafts.f90 b/src/MNH/modn_aircrafts.f90
index f4309dfc793e1387355328bb6af8844ef64066e1..131b53fbbb2722ff259d62b46c32c76b69fd31c1 100644
--- a/src/MNH/modn_aircrafts.f90
+++ b/src/MNH/modn_aircrafts.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2022-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2022-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -13,7 +13,7 @@ MODULE MODN_AIRCRAFTS
! Namelist with the the characteristics of the aircrafts
!
USE MODD_AIRCRAFT_BALLOON
-USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAX
+USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAX, NSENSORNAMELGTMAX
USE MODD_TYPE_DATE, ONLY: DATE_TIME
IMPLICIT NONE
@@ -21,17 +21,17 @@ IMPLICIT NONE
!Use separated arrays for the different aircraft characteristics
!Using directly TAIRCRAFTDATA derived types does not work due to compiler bug (GCC at least from 5.5 to 12.1, see GCC bug 106065)
-CHARACTER(LEN=3), DIMENSION(:), ALLOCATABLE :: CMODEL
-INTEGER, DIMENSION(:), ALLOCATABLE :: NMODEL
-CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: CTYPE
-CHARACTER(LEN=10), DIMENSION(:), ALLOCATABLE :: CTITLE
-TYPE(DATE_TIME), DIMENSION(:), ALLOCATABLE :: TLAUNCH
-REAL, DIMENSION(:), ALLOCATABLE :: XTSTEP
-INTEGER, DIMENSION(:), ALLOCATABLE :: NPOS
-LOGICAL, DIMENSION(:), ALLOCATABLE :: LALTDEF
-CHARACTER(LEN=NFILENAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CFILE !Names of CSV files with trajectory data
+CHARACTER(LEN=3), DIMENSION(:), ALLOCATABLE :: CMODEL
+INTEGER, DIMENSION(:), ALLOCATABLE :: NMODEL
+CHARACTER(LEN=NSENSORNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CTYPE
+CHARACTER(LEN=NSENSORNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CTITLE
+TYPE(DATE_TIME), DIMENSION(:), ALLOCATABLE :: TLAUNCH
+REAL, DIMENSION(:), ALLOCATABLE :: XTSTEP
+INTEGER, DIMENSION(:), ALLOCATABLE :: NPOS
+LOGICAL, DIMENSION(:), ALLOCATABLE :: LALTDEF
+CHARACTER(LEN=NFILENAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CFILE !Names of CSV files with trajectory data
-!Do not read CTYPE, value is always forced to 'AIRCRA'
+!Do not read CTYPE, value is always forced to 'AIRCRAFT'
NAMELIST / NAM_AIRCRAFTS / CFILE, CMODEL, CTITLE, LALTDEF, NMODEL, NPOS, TLAUNCH, XTSTEP
CONTAINS
@@ -42,7 +42,7 @@ SUBROUTINE AIRCRAFTS_NML_ALLOCATE( KAIRCRAFTS )
!Note: the default values are used/checked in ini_aircraft => be careful to ensure coherency
ALLOCATE( CMODEL (KAIRCRAFTS) ); CMODEL(:) = 'FIX'
ALLOCATE( CTITLE (KAIRCRAFTS) ); CTITLE(:) = ''
- ALLOCATE( CTYPE (KAIRCRAFTS) ); CTYPE(:) = 'AIRCRA'
+ ALLOCATE( CTYPE (KAIRCRAFTS) ); CTYPE(:) = 'AIRCRAFT'
ALLOCATE( NMODEL (KAIRCRAFTS) ); NMODEL(:) = 0
ALLOCATE( TLAUNCH(KAIRCRAFTS) )
ALLOCATE( XTSTEP (KAIRCRAFTS) ); XTSTEP(:) = XNEGUNDEF
diff --git a/src/MNH/modn_balloons.f90 b/src/MNH/modn_balloons.f90
index f77356c88a006e722ae782e3e8b4330c86238a2a..4192ba28ad21484ce7bd700f8467fc7b645c76b9 100644
--- a/src/MNH/modn_balloons.f90
+++ b/src/MNH/modn_balloons.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2022-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2022-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -13,6 +13,7 @@ MODULE MODN_BALLOONS
! Namelist with the the characteristics of the balloons
!
USE MODD_AIRCRAFT_BALLOON
+USE MODD_PARAMETERS, ONLY: NSENSORNAMELGTMAX
USE MODD_TYPE_DATE, ONLY: DATE_TIME
IMPLICIT NONE
@@ -22,8 +23,8 @@ IMPLICIT NONE
CHARACTER(LEN=3), DIMENSION(:), ALLOCATABLE :: CMODEL
INTEGER, DIMENSION(:), ALLOCATABLE :: NMODEL
-CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: CTYPE
-CHARACTER(LEN=10), DIMENSION(:), ALLOCATABLE :: CTITLE
+CHARACTER(LEN=NSENSORNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CTYPE
+CHARACTER(LEN=NSENSORNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CTITLE
TYPE(DATE_TIME), DIMENSION(:), ALLOCATABLE :: TLAUNCH
REAL, DIMENSION(:), ALLOCATABLE :: XLATLAUNCH
REAL, DIMENSION(:), ALLOCATABLE :: XLONLAUNCH
diff --git a/src/MNH/modn_profilern.f90 b/src/MNH/modn_profilern.f90
index c5e398416461974c92211d6ab8d3a99f8cda196f..319ef272da27d5191878d876eeadf8155555869c 100644
--- a/src/MNH/modn_profilern.f90
+++ b/src/MNH/modn_profilern.f90
@@ -27,6 +27,7 @@
!! IMPLICIT ARGUMENTS
!! ------------------
USE MODD_ALLPROFILER_n, ONLY:&
+ NNOCSVPROFILERMAX ,&
NNUMB_PROF_n =>NNUMB_PROF ,&
XSTEP_PROF_n =>XSTEP_PROF ,&
XX_PROF_n =>XX_PROF ,&
@@ -37,7 +38,7 @@ USE MODD_ALLPROFILER_n, ONLY:&
CNAME_PROF_n =>CNAME_PROF ,&
CFILE_PROF_n =>CFILE_PROF ,&
LDIAG_SURFRAD_n =>LDIAG_SURFRAD_PROF
-USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAX, NSTATPROFNAMELGTMAX
+USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAX, NSENSORNAMELGTMAX
!
!-----------------------------------------------------------------------------
!
@@ -48,9 +49,9 @@ IMPLICIT NONE
INTEGER ,SAVE:: NNUMB_PROF
REAL ,SAVE:: XSTEP_PROF
-REAL, DIMENSION(100) ,SAVE:: XX_PROF, XY_PROF, XZ_PROF, XLAT_PROF, XLON_PROF
-CHARACTER (LEN=NSTATPROFNAMELGTMAX), DIMENSION(100),SAVE:: CNAME_PROF
-CHARACTER (LEN=NFILENAMELGTMAX), SAVE:: CFILE_PROF !filename
+REAL, DIMENSION(NNOCSVPROFILERMAX),SAVE:: XX_PROF, XY_PROF, XZ_PROF, XLAT_PROF, XLON_PROF
+CHARACTER (LEN=NSENSORNAMELGTMAX), DIMENSION(NNOCSVPROFILERMAX),SAVE:: CNAME_PROF
+CHARACTER (LEN=NFILENAMELGTMAX) ,SAVE:: CFILE_PROF !filename
LOGICAL ,SAVE:: LDIAG_SURFRAD
NAMELIST /NAM_PROFILERn/ &
diff --git a/src/MNH/modn_stationn.f90 b/src/MNH/modn_stationn.f90
index 5cacedfca4f47d44265ae09caa765147b10902eb..762ed48e5de7cf4e0735b197d7d02288394c9e3c 100644
--- a/src/MNH/modn_stationn.f90
+++ b/src/MNH/modn_stationn.f90
@@ -26,6 +26,7 @@
!! IMPLICIT ARGUMENTS
!! ------------------
USE MODD_ALLSTATION_n, ONLY:&
+ NNOCSVSTATIONMAX ,&
NNUMB_STAT_n =>NNUMB_STAT ,&
XSTEP_STAT_n =>XSTEP_STAT ,&
XX_STAT_n =>XX_STAT ,&
@@ -36,7 +37,7 @@ USE MODD_ALLSTATION_n, ONLY:&
CNAME_STAT_n =>CNAME_STAT ,&
CFILE_STAT_n =>CFILE_STAT ,&
LDIAG_SURFRAD_n =>LDIAG_SURFRAD_STAT
-USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAX, NSTATPROFNAMELGTMAX
+USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAX, NSENSORNAMELGTMAX
!
!-----------------------------------------------------------------------------
!
@@ -47,9 +48,9 @@ IMPLICIT NONE
INTEGER ,SAVE:: NNUMB_STAT
REAL ,SAVE:: XSTEP_STAT
-REAL, DIMENSION(100) ,SAVE:: XX_STAT, XY_STAT, XZ_STAT, XLAT_STAT, XLON_STAT
-CHARACTER (LEN=NSTATPROFNAMELGTMAX), DIMENSION(100),SAVE:: CNAME_STAT
-CHARACTER (LEN=NFILENAMELGTMAX), SAVE:: CFILE_STAT !filename
+REAL, DIMENSION(NNOCSVSTATIONMAX),SAVE:: XX_STAT, XY_STAT, XZ_STAT, XLAT_STAT, XLON_STAT
+CHARACTER (LEN=NSENSORNAMELGTMAX), DIMENSION(NNOCSVSTATIONMAX),SAVE:: CNAME_STAT
+CHARACTER (LEN=NFILENAMELGTMAX) ,SAVE:: CFILE_STAT !filename
LOGICAL ,SAVE:: LDIAG_SURFRAD
NAMELIST /NAM_STATIONn/ &
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index f5624727a8a9bc1082f394b8a9e9bbd6eb8b8e35..8aa4c5a54f2a7413ade0fbb127b8f76d55bc8e57 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -285,6 +285,7 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX
USE MODD_LBC_n
USE MODD_LES
+USE MODD_LES_n, ONLY: NLES_TIMES
USE MODD_LES_BUDGET
USE MODD_LSFIELD_n
USE MODD_LUNIT_n
@@ -493,7 +494,7 @@ IKB = 1 + JPVEXT
IKE = IKU - JPVEXT
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(XTHT,1), SIZE(XTHT,2), SIZE(XTHT,3),.TRUE.)
+CALL FILL_DIMPHYEX( YLDIMPHYEX, SIZE(XTHT,1), SIZE(XTHT,2), SIZE(XTHT,3), LTURB=.TRUE., KLES_TIMES=NLES_TIMES, KLES_K=NLES_K )
!
ZTIME1 = 0.0_MNHTIME
ZTIME2 = 0.0_MNHTIME
diff --git a/src/MNH/profilern.f90 b/src/MNH/profilern.f90
index 25c907e90e8dd9822a8fd9070b041ad4c6124ccb..f95533090650d9f5c3252f178feb93068d322e3a 100644
--- a/src/MNH/profilern.f90
+++ b/src/MNH/profilern.f90
@@ -83,53 +83,25 @@ END MODULE MODI_PROFILER_n
! + bugfix: put values in variables in this case
! + move some operations outside a do loop
! P. Wautelet 04/2022: restructure profilers for better performance, reduce memory usage and correct some problems/bugs
+! P. Wautelet 01/06/2023: deduplicate code => moved to modd/mode_sensors.f90
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
-USE MODD_CST, ONLY: XCPD, XG, XLAM_CRAD, XLIGHTSPEED, XP00, XPI, XRD, XRHOLW, XRV, XTT
-USE MODD_DIAG_IN_RUN
+USE MODD_CST, ONLY: XCPD, XG, XP00, XPI, XRD, XRV
+USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_TKE_DISS
USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
-USE MODD_NSV, ONLY: NSV_C2R2, NSV_C2R2BEG, NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR
+USE MODD_NSV, ONLY: NSV_C2R2BEG, NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
USE MODD_PARAMETERS, ONLY: JPVEXT, XUNDEF
-USE MODD_PARAM_ICE, ONLY: LSNOW_T_I => LSNOW_T
-USE MODD_PARAM_LIMA, ONLY: LSNOW_T_L => LSNOW_T, &
- XALPHAR_L => XALPHAR, XNUR_L => XNUR, XALPHAS_L => XALPHAS, XNUS_L => XNUS, &
- XALPHAG_L => XALPHAG, XNUG_L => XNUG, XALPHAI_L => XALPHAI, XNUI_L => XNUI, &
- XRTMIN_L => XRTMIN, XALPHAC_L => XALPHAC, XNUC_L => XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L => XDI, XLBEXI_L => XLBEXI, XLBI_L => XLBI, XAI_L => XAI, XBI_L => XBI, XC_I_L => XC_I, &
- XLBEXS_L => XLBEXS, XLBS_L => XLBS, XCCS_L => XCCS, &
- XAS_L => XAS, XBS_L => XBS, XCXS_L => XCXS, &
- XLBDAS_MAX_L => XLBDAS_MAX, XLBDAS_MIN_L => XLBDAS_MIN, &
- XNS_L => XNS, XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
-USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L => XDG, XLBEXG_L => XLBEXG, XLBG_L => XLBG, XCCG_L => XCCG, &
- XAG_L => XAG, XBG_L => XBG, XCXG_L => XCXG, XCG_L => XCG
-USE MODD_PARAM_LIMA_WARM, ONLY: XLBEXR_L => XLBEXR, XLBR_L => XLBR, XBR_L => XBR, XAR_L => XAR, &
- XBC_L => XBC, XAC_L => XAC
-USE MODD_PARAM_n, ONLY: CCLOUD, CRAD, CSURF
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
USE MODD_PROFILER_n
-USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I => XLBEXR, &
- XLBR_I => XLBR, XCCR_I => XCCR, XBR_I => XBR, XAR_I => XAR, &
- XALPHAC_I => XALPHAC, XNUC_I => XNUC, &
- XLBC_I => XLBC, XBC_I => XBC, XAC_I => XAC, &
- XALPHAC2_I => XALPHAC2, XNUC2_I => XNUC2, &
- XALPHAS_I => XALPHAS, XNUS_I => XNUS, XLBEXS_I => XLBEXS, &
- XLBS_I => XLBS, XCCS_I => XCCS, XAS_I => XAS, XBS_I => XBS, XCXS_I => XCXS, &
- XALPHAG_I => XALPHAG, XNUG_I => XNUG, XDG_I => XDG, XLBEXG_I => XLBEXG, &
- XLBG_I => XLBG, XCCG_I => XCCG, XAG_I => XAG, XBG_I => XBG, XCXG_I => XCXG, XCG_I => XCG, &
- XALPHAI_I => XALPHAI, XNUI_I => XNUI, XDI_I => XDI, XLBEXI_I => XLBEXI, &
- XLBI_I => XLBI, XAI_I => XAI, XBI_I => XBI, XC_I_I => XC_I, &
- XNS_I => XNS, XRTMIN_I => XRTMIN, XCONC_LAND, XCONC_SEA, &
- XLBDAS_MAX_I => XLBDAS_MAX, XLBDAS_MIN_I => XLBDAS_MIN, &
- XTRANS_MP_GAMMAS_I => XTRANS_MP_GAMMAS
!
USE MODE_FGAU, ONLY: GAULAG
-USE MODE_FSCATTER, ONLY: BHMIE, QEPSI, QEPSW, MG, MOMG
USE MODE_MSG
-USE MODE_STATPROF_TOOLS, ONLY: STATPROF_INSTANT, STATPROF_INTERP_2D, STATPROF_INTERP_3D, &
- STATPROF_INTERP_3D_U, STATPROF_INTERP_3D_V
+USE MODE_SENSOR, ONLY: Sensor_rare_compute, Sensor_wc_compute
+USE MODE_STATPROF_TOOLS, ONLY: STATPROF_DIAG_SURFRAD
!
USE MODI_GPS_ZENITH_GRID
USE MODI_WATER_SUM
@@ -161,15 +133,13 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! for radar
! 0.2 declaration of local variables
!
!
-INTEGER, PARAMETER :: JPTS_GAULAG = 9 ! number of points for Gauss-Laguerre quadrature
-!
INTEGER :: IKB
INTEGER :: IKE
INTEGER :: IKU
!
!
-REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)) :: ZWORK
-REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PAER,4)) :: ZWORK2
+REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)) :: ZWORK
+REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PAER,4)) :: ZWORK2
!
INTEGER :: IN ! time index
INTEGER :: JSV ! loop counter
@@ -210,26 +180,6 @@ REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZVISIGUL, ZVISIKUN
REAL :: ZK1,ZK2,ZK3 ! k1, k2 and K3 atmospheric refractivity constants
REAL :: ZRDSRV ! XRD/XRV
!
-! specific to cloud radar
-INTEGER :: JLOOP ! loop counter
-REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
-REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
-REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
-REAL, DIMENSION(SIZE(PR,3)) :: ZCCI,ZCCR,ZCCC ! ICE,RAIN CLOUD concentration (LIMA)
-REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
-REAL :: ZA, ZB, ZCC, ZCX, ZALPHA, ZNS, ZNU, ZLB, ZLBEX, ZRHOHYD ! generic microphysical parameters
-INTEGER :: JJ ! loop counter for quadrature
-COMPLEX :: QMW,QMI,QM,QB,QEPSIW,QEPSWI ! dielectric parameter
-REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
-REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
-REAL :: ZLBDA ! slope distribution parameter
-REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
-REAL :: ZFW ! liquid fraction
-REAL :: ZFPW ! weight for mixed-phase reflectivity
-REAL :: ZN ! number concentration
-REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
-REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
-LOGICAL :: GCALC
!----------------------------------------------------------------------------
!
!* 2. PRELIMINARIES
@@ -255,15 +205,15 @@ IKE = IKU-JPVEXT
!* 3.4 instant of storage
! ------------------
!
-CALL STATPROF_INSTANT( TPROFILERS_TIME, IN )
-IF ( IN < 1 ) RETURN !No profiler storage at this time step
+IF ( .NOT. TPROFILERS_TIME%STORESTEP_CHECK_AND_SET( IN ) ) RETURN !No profiler storage at this time step
!
!----------------------------------------------------------------------------
!
!* 8. DATA RECORDING
! --------------
!
-!PW: TODO: ne faire le calcul que si necessaire (presence de profileurs locaux,...)
+IF ( NUMBPROFILER_LOC == 0 ) RETURN ! No profiler on this process
+
ZTEMP(:,:,:)=PTH(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
! Theta_v
ZTHV(:,:,:) = PTH(:,:,:) / (1.+WATER_SUM(PR(:,:,:,:)))*(1.+PR(:,:,:,1)/ZRDSRV)
@@ -288,12 +238,14 @@ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
END IF
!
PROFILER: DO JP = 1, NUMBPROFILER_LOC
- ZZ(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PZ )
- ZRHOD(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PRHODREF )
- ZPRES(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PP )
- ZU_PROFILER(:) = STATPROF_INTERP_3D_U( TPROFILERS(JP), PU )
- ZV_PROFILER(:) = STATPROF_INTERP_3D_V( TPROFILERS(JP), PV )
- ZGAM = (XRPK * (TPROFILERS(JP)%XLON - XLON0) - XBETA)*(XPI/180.)
+ TPROFILERS(JP)%NSTORE_CUR = IN
+
+ ZZ(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PZ )
+ ZRHOD(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PRHODREF )
+ ZPRES(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PP )
+ ZU_PROFILER(:) = TPROFILERS(JP)%INTERP_HOR_FROM_UPOINT( PU )
+ ZV_PROFILER(:) = TPROFILERS(JP)%INTERP_HOR_FROM_VPOINT( PV )
+ ZGAM = (XRPK * (TPROFILERS(JP)%XLON_CUR - XLON0) - XBETA)*(XPI/180.)
ZFF(:) = SQRT(ZU_PROFILER(:)**2 + ZV_PROFILER(:)**2)
DO JK=1,IKU
IF (ZU_PROFILER(JK) >=0. .AND. ZV_PROFILER(JK) > 0.) &
@@ -308,15 +260,15 @@ PROFILER: DO JP = 1, NUMBPROFILER_LOC
ZDD(JK) = XUNDEF
END DO
! GPS IWV and ZTD
- XZS_GPS=TPROFILERS(JP)%XZ
+ XZS_GPS=TPROFILERS(JP)%XZ_CUR
IF ( ABS( ZZ(IKB)-XZS_GPS ) < 150 ) THEN ! distance between real and model orography ok
- ZRV(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,1) )
- ZT(:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMP )
+ ZRV(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,1) )
+ ZT(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTEMP )
ZE(:) = ZPRES(:)*ZRV(:)/(ZRDSRV+ZRV(:))
- ZTV(:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMPV )
- ZZTD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZTD )
- ZZHD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZHD )
- ZZWD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZWD )
+ ZTV(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTEMPV )
+ ZZTD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZTD )
+ ZZHD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZHD )
+ ZZWD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZWD )
ZIWV = 0.
DO JK=IKB,IKE
ZIWV=ZIWV+ZRHOD(JK)*ZRV(JK)*(ZZ(JK+1)-ZZ(JK))
@@ -373,312 +325,39 @@ PROFILER: DO JP = 1, NUMBPROFILER_LOC
TPROFILERS(JP)%XZWD(IN)= XUNDEF
TPROFILERS(JP)%XZHD(IN)= XUNDEF
END IF
- TPROFILERS(JP)%XZON (IN,:) = ZU_PROFILER(:) * COS(ZGAM) + ZV_PROFILER(:) * SIN(ZGAM)
- TPROFILERS(JP)%XMER (IN,:) = - ZU_PROFILER(:) * SIN(ZGAM) + ZV_PROFILER(:) * COS(ZGAM)
- TPROFILERS(JP)%XFF (IN,:) = ZFF(:)
- TPROFILERS(JP)%XDD (IN,:) = ZDD(:)
- TPROFILERS(JP)%XW (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PW )
- TPROFILERS(JP)%XTH (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PTH )
- TPROFILERS(JP)%XTHV (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTHV )
- IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) TPROFILERS(JP)%XVISIGUL(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZVISIGUL )
- IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) TPROFILERS(JP)%XVISIKUN(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZVISIKUN )
- TPROFILERS(JP)%XZZ (IN,:) = ZZ(:)
- TPROFILERS(JP)%XRHOD(IN,:) = ZRHOD(:)
- IF ( CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4' ) &
- TPROFILERS(JP)%XCIZ(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PCIT )
-! add RARE
- ! initialization CRARE and CRARE_ATT + LWC and IWC
- TPROFILERS(JP)%XCRARE(IN,:) = 0.
- TPROFILERS(JP)%XCRARE_ATT(IN,:) = 0.
- TPROFILERS(JP)%XLWCZ (IN,:) = 0.
- TPROFILERS(JP)%XIWCZ (IN,:) = 0.
- IF (CCLOUD=="LIMA" .OR. CCLOUD=="ICE3" ) THEN ! only for ICE3 and LIMA
- TPROFILERS(JP)%XLWCZ (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), (PR(:,:,:,2)+PR(:,:,:,3))*PRHODREF(:,:,:) )
- TPROFILERS(JP)%XIWCZ (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), (PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:) )
- ZTEMPZ(:)=STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMP(:,:,:) )
- ZRHODREFZ(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PRHODREF(:,:,:) )
- ZCIT(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PCIT(:,:,:) )
- IF (CCLOUD=="LIMA") THEN
- ZCCI(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NI) )
- ZCCR(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NR) )
- ZCCC(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NC) )
- END IF
- DO JLOOP=3,6
- ZRZ(:,JLOOP)=STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,JLOOP) )
- END DO
- IF (CSURF=="EXTE") THEN
- DO JK=1,IKU
- ZRZ(JK,2)=STATPROF_INTERP_2D( TPROFILERS(JP), PR(:,:,JK,2)*PSEA(:,:) ) ! becomes cloud mixing ratio over sea
- ZRZ(JK,7)=STATPROF_INTERP_2D( TPROFILERS(JP), PR(:,:,JK,2)*(1.-PSEA(:,:)) ) ! becomes cloud mixing ratio over land
- END DO
- ELSE
- ZRZ(:,2)=STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,2) )
- ZRZ(:,7)=0.
- END IF
- ALLOCATE(ZAELOC(IKU))
- !
- ZAELOC(:)=0.
- ! initialization of quadrature points and weights
- ALLOCATE(ZX(JPTS_GAULAG),ZW(JPTS_GAULAG))
- CALL GAULAG(JPTS_GAULAG,ZX,ZW) ! for integration over diameters
- ! initialize minimum values
- ALLOCATE(ZRTMIN(SIZE(PR,4)+1))
- IF (CCLOUD == 'LIMA') THEN
- ZRTMIN(2)=XRTMIN_L(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_L(3)
- ZRTMIN(4)=XRTMIN_L(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_L(6)
- ZRTMIN(7)=XRTMIN_L(2) ! cloud water over land
- ELSE
- ZRTMIN(2)=XRTMIN_I(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_I(3)
- ZRTMIN(4)=XRTMIN_I(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_I(6)
- ZRTMIN(7)=XRTMIN_I(2) ! cloud water over land
- END IF
- ! compute cloud radar reflectivity from vertical profiles of temperature
- ! and mixing ratios
- DO JK=1,IKU
- QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- DO JLOOP=2,7
- IF (CCLOUD == 'LIMA') THEN
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCCI(JK)>0.).AND.&
- (JLOOP.NE.3.OR.ZCCR(JK)>0.).AND.((JLOOP.NE.2.AND.JLOOP.NE.7).OR.ZCCC(JK)>0.))
- ELSE
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCIT(JK)>0.))
- END IF
- IF (GCALC) THEN
- SELECT CASE(JLOOP)
- CASE(2) ! cloud water over sea
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_SEA
- ZCX=0.
- ZALPHA=XALPHAC2_I
- ZNU=XNUC2_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- END IF
- CASE(3) ! rain water
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAR_L
- ZB=XBR_L
- ZCC=ZCCR(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAR_L
- ZNU=XNUR_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAR_I
- ZB=XBR_I
- ZCC=XCCR_I
- ZCX=-1.
- ZALPHA=XALPHAR_I
- ZNU=XNUR_I
- ZLB=XLBR_I
- ZLBEX=XLBEXR_I
- END IF
- CASE(4) ! pristine ice
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAI_L
- ZB=XBI_L
- ZCC=ZCCI(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAI_L
- ZNU=XNUI_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ELSE
- ZA=XAI_I
- ZB=XBI_I
- ZCC=ZCIT(JK)
- ZCX=0.
- ZALPHA=XALPHAI_I
- ZNU=XNUI_I
- ZLBEX=XLBEXI_I
- ZLB=XLBI_I*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- END IF
- CASE(5) ! snow
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAS_L
- ZB=XBS_L
- ZCC=XCCS_L
- ZCX=XCXS_L
- ZALPHA=XALPHAS_L
- ZNU=XNUS_L
- ZNS=XNS_L
- ZLB=XLBS_L
- ZLBEX=XLBEXS_L
- ZFW=0
- ELSE
- ZA=XAS_I
- ZB=XBS_I
- ZCC=XCCS_I
- ZCX=XCXS_I
- ZALPHA=XALPHAS_I
- ZNU=XNUS_I
- ZNS=XNS_I
- ZLB=XLBS_I
- ZLBEX=XLBEXS_I
- ZFW=0
- END IF
- CASE(6) ! graupel
- !If temperature between -10 and 10B0C and Mr and Mg over min
- !threshold: melting graupel
- ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel
- ! (Fw=0)
- IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
- .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
- ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
- ELSE
- ZFW=0
- END IF
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAG_L
- ZB=XBG_L
- ZCC=XCCG_L
- ZCX=XCXG_L
- ZALPHA=XALPHAG_L
- ZNU=XNUG_L
- ZLB=XLBG_L
- ZLBEX=XLBEXG_L
- ELSE
- ZA=XAG_I
- ZB=XBG_I
- ZCC=XCCG_I
- ZCX=XCXG_I
- ZALPHA=XALPHAG_I
- ZNU=XNUG_I
- ZLB=XLBG_I
- ZLBEX=XLBEXG_I
- END IF
- CASE(7) ! cloud water over land
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_LAND
- ZCX=0.
- ZALPHA=XALPHAC_I
- ZNU=XNUC_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- END IF
- END SELECT
- IF ( JLOOP == 5 .AND. CCLOUD=='LIMA'.AND.LSNOW_T_L ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE IF (JLOOP.EQ.5 .AND. (CCLOUD=='ICE3'.AND.LSNOW_T_I) ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE
- ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
- ZN=ZCC*ZLBDA**ZCX
- END IF
- ZREFLOC=0.
- ZAETMP=0.
- DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
- ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
- SELECT CASE(JLOOP)
- CASE(2,3,7)
- QM=QMW
- CASE(4,5,6)
- ! pristine ice, snow, dry graupel
- ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
- QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
- ! water inclusions in ice in air
- QEPSWI=MG(QMW**2,QM**2,ZFW)
- ! ice in air inclusions in water
- QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
- !MG weighted rule (Matrosov 2008)
- IF(ZFW .LT. 0.37) THEN
- ZFPW=0
- ELSE IF(ZFW .GT. 0.63) THEN
- ZFPW=1
- ELSE
- ZFPW=(ZFW-0.37)/(0.63-0.37)
- ENDIF
- QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
- END SELECT
- CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
- ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- END DO
- ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZN/(4.*GAMMA(ZNU)*.93)
- ZAETMP=ZAETMP * XPI *ZN/(4.*GAMMA(ZNU))
- TPROFILERS(JP)%XCRARE(IN,JK)=TPROFILERS(JP)%XCRARE(IN,JK)+ZREFLOC
- ZAELOC(JK)=ZAELOC(JK)+ZAETMP
- END IF
- END DO
- END DO
- ! apply attenuation
- ALLOCATE(ZZMZ(IKU))
- ZZMZ = ZZ(:) ! STATPROF_INTERP_3D( TPROFILERS(JP), ZZM(:,:,:) )
-! ZZMZ(1)=ZZM_STAT
- ! zenith
- ZAETOT=1.
- DO JK = 2,IKU
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK-1)+ZAELOC(JK))*(ZZMZ(JK)-ZZMZ(JK-1)))
- TPROFILERS(JP)%XCRARE_ATT(IN,JK)=TPROFILERS(JP)%XCRARE(IN,JK)*ZAETOT
- END DO
- DEALLOCATE(ZZMZ,ZAELOC)
- ! m^3 b mm^6/m^3 b dBZ
- WHERE(TPROFILERS(JP)%XCRARE(IN,:)>0)
- TPROFILERS(JP)%XCRARE(IN,:)=10.*LOG10(1.E18*TPROFILERS(JP)%XCRARE(IN,:))
- ELSEWHERE
- TPROFILERS(JP)%XCRARE(IN,:)=XUNDEF
- END WHERE
- WHERE(TPROFILERS(JP)%XCRARE_ATT(IN,:)>0)
- TPROFILERS(JP)%XCRARE_ATT(IN,:)=10.*LOG10(1.E18*TPROFILERS(JP)%XCRARE_ATT(IN,:))
- ELSEWHERE
- TPROFILERS(JP)%XCRARE_ATT(IN,:)=XUNDEF
- END WHERE
- DEALLOCATE(ZX,ZW,ZRTMIN)
- END IF ! end LOOP ICE3
-! end add RARE
-!!
- TPROFILERS(JP)%XP (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PP )
+ TPROFILERS(JP)%XZON (:,IN) = ZU_PROFILER(:) * COS(ZGAM) + ZV_PROFILER(:) * SIN(ZGAM)
+ TPROFILERS(JP)%XMER (:,IN) = - ZU_PROFILER(:) * SIN(ZGAM) + ZV_PROFILER(:) * COS(ZGAM)
+ TPROFILERS(JP)%XFF (:,IN) = ZFF(:)
+ TPROFILERS(JP)%XDD (:,IN) = ZDD(:)
+ TPROFILERS(JP)%XW (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PW )
+ TPROFILERS(JP)%XTH (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTH )
+ TPROFILERS(JP)%XTHV (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTHV )
+ IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) &
+ TPROFILERS(JP)%XVISIGUL(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZVISIGUL )
+ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) &
+ TPROFILERS(JP)%XVISIKUN(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZVISIKUN )
+ TPROFILERS(JP)%XZZ (:,IN) = ZZ(:)
+ TPROFILERS(JP)%XRHOD(:,IN) = ZRHOD(:)
+ IF (CCLOUD=="LIMA") THEN
+ TPROFILERS(JP)%XCIZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NI) )
+ TPROFILERS(JP)%XCCZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NC) )
+ TPROFILERS(JP)%XCRZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NR) )
+ ELSE IF ( CCLOUD=="ICE3" .OR. CCLOUD=="ICE4" ) THEN
+ TPROFILERS(JP)%XCIZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PCIT )
+ END IF
+
+ CALL Sensor_wc_compute( TPROFILERS(JP), IN, PR, PRHODREF )
+ CALL Sensor_rare_compute( TPROFILERS(JP), IN, PR, PSV, PRHODREF, PCIT, ZTEMP, ZZ, PSEA )
+ !!
+ TPROFILERS(JP)%XP (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PP )
!
DO JSV=1,SIZE(PR,4)
- TPROFILERS(JP)%XR (IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,JSV) )
+ TPROFILERS(JP)%XR (:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,JSV) )
END DO
ZWORK(:,:,:,:)=PSV(:,:,:,:)
ZWORK(:,:,1,:)=PSV(:,:,2,:)
DO JSV=1,SIZE(PSV,4)
- TPROFILERS(JP)%XSV (IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), ZWORK(:,:,:,JSV) )
+ TPROFILERS(JP)%XSV (:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZWORK(:,:,:,JSV) )
END DO
ZWORK2(:,:,:,:) = 0.
DO JK=IKB,IKE
@@ -686,34 +365,19 @@ PROFILER: DO JP = 1, NUMBPROFILER_LOC
ZWORK2(:,:,JK,:)=PAER(:,:,IKRAD,:)
END DO
DO JSV=1,SIZE(PAER,4)
- TPROFILERS(JP)%XAER(IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), ZWORK2(:,:,:,JSV) )
+ TPROFILERS(JP)%XAER(:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZWORK2(:,:,:,JSV) )
END DO
- IF (SIZE(PTKE)>0) TPROFILERS(JP)%XTKE (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PTKE )
+ IF (SIZE(PTKE)>0) TPROFILERS(JP)%XTKE (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTKE )
+
+ ! XRHOD_SENSOR is not computed for profilers because not very useful
+ ! If needed, the interpolation must also be done vertically
+ ! (and therefore the vertical interpolation coefficients have to be computed)
+ ! TPROFILERS(JP)%XRHOD_SENSOR(IN) = ...
+
+ IF ( CRAD /= 'NONE' ) TPROFILERS(JP)%XTSRAD(IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTS )
!
- IF ( LDIAG_SURFRAD_PROF ) THEN
- TPROFILERS(JP)%XT2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_T2M )
- TPROFILERS(JP)%XQ2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_Q2M )
- TPROFILERS(JP)%XHU2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_HU2M )
- TPROFILERS(JP)%XZON10M(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_ZON10M )
- TPROFILERS(JP)%XMER10M(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_MER10M )
- TPROFILERS(JP)%XRN (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_RN )
- TPROFILERS(JP)%XH (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_H )
- TPROFILERS(JP)%XLE (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LE )
- TPROFILERS(JP)%XLEI (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LEI )
- TPROFILERS(JP)%XGFLUX (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_GFLUX )
- IF (CRAD /= 'NONE') THEN
- TPROFILERS(JP)%XSWD (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SWD )
- TPROFILERS(JP)%XSWU (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SWU )
- TPROFILERS(JP)%XLWD (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LWD )
- TPROFILERS(JP)%XLWU (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LWU )
- TPROFILERS(JP)%XSWDIR (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SWDIR )
- TPROFILERS(JP)%XSWDIFF(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SWDIFF )
- TPROFILERS(JP)%XDSTAOD(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_DSTAOD )
- TPROFILERS(JP)%XSLTAOD(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SLTAOD )
- END IF
- TPROFILERS(JP)%XSFCO2 (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SFCO2 )
- END IF
- TPROFILERS(JP)%XTKE_DISS(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), XCURRENT_TKE_DISS )
+ IF ( LDIAG_SURFRAD_PROF ) CALL STATPROF_DIAG_SURFRAD(TPROFILERS(JP), IN )
+ TPROFILERS(JP)%XTKE_DISS(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( XCURRENT_TKE_DISS )
END DO PROFILER
!
!----------------------------------------------------------------------------
diff --git a/src/MNH/read_all_data_grib_case.f90 b/src/MNH/read_all_data_grib_case.f90
index 4e03378378ef394b67c2644ca79352602f39b2e6..14925cb2b28bbcf29a381cf01af447266e21b9dd 100644
--- a/src/MNH/read_all_data_grib_case.f90
+++ b/src/MNH/read_all_data_grib_case.f90
@@ -714,6 +714,10 @@ DEALLOCATE (ZLNPS_G)
!
WRITE (ILUOUT0,'(A)') ' | Reading T and Q fields'
!
+IF (IMODEL==11) THEN
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=130,KLEV1=1000) !look for air temperature at pressure level 1000hPa
+ IF (INUM < 0) IMODEL = 0 ! This change is for handling IFS model level grib file obtained by python API
+END IF
IF (IMODEL/=10.AND.IMODEL/=11) THEN
SELECT CASE (IMODEL)
CASE(0) ! ECMWF
diff --git a/src/MNH/read_chem_data_netcdf_case.f90 b/src/MNH/read_chem_data_netcdf_case.f90
index 2648709e0c93aed6ecd7ca7c21a4727a94d9881b..f55fe1f28bfeeac1d67c04d6975e47be7ccce3df 100644
--- a/src/MNH/read_chem_data_netcdf_case.f90
+++ b/src/MNH/read_chem_data_netcdf_case.f90
@@ -175,7 +175,7 @@ INTEGER(kind=CDFINT) :: ind_netcdf ! Indice for netcdf var.
INTEGER :: ICHANNEL
CHARACTER(LEN=8) :: YMOZ="MOZ1.nam"
integer :: IMOZ
-CHARACTER(LEN=68) :: YFORMAT
+CHARACTER(LEN=100) :: YFORMAT
CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YSPCMNH
integer, dimension(:), ALLOCATABLE :: ISPCMOZ
CHARACTER(LEN=9) :: YA
diff --git a/src/MNH/read_desfmn.f90 b/src/MNH/read_desfmn.f90
index ce23cbb2ccae0f1e9151fd117335a597a91d865d..ea6c0f70474357cbcaf5ec8b0dcc33e18b51eecd 100644
--- a/src/MNH/read_desfmn.f90
+++ b/src/MNH/read_desfmn.f90
@@ -266,8 +266,6 @@ USE MODN_LATZ_EDFLX
USE MODN_2D_FRC
USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
-USE MODN_PROFILER_n, LDIAG_SURFRAD_PROF => LDIAG_SURFRAD
-USE MODN_STATION_n, LDIAG_SURFRAD_STAT => LDIAG_SURFRAD
!
USE MODN_PARAM_LIMA
! USE MODN_FLYERS
@@ -481,18 +479,20 @@ IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_BLANKn)
CALL UPDATE_NAM_BLANKn
END IF
-CALL POSNAM( TZDESFILE, 'NAM_PROFILERN', GFOUND )
-CALL INIT_NAM_PROFILERn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_PROFILERN)
- CALL UPDATE_NAM_PROFILERn
-END IF
-CALL POSNAM( TZDESFILE, 'NAM_STATIONN', GFOUND )
-CALL INIT_NAM_STATIONn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_STATIONn)
- CALL UPDATE_NAM_STATIONn
-END IF
+! Note: it is not useful to read the PROFILERS/STATIONS namelists in the .des files
+! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
+! CALL POSNAM( TZDESFILE, 'NAM_PROFILERN', GFOUND )
+! CALL INIT_NAM_PROFILERn
+! IF (GFOUND) THEN
+! READ(UNIT=ILUDES,NML=NAM_PROFILERN)
+! CALL UPDATE_NAM_PROFILERn
+! END IF
+! CALL POSNAM( TZDESFILE, 'NAM_STATIONN', GFOUND )
+! CALL INIT_NAM_STATIONn
+! IF (GFOUND) THEN
+! READ(UNIT=ILUDES,NML=NAM_STATIONn)
+! CALL UPDATE_NAM_STATIONn
+! END IF
CALL POSNAM( TZDESFILE, 'NAM_FIREN', GFOUND )
CALL INIT_NAM_FIREn
IF (GFOUND) THEN
@@ -764,11 +764,12 @@ IF (NVERB >= 10) THEN
WRITE(UNIT=ILUOUT,FMT="('********** BLANKn ******************')")
WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
!
- WRITE(UNIT=ILUOUT,FMT="('********** PROFILERn *****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PROFILERn)
+! Profilers/stations namelists not read anymore in READ_DESFM_n
+! WRITE(UNIT=ILUOUT,FMT="('********** PROFILERn *****************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_PROFILERn)
!
- WRITE(UNIT=ILUOUT,FMT="('********** STATIONn ******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_STATIONn)
+! WRITE(UNIT=ILUOUT,FMT="('********** STATIONn ******************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_STATIONn)
!
WRITE(UNIT=ILUOUT,FMT="('********** BLAZE *******************')")
WRITE(UNIT=ILUOUT,NML=NAM_FIREn)
diff --git a/src/MNH/read_grid_time_mesonh_case.f90 b/src/MNH/read_grid_time_mesonh_case.f90
index fba1ea9e956b21a5e3ff451c4a86b8d9b2bce6aa..c6446d4eee6e6e45218af571350e429e4d80d5d2 100644
--- a/src/MNH/read_grid_time_mesonh_case.f90
+++ b/src/MNH/read_grid_time_mesonh_case.f90
@@ -150,8 +150,6 @@ TYPE(TFILEDATA),POINTER :: TZFMFILE => NULL()
ILUOUT0 = TLUOUT0%NLU
ZEPS=1.E-10
!
-!PW: TODO: temporary: look for file from its name
-! TPFMFILE should be passed in arguments
CALL IO_File_find_byname(HFMFILE,TZFMFILE,IRESP)
!
!* 1.1 Original FMfile name
diff --git a/src/MNH/saltcamsn.f90 b/src/MNH/saltcamsn.f90
index 1747bddc7934c3ada4267f7df353af05de3ab6e1..96dcde95d634c1a05a2ce9a284648bfd704ecc4c 100644
--- a/src/MNH/saltcamsn.f90
+++ b/src/MNH/saltcamsn.f90
@@ -135,6 +135,8 @@ DELTA_CAMS_3 = RAY_CAMS_4 - RAY_CAMS_3
! puis calcul de la masse correspondante avec facteur correctif pour eviter
! la surestimation des concentrations en aerosols
+ZMASS(:,:,:,1) = PMASSCAMS(:,:,:,1) * 1E-3
+
DELTA_1 = RAY_2 - RAY_CAMS_1
RATIO_1 = DELTA_1 / DELTA_CAMS_1
ZMASS(:,:,:,2) = PMASSCAMS(:,:,:,1) * RATIO_1 ! * 1E-2 ! Attribution Mode 2 ORILAM
@@ -159,18 +161,16 @@ DELTA_6 = 10 - RAY_CAMS_3
RATIO_6 = DELTA_3 / DELTA_CAMS_1
ZMASS(:,:,:,5) = (PMASSCAMS(:,:,:,3) * RATIO_6) + ZMASS(:,:,:,5) ! Attribution Mode 5 ter ORILAM
-ZMASS(:,:,:,5) = ZMASS(:,:,:,5) * 1E-1
-
-! Hyp : the ultrafine mode is neglected for orilam-lima coupling
-ZMASS(:,:,:,1) = PMASSCAMS(:,:,:,1) * 1E-5 ! ultrafin mode
-!
!========================================================
! Adjust the mass / SSA emissions after a few hours
-ZMASS(:,:,:,1) = ZMASS(:,:,:,1) * 1.
-ZMASS(:,:,:,2) = ZMASS(:,:,:,2) * 1.
-ZMASS(:,:,:,3) = ZMASS(:,:,:,3) * 1.
-ZMASS(:,:,:,4) = ZMASS(:,:,:,4) * 1.
-ZMASS(:,:,:,5) = ZMASS(:,:,:,5) * 1.
+ZMASS(:,:,:,1) = MAX(ZMASS(:,:,:,1) * 0.16, 1E-18)
+ZMASS(:,:,:,2) = MAX(ZMASS(:,:,:,2) * 0.1, 1E-17)
+ZMASS(:,:,:,3) = MAX(ZMASS(:,:,:,3) * 0.5, 1E-16)
+ZMASS(:,:,:,4) = MAX(ZMASS(:,:,:,4) * 0.1, 1E-16)
+ZMASS(:,:,:,5) = MAX(ZMASS(:,:,:,5), 1E-17)
+IF (NMODE_SLT >= 6) ZMASS(:,:,:,6) = MAX(ZMASS(:,:,:,5) * 0.01, 1E-16)
+IF (NMODE_SLT >= 7) ZMASS(:,:,:,7) = MAX(ZMASS(:,:,:,5) * 0.001, 1E-16)
+IF (NMODE_SLT >= 8) ZMASS(:,:,:,8) = MAX(ZMASS(:,:,:,5) * 0.0001, 1E-16)
!========================================================
DO JN = 1, NMODE_SLT
@@ -197,15 +197,11 @@ DO JN = 1, NMODE_SLT
ZMMIN(IM6(JN)) = XN0MIN_SLT(IMODEIDX) * (ZRGMIN**6)*EXP(18. * LOG(ZINISIGMA(JN))**2)
END DO
-
-ZMASS(:,:,:,:) = MAX(ZMASS(:,:,:,:), 1E-40)
-!
!
ZRHOI = XDENSITY_SALT
ZMI = XMOLARWEIGHT_SALT
ZDEN2MOL = 1E-6 * XAVOGADRO / XMD
ZFAC = (4. / 3.) * XPI * ZRHOI * 1.e-9
-
!
DO JN = 1, NMODE_SLT
@@ -225,13 +221,13 @@ DO JN = 1, NMODE_SLT
(ZINIRADIUS(JN)**3) * &
EXP(4.5*LOG(ZINISIGMA(JN))**2)
- ZM(:,:,:,IM3(JN)) = MAX(ZMMIN(IM3(JN)), ZM(:,:,:,IM3(JN)))
+! ZM(:,:,:,IM3(JN)) = MAX(ZMMIN(IM3(JN)), ZM(:,:,:,IM3(JN)))
!
!* 1.3 calculate moment 6 from m0, RG and SIG
!
ZM(:,:,:,IM6(JN))= ZM(:,:,:,IM0(JN)) * ((ZINIRADIUS(JN)**6)*&
EXP(18. * (LOG(ZINISIGMA(JN)))**2))
- ZM(:,:,:,IM6(JN)) = MAX(ZMMIN(IM6(JN)), ZM(:,:,:,IM6(JN)))
+! ZM(:,:,:,IM6(JN)) = MAX(ZMMIN(IM6(JN)), ZM(:,:,:,IM6(JN)))
!
!* 1.4 output concentration (in ppv)
!
diff --git a/src/MNH/stationn.f90 b/src/MNH/stationn.f90
index a9a08e66a8a54e80fd3ec5f53b7b7f90aee738c3..6ef64ccf5162ce40563307b5f51ed8cf50e71303 100644
--- a/src/MNH/stationn.f90
+++ b/src/MNH/stationn.f90
@@ -9,11 +9,12 @@ MODULE MODI_STATION_n
!
INTERFACE
!
- SUBROUTINE STATION_n( PZ, &
+ SUBROUTINE STATION_n( PZ, PRHODREF, &
PU, PV, PW, PTH, PR, PSV, PTKE, &
PTS, PP )
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry air density of the reference state
REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! horizontal wind X component
REAL, DIMENSION(:,:,:), INTENT(IN) :: PV ! horizontal wind Y component
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW ! vertical wind
@@ -33,7 +34,7 @@ END INTERFACE
END MODULE MODI_STATION_n
!
! #######################################################
- SUBROUTINE STATION_n( PZ, &
+ SUBROUTINE STATION_n( PZ, PRHODREF, &
PU, PV, PW, PTH, PR, PSV, PTKE, &
PTS, PP )
! #######################################################
@@ -85,13 +86,13 @@ END MODULE MODI_STATION_n
USE MODD_ALLSTATION_n, ONLY: LDIAG_SURFRAD_STAT
USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_CST, ONLY: XPI
-USE MODD_DIAG_IN_RUN
USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
USE MODD_PARAMETERS, ONLY: JPVEXT
USE MODD_PARAM_n, ONLY: CRAD
+USE MODD_SENSOR, ONLY: TSENSORTIME
USE MODD_STATION_n
!
-USE MODE_STATPROF_TOOLS, ONLY: STATPROF_INSTANT, STATPROF_INTERP_2D, STATPROF_INTERP_2D_U, STATPROF_INTERP_2D_V
+USE MODE_STATPROF_TOOLS, ONLY: STATPROF_DIAG_SURFRAD
!
!
IMPLICIT NONE
@@ -101,6 +102,7 @@ IMPLICIT NONE
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry air density of the reference state
REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! horizontal wind X component
REAL, DIMENSION(:,:,:), INTENT(IN) :: PV ! horizontal wind Y component
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW ! vertical wind
@@ -131,66 +133,47 @@ INTEGER :: JK ! loop for levels
!* 3.4 instant of storage
! ------------------
!
-CALL STATPROF_INSTANT( TSTATIONS_TIME, IN )
-IF ( IN < 1 ) RETURN !No profiler storage at this time step
+IF ( .NOT. TSTATIONS_TIME%STORESTEP_CHECK_AND_SET( IN ) ) RETURN !No profiler storage at this time step
!
!----------------------------------------------------------------------------
!
!* 8. DATA RECORDING
! --------------
!
-STATION: DO JS = 1,NUMBSTAT_LOC
+STATION: DO JS = 1, NUMBSTAT_LOC
+ TSTATIONS(JS)%NSTORE_CUR = IN
+
JK = TSTATIONS(JS)%NK
IF (LCARTESIAN) THEN
- TSTATIONS(JS)%XZON(IN) = STATPROF_INTERP_2D_U( TSTATIONS(JS), PU(:,:,JK) )
- TSTATIONS(JS)%XMER(IN) = STATPROF_INTERP_2D_V( TSTATIONS(JS), PV(:,:,JK) )
+ TSTATIONS(JS)%XZON(1,IN) = TSTATIONS(JS)%INTERP_HOR_FROM_UPOINT( PU(:,:,JK) )
+ TSTATIONS(JS)%XMER(1,IN) = TSTATIONS(JS)%INTERP_HOR_FROM_VPOINT( PV(:,:,JK) )
ELSE
- ZU_STAT = STATPROF_INTERP_2D_U( TSTATIONS(JS), PU(:,:,JK) )
- ZV_STAT = STATPROF_INTERP_2D_V( TSTATIONS(JS), PV(:,:,JK) )
- ZGAM = (XRPK * (TSTATIONS(JS)%XLON - XLON0) - XBETA)*(XPI/180.)
- TSTATIONS(JS)%XZON(IN) = ZU_STAT * COS(ZGAM) + ZV_STAT * SIN(ZGAM)
- TSTATIONS(JS)%XMER(IN) = - ZU_STAT * SIN(ZGAM) + ZV_STAT * COS(ZGAM)
+ ZU_STAT = TSTATIONS(JS)%INTERP_HOR_FROM_UPOINT( PU(:,:,JK) )
+ ZV_STAT = TSTATIONS(JS)%INTERP_HOR_FROM_VPOINT( PV(:,:,JK) )
+ ZGAM = (XRPK * (TSTATIONS(JS)%XLON_CUR - XLON0) - XBETA)*(XPI/180.)
+ TSTATIONS(JS)%XZON(1,IN) = ZU_STAT * COS(ZGAM) + ZV_STAT * SIN(ZGAM)
+ TSTATIONS(JS)%XMER(1,IN) = - ZU_STAT * SIN(ZGAM) + ZV_STAT * COS(ZGAM)
END IF
- TSTATIONS(JS)%XW (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), PW(:,:,JK) )
- TSTATIONS(JS)%XTH(IN) = STATPROF_INTERP_2D( TSTATIONS(JS), PTH(:,:,JK) )
- TSTATIONS(JS)%XP (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), PP(:,:,JK) )
+ TSTATIONS(JS)%XW (1,IN) = TSTATIONS(JS)%INTERP_HOR_FROM_MASSPOINT( PW(:,:,JK) )
+ TSTATIONS(JS)%XTH(1,IN) = TSTATIONS(JS)%INTERP_HOR_FROM_MASSPOINT( PTH(:,:,JK) )
+ TSTATIONS(JS)%XP (1,IN) = TSTATIONS(JS)%INTERP_HOR_FROM_MASSPOINT( PP(:,:,JK) )
DO JSV=1,SIZE(PR,4)
- TSTATIONS(JS)%XR(IN,JSV) = STATPROF_INTERP_2D( TSTATIONS(JS), PR(:,:,JK,JSV) )
+ TSTATIONS(JS)%XR(1,IN,JSV) = TSTATIONS(JS)%INTERP_HOR_FROM_MASSPOINT( PR(:,:,JK,JSV) )
END DO
DO JSV=1,SIZE(PSV,4)
- TSTATIONS(JS)%XSV(IN,JSV) = STATPROF_INTERP_2D( TSTATIONS(JS), PSV(:,:,JK,JSV) )
+ TSTATIONS(JS)%XSV(1,IN,JSV) = TSTATIONS(JS)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,JK,JSV) )
END DO
- IF (SIZE(PTKE)>0) TSTATIONS(JS)%XTKE(IN) = STATPROF_INTERP_2D( TSTATIONS(JS), PTKE(:,:,JK) )
- IF ( CRAD /= 'NONE' ) TSTATIONS(JS)%XTSRAD(IN) = STATPROF_INTERP_2D( TSTATIONS(JS), PTS )
- TSTATIONS(JS)%XZS = STATPROF_INTERP_2D( TSTATIONS(JS), PZ(:,:,1+JPVEXT))
+ TSTATIONS(JS)%XRHOD_SENSOR(IN) = TSTATIONS(JS)%INTERP_HOR_FROM_MASSPOINT( PRHODREF(:,:,JK) )
- IF ( LDIAG_SURFRAD_STAT ) THEN
- TSTATIONS(JS)%XZON10M(IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_ZON10M )
- TSTATIONS(JS)%XMER10M(IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_MER10M )
- TSTATIONS(JS)%XT2M (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_T2M )
- TSTATIONS(JS)%XQ2M (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_Q2M )
- TSTATIONS(JS)%XHU2M (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_HU2M )
- TSTATIONS(JS)%XRN (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_RN )
- TSTATIONS(JS)%XH (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_H )
- TSTATIONS(JS)%XLE (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_LE )
- TSTATIONS(JS)%XLEI (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_LEI )
- TSTATIONS(JS)%XGFLUX (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_GFLUX )
- IF ( CRAD /= 'NONE' ) THEN
- TSTATIONS(JS)%XSWD (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_SWD )
- TSTATIONS(JS)%XSWU (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_SWU )
- TSTATIONS(JS)%XLWD (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_LWD )
- TSTATIONS(JS)%XLWU (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_LWU )
- TSTATIONS(JS)%XSWDIR (IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_SWDIR )
- TSTATIONS(JS)%XSWDIFF(IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_SWDIFF )
- TSTATIONS(JS)%XDSTAOD(IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_DSTAOD )
- TSTATIONS(JS)%XSLTAOD(IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_SLTAOD )
- END IF
- TSTATIONS(JS)%XSFCO2(IN) = STATPROF_INTERP_2D( TSTATIONS(JS), XCURRENT_SFCO2 )
- END IF
+ IF (SIZE(PTKE)>0) TSTATIONS(JS)%XTKE(1,IN) = TSTATIONS(JS)%INTERP_HOR_FROM_MASSPOINT( PTKE(:,:,JK) )
+ IF ( CRAD /= 'NONE' ) TSTATIONS(JS)%XTSRAD(IN) = TSTATIONS(JS)%INTERP_HOR_FROM_MASSPOINT( PTS )
+ TSTATIONS(JS)%XZS = TSTATIONS(JS)%INTERP_HOR_FROM_MASSPOINT( PZ(:,:,1+JPVEXT))
+
+ IF ( LDIAG_SURFRAD_STAT ) CALL STATPROF_DIAG_SURFRAD( TSTATIONS(JS), IN )
END DO STATION
!
!----------------------------------------------------------------------------
diff --git a/src/MNH/statprof_reader.f90 b/src/MNH/statprof_reader.f90
index 43a7168d24eb98fcd4d72e5197ff50a857f80114..bc3b8dd99ecd84c31314a618516344115ce43bce 100644
--- a/src/MNH/statprof_reader.f90
+++ b/src/MNH/statprof_reader.f90
@@ -88,9 +88,9 @@ DO
CALL FRENCH_TO_ENGLISH( YSTRING )
IF ( LCARTESIAN ) THEN
- READ( YSTRING, * ) TZSTATPROF%CNAME, TZSTATPROF%XX, TZSTATPROF%XY, TZSTATPROF%XZ
+ READ( YSTRING, * ) TZSTATPROF%CNAME, TZSTATPROF%XX_CUR, TZSTATPROF%XY_CUR, TZSTATPROF%XZ_CUR
ELSE
- READ( YSTRING, * ) TZSTATPROF%CNAME, TZSTATPROF%XLAT, TZSTATPROF%XLON, TZSTATPROF%XZ
+ READ( YSTRING, * ) TZSTATPROF%CNAME, TZSTATPROF%XLAT_CUR, TZSTATPROF%XLON_CUR, TZSTATPROF%XZ_CUR
END IF
IF ( .NOT. LCARTESIAN ) CALL STATPROF_INI_INTERP( TZSTATPROF )
diff --git a/src/MNH/statprof_tools.f90 b/src/MNH/statprof_tools.f90
index f7e0e7596480f238e84f28cf092b60db764c6f08..ebcf9661819321dab44a4114b59be2921bd58d87 100644
--- a/src/MNH/statprof_tools.f90
+++ b/src/MNH/statprof_tools.f90
@@ -10,264 +10,26 @@
! Modifications:
! P. Wautelet 30/09/2022: bugfix: use XUNDEF from SURFEX for surface variables computed by SURFEX
! P. Wautelet 25/11/2022: rewrite STATPROF_INSTANT algorithm (does not depends on model timestep anymore => independent of model)
+! P. Wautelet 24/05/2023: move TSTATPROF_TIME and STATPROF_INSTANT to modd_sensor (+ rename them)
!-----------------------------------------------------------------
! ###################
MODULE MODE_STATPROF_TOOLS
! ###################
-USE MODD_TYPE_STATPROF, ONLY: TPROFILERDATA, TSTATIONDATA, TSTATPROFDATA, TSTATPROFTIME
+USE MODD_TYPE_STATPROF, ONLY: TPROFILERDATA, TSTATIONDATA, TSTATPROFDATA
IMPLICIT NONE
PRIVATE
-PUBLIC :: PROFILER_ALLOCATE, STATION_ALLOCATE
PUBLIC :: STATPROF_INI_INTERP
PUBLIC :: STATPROF_POSITION
PUBLIC :: PROFILER_ADD, STATION_ADD
-PUBLIC :: STATPROF_INTERP_2D, STATPROF_INTERP_2D_U, STATPROF_INTERP_2D_V
-PUBLIC :: STATPROF_INTERP_3D, STATPROF_INTERP_3D_U, STATPROF_INTERP_3D_V
-PUBLIC :: STATPROF_INSTANT
+PUBLIC :: STATPROF_DIAG_SURFRAD
+PUBLIC :: ADD_DIAG_SURFRAD_DATA
CONTAINS
-! ################################################
-SUBROUTINE PROFILER_ALLOCATE( TPPROFILER, KSTORE )
-! ################################################
-
- USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
- USE MODD_CONF_n, ONLY: NRR
- USE MODD_DIM_n, ONLY: NKMAX
- USE MODD_NSV, ONLY: NSV
- USE MODD_PARAMETERS, ONLY: JPVEXT, XUNDEF
- USE MODD_PARAM_n, ONLY: CCLOUD, CRAD, CTURB
- USE MODD_RADIATIONS_n, ONLY: NAER
- USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
-
- IMPLICIT NONE
-
- TYPE(TPROFILERDATA), INTENT(INOUT) :: TPPROFILER
- INTEGER, INTENT(IN) :: KSTORE ! number of moments to store
-
- INTEGER :: IKU
-
- IKU = NKMAX + 2 * JPVEXT
- ALLOCATE( TPPROFILER%XZON (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XMER (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XFF (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XDD (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XW (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XP (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XZZ (KSTORE, IKU) )
- IF ( CTURB == 'TKEL' ) THEN
- ALLOCATE( TPPROFILER%XTKE (KSTORE, IKU) )
- ELSE
- ALLOCATE( TPPROFILER%XTKE (0, 0) )
- END IF
- ALLOCATE( TPPROFILER%XTH (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XTHV (KSTORE, IKU) )
- IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) THEN
- ALLOCATE( TPPROFILER%XVISIGUL (KSTORE, IKU) )
- ELSE
- ALLOCATE( TPPROFILER%XVISIGUL (0, 0) )
- END IF
- IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
- ALLOCATE( TPPROFILER%XVISIKUN (KSTORE, IKU) )
- ELSE
- ALLOCATE( TPPROFILER%XVISIKUN (0, 0) )
- END IF
- ALLOCATE( TPPROFILER%XCRARE (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XCRARE_ATT(KSTORE, IKU) )
- IF ( CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4' ) THEN
- ALLOCATE( TPPROFILER%XCIZ (KSTORE, IKU) )
- ELSE
- ALLOCATE( TPPROFILER%XCIZ (0, 0) )
- END IF
- ALLOCATE( TPPROFILER%XLWCZ (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XIWCZ (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XRHOD (KSTORE, IKU) )
- ALLOCATE( TPPROFILER%XR (KSTORE, IKU, NRR) )
- ALLOCATE( TPPROFILER%XSV (KSTORE, IKU, NSV) )
- ALLOCATE( TPPROFILER%XAER (KSTORE, IKU, NAER) )
-
- ALLOCATE( TPPROFILER%XIWV(KSTORE) )
- ALLOCATE( TPPROFILER%XZTD(KSTORE) )
- ALLOCATE( TPPROFILER%XZWD(KSTORE) )
- ALLOCATE( TPPROFILER%XZHD(KSTORE) )
-
- IF ( LDIAG_SURFRAD_PROF ) THEN
- ALLOCATE( TPPROFILER%XT2M (KSTORE) )
- ALLOCATE( TPPROFILER%XQ2M (KSTORE) )
- ALLOCATE( TPPROFILER%XHU2M (KSTORE) )
- ALLOCATE( TPPROFILER%XZON10M(KSTORE) )
- ALLOCATE( TPPROFILER%XMER10M(KSTORE) )
- ALLOCATE( TPPROFILER%XRN (KSTORE) )
- ALLOCATE( TPPROFILER%XH (KSTORE) )
- ALLOCATE( TPPROFILER%XLE (KSTORE) )
- ALLOCATE( TPPROFILER%XLEI (KSTORE) )
- ALLOCATE( TPPROFILER%XGFLUX (KSTORE) )
- IF ( CRAD /= 'NONE' ) THEN
- ALLOCATE( TPPROFILER%XSWD (KSTORE) )
- ALLOCATE( TPPROFILER%XSWU (KSTORE) )
- ALLOCATE( TPPROFILER%XLWD (KSTORE) )
- ALLOCATE( TPPROFILER%XLWU (KSTORE) )
- ALLOCATE( TPPROFILER%XSWDIR (KSTORE) )
- ALLOCATE( TPPROFILER%XSWDIFF(KSTORE) )
- ALLOCATE( TPPROFILER%XDSTAOD(KSTORE) )
- ALLOCATE( TPPROFILER%XSLTAOD(KSTORE) )
- END IF
- ALLOCATE( TPPROFILER%XSFCO2 (KSTORE) )
- END IF
-
- ALLOCATE( TPPROFILER%XTKE_DISS(KSTORE, IKU) )
-
- TPPROFILER%XZON (:,:) = XUNDEF
- TPPROFILER%XMER (:,:) = XUNDEF
- TPPROFILER%XFF (:,:) = XUNDEF
- TPPROFILER%XDD (:,:) = XUNDEF
- TPPROFILER%XW (:,:) = XUNDEF
- TPPROFILER%XP (:,:) = XUNDEF
- TPPROFILER%XZZ (:,:) = XUNDEF
- IF ( CTURB == 'TKEL' ) TPPROFILER%XTKE(:,:) = XUNDEF
- TPPROFILER%XTH (:,:) = XUNDEF
- TPPROFILER%XTHV (:,:) = XUNDEF
- IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) TPPROFILER%XVISIGUL(:,:) = XUNDEF
- IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) TPPROFILER%XVISIKUN(:,:) = XUNDEF
- TPPROFILER%XCRARE (:,:) = XUNDEF
- TPPROFILER%XCRARE_ATT(:,:) = XUNDEF
- IF ( CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4' ) TPPROFILER%XCIZ (:,:) = XUNDEF
- TPPROFILER%XLWCZ (:,:) = XUNDEF
- TPPROFILER%XIWCZ (:,:) = XUNDEF
- TPPROFILER%XRHOD (:,:) = XUNDEF
- TPPROFILER%XR (:,:,:) = XUNDEF
- TPPROFILER%XSV (:,:,:) = XUNDEF
- TPPROFILER%XAER (:,:,:) = XUNDEF
-
- TPPROFILER%XIWV(:) = XUNDEF
- TPPROFILER%XZTD(:) = XUNDEF
- TPPROFILER%XZWD(:) = XUNDEF
- TPPROFILER%XZHD(:) = XUNDEF
-
- IF ( LDIAG_SURFRAD_PROF ) THEN
- TPPROFILER%XT2M (:) = XUNDEF_SFX
- TPPROFILER%XQ2M (:) = XUNDEF_SFX
- TPPROFILER%XHU2M (:) = XUNDEF_SFX
- TPPROFILER%XZON10M(:) = XUNDEF_SFX
- TPPROFILER%XMER10M(:) = XUNDEF_SFX
- TPPROFILER%XRN (:) = XUNDEF_SFX
- TPPROFILER%XH (:) = XUNDEF_SFX
- TPPROFILER%XLE (:) = XUNDEF_SFX
- TPPROFILER%XLEI (:) = XUNDEF_SFX
- TPPROFILER%XGFLUX (:) = XUNDEF_SFX
- IF ( CRAD /= 'NONE' ) THEN
- TPPROFILER%XSWD (:) = XUNDEF
- TPPROFILER%XSWU (:) = XUNDEF
- TPPROFILER%XLWD (:) = XUNDEF
- TPPROFILER%XLWU (:) = XUNDEF
- TPPROFILER%XSWDIR (:) = XUNDEF
- TPPROFILER%XSWDIFF(:) = XUNDEF
- TPPROFILER%XDSTAOD(:) = XUNDEF
- TPPROFILER%XSLTAOD(:) = XUNDEF
- END IF
- TPPROFILER%XSFCO2(:) = XUNDEF
- END IF
-
- TPPROFILER%XTKE_DISS(:,:) = XUNDEF
-
-END SUBROUTINE PROFILER_ALLOCATE
-
-! ##############################################
-SUBROUTINE STATION_ALLOCATE( TPSTATION, KSTORE )
-! ##############################################
-
- USE MODD_ALLSTATION_n, ONLY: LDIAG_SURFRAD_STAT
- USE MODD_CONF_n, ONLY: NRR
- USE MODD_NSV, ONLY: NSV
- USE MODD_PARAMETERS, ONLY: XUNDEF
- USE MODD_PARAM_n, ONLY: CRAD, CTURB
- USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
-
- IMPLICIT NONE
-
- TYPE(TSTATIONDATA), INTENT(INOUT) :: TPSTATION
- INTEGER, INTENT(IN) :: KSTORE ! number of moments to store
-
- ALLOCATE( TPSTATION%XZON(KSTORE) )
- ALLOCATE( TPSTATION%XMER(KSTORE) )
- ALLOCATE( TPSTATION%XW (KSTORE) )
- ALLOCATE( TPSTATION%XP (KSTORE) )
- IF ( CTURB == 'TKEL' ) THEN
- ALLOCATE( TPSTATION%XTKE(KSTORE) )
- ELSE
- ALLOCATE( TPSTATION%XTKE(0) )
- END IF
- ALLOCATE( TPSTATION%XTH(KSTORE) )
- ALLOCATE( TPSTATION%XR (KSTORE, NRR) )
- ALLOCATE( TPSTATION%XSV(KSTORE, NSV) )
- IF ( CRAD /= 'NONE' ) THEN
- ALLOCATE( TPSTATION%XTSRAD(KSTORE) )
- ELSE
- ALLOCATE( TPSTATION%XTSRAD(0) )
- END IF
- IF ( LDIAG_SURFRAD_STAT ) THEN
- ALLOCATE( TPSTATION%XT2M (KSTORE) )
- ALLOCATE( TPSTATION%XQ2M (KSTORE) )
- ALLOCATE( TPSTATION%XHU2M (KSTORE) )
- ALLOCATE( TPSTATION%XZON10M(KSTORE) )
- ALLOCATE( TPSTATION%XMER10M(KSTORE) )
- ALLOCATE( TPSTATION%XRN (KSTORE) )
- ALLOCATE( TPSTATION%XH (KSTORE) )
- ALLOCATE( TPSTATION%XLE (KSTORE) )
- ALLOCATE( TPSTATION%XLEI (KSTORE) )
- ALLOCATE( TPSTATION%XGFLUX (KSTORE) )
- IF ( CRAD /= 'NONE' ) THEN
- ALLOCATE( TPSTATION%XSWD (KSTORE) )
- ALLOCATE( TPSTATION%XSWU (KSTORE) )
- ALLOCATE( TPSTATION%XLWD (KSTORE) )
- ALLOCATE( TPSTATION%XLWU (KSTORE) )
- ALLOCATE( TPSTATION%XSWDIR (KSTORE) )
- ALLOCATE( TPSTATION%XSWDIFF(KSTORE) )
- ALLOCATE( TPSTATION%XDSTAOD(KSTORE) )
- ALLOCATE( TPSTATION%XSLTAOD(KSTORE) )
- END IF
- ALLOCATE( TPSTATION%XSFCO2(KSTORE) )
- END IF
-
- TPSTATION%XZON(:) = XUNDEF
- TPSTATION%XMER(:) = XUNDEF
- TPSTATION%XW(:) = XUNDEF
- TPSTATION%XP(:) = XUNDEF
- TPSTATION%XTKE(:) = XUNDEF
- TPSTATION%XTH(:) = XUNDEF
- TPSTATION%XR(:,:) = XUNDEF
- TPSTATION%XSV(:,:) = XUNDEF
- TPSTATION%XTSRAD(:) = XUNDEF
- IF ( LDIAG_SURFRAD_STAT ) THEN
- TPSTATION%XT2M(:) = XUNDEF_SFX
- TPSTATION%XQ2M(:) = XUNDEF_SFX
- TPSTATION%XHU2M(:) = XUNDEF_SFX
- TPSTATION%XZON10M(:) = XUNDEF_SFX
- TPSTATION%XMER10M(:) = XUNDEF_SFX
- TPSTATION%XRN(:) = XUNDEF_SFX
- TPSTATION%XH(:) = XUNDEF_SFX
- TPSTATION%XLE(:) = XUNDEF_SFX
- TPSTATION%XLEI(:) = XUNDEF_SFX
- TPSTATION%XGFLUX(:) = XUNDEF_SFX
- IF ( CRAD /= 'NONE' ) THEN
- TPSTATION%XSWD(:) = XUNDEF
- TPSTATION%XSWU(:) = XUNDEF
- TPSTATION%XLWD(:) = XUNDEF
- TPSTATION%XLWU(:) = XUNDEF
- TPSTATION%XSWDIR(:) = XUNDEF
- TPSTATION%XSWDIFF(:) = XUNDEF
- TPSTATION%XDSTAOD(:) = XUNDEF
- TPSTATION%XSLTAOD(:) = XUNDEF
- END IF
- TPSTATION%XSFCO2(:) = XUNDEF_SFX
- END IF
-
-END SUBROUTINE STATION_ALLOCATE
-
! ##########################################
SUBROUTINE STATPROF_INI_INTERP( TPSTATPROF )
! ##########################################
@@ -282,7 +44,7 @@ SUBROUTINE STATPROF_INI_INTERP( TPSTATPROF )
CLASS(TSTATPROFDATA), INTENT(INOUT) :: TPSTATPROF
- IF ( TPSTATPROF%XLAT == XUNDEF .OR. TPSTATPROF%XLON == XUNDEF ) THEN
+ IF ( TPSTATPROF%XLAT_CUR == XUNDEF .OR. TPSTATPROF%XLON_CUR == XUNDEF ) THEN
CMNHMSG(1) = 'Error in station or profiler position'
CMNHMSG(2) = 'either LATitude or LONgitude segment'
CMNHMSG(3) = 'or I and J segment'
@@ -290,9 +52,9 @@ SUBROUTINE STATPROF_INI_INTERP( TPSTATPROF )
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'STATPROF_INI_INTERP' )
END IF
- CALL SM_XYHAT( XLATORI, XLONORI, &
- TPSTATPROF%XLAT, TPSTATPROF%XLON, &
- TPSTATPROF%XX, TPSTATPROF%XY )
+ CALL SM_XYHAT( XLATORI, XLONORI, &
+ TPSTATPROF%XLAT_CUR, TPSTATPROF%XLON_CUR, &
+ TPSTATPROF%XX_CUR, TPSTATPROF%XY_CUR )
END SUBROUTINE STATPROF_INI_INTERP
@@ -330,8 +92,8 @@ SUBROUTINE STATPROF_POSITION( TPSTATPROF, OINSIDE, OPRESENT )
CALL GET_INDICE_ll( IIB, IJB, IIE, IJE )
- IF ( TPSTATPROF%XX >= XHAT_BOUND(NPHYS_XMIN) .AND. TPSTATPROF%XX <= XHAT_BOUND(NPHYS_XMAX) &
- .AND. TPSTATPROF%XY >= XHAT_BOUND(NPHYS_YMIN) .AND. TPSTATPROF%XY <= XHAT_BOUND(NPHYS_YMAX) ) THEN
+ IF ( TPSTATPROF%XX_CUR >= XHAT_BOUND(NPHYS_XMIN) .AND. TPSTATPROF%XX_CUR <= XHAT_BOUND(NPHYS_XMAX) &
+ .AND. TPSTATPROF%XY_CUR >= XHAT_BOUND(NPHYS_YMIN) .AND. TPSTATPROF%XY_CUR <= XHAT_BOUND(NPHYS_YMAX) ) THEN
OINSIDE = .TRUE.
ELSE
CALL GET_MODEL_NUMBER_ll(IMI)
@@ -340,12 +102,12 @@ SUBROUTINE STATPROF_POSITION( TPSTATPROF, OINSIDE, OPRESENT )
END IF
! X position
- TPSTATPROF%NI_U = COUNT( XXHAT (:) <= TPSTATPROF%XX )
- TPSTATPROF%NI_M = COUNT( XXHATM(:) <= TPSTATPROF%XX )
+ TPSTATPROF%NI_U = COUNT( XXHAT (:) <= TPSTATPROF%XX_CUR )
+ TPSTATPROF%NI_M = COUNT( XXHATM(:) <= TPSTATPROF%XX_CUR )
! Y position
- TPSTATPROF%NJ_V = COUNT( XYHAT (:) <= TPSTATPROF%XY )
- TPSTATPROF%NJ_M = COUNT( XYHATM(:) <= TPSTATPROF%XY )
+ TPSTATPROF%NJ_V = COUNT( XYHAT (:) <= TPSTATPROF%XY_CUR )
+ TPSTATPROF%NJ_M = COUNT( XYHATM(:) <= TPSTATPROF%XY_CUR )
! Position of station/profiler according to process
IF ( TPSTATPROF%NI_U >= IIB .AND. TPSTATPROF%NI_U <= IIE &
@@ -354,8 +116,8 @@ SUBROUTINE STATPROF_POSITION( TPSTATPROF, OINSIDE, OPRESENT )
! Check if station/profiler is too near of physical domain border (outside of physical domain for mass points)
IF ( OINSIDE .AND. .NOT. L1D ) THEN
- IF ( TPSTATPROF%XX < XHATM_BOUND(NPHYS_XMIN) .OR. TPSTATPROF%XX > XHATM_BOUND(NPHYS_XMAX) &
- .OR. TPSTATPROF%XY < XHATM_BOUND(NPHYS_YMIN) .OR. TPSTATPROF%XY > XHATM_BOUND(NPHYS_YMAX) ) THEN
+ IF ( TPSTATPROF%XX_CUR < XHATM_BOUND(NPHYS_XMIN) .OR. TPSTATPROF%XX_CUR > XHATM_BOUND(NPHYS_XMAX) &
+ .OR. TPSTATPROF%XY_CUR < XHATM_BOUND(NPHYS_YMIN) .OR. TPSTATPROF%XY_CUR > XHATM_BOUND(NPHYS_YMAX) ) THEN
CALL GET_MODEL_NUMBER_ll(IMI)
WRITE( CMNHMSG(1), "( 'station or profiler ', A, ' is outside of mass-points physical domain of model', I3 )" ) &
TRIM(TPSTATPROF%CNAME), IMI
@@ -371,13 +133,13 @@ SUBROUTINE STATPROF_POSITION( TPSTATPROF, OINSIDE, OPRESENT )
! Computations only on correct process
IF ( OPRESENT .AND. .NOT. L1D ) THEN
! Interpolation coefficient for X (mass-point)
- TPSTATPROF%XXMCOEF = ( TPSTATPROF%XX - XXHATM(TPSTATPROF%NI_M) ) / ( XXHATM(TPSTATPROF%NI_M+1) - XXHATM(TPSTATPROF%NI_M) )
+ TPSTATPROF%XXMCOEF = ( TPSTATPROF%XX_CUR - XXHATM(TPSTATPROF%NI_M) ) / ( XXHATM(TPSTATPROF%NI_M+1) - XXHATM(TPSTATPROF%NI_M) )
! Interpolation coefficient for Y (mass-point)
- TPSTATPROF%XYMCOEF = ( TPSTATPROF%XY - XYHATM(TPSTATPROF%NJ_M) ) / ( XYHATM(TPSTATPROF%NJ_M+1) - XYHATM(TPSTATPROF%NJ_M) )
+ TPSTATPROF%XYMCOEF = ( TPSTATPROF%XY_CUR - XYHATM(TPSTATPROF%NJ_M) ) / ( XYHATM(TPSTATPROF%NJ_M+1) - XYHATM(TPSTATPROF%NJ_M) )
! Interpolation coefficient for X (U-point)
- TPSTATPROF%XXUCOEF = ( TPSTATPROF%XX - XXHAT(TPSTATPROF%NI_U) ) / ( XXHAT(TPSTATPROF%NI_U+1) - XXHAT(TPSTATPROF%NI_U) )
+ TPSTATPROF%XXUCOEF = ( TPSTATPROF%XX_CUR - XXHAT(TPSTATPROF%NI_U) ) / ( XXHAT(TPSTATPROF%NI_U+1) - XXHAT(TPSTATPROF%NI_U) )
! Interpolation coefficient for Y (V-point)
- TPSTATPROF%XYVCOEF = ( TPSTATPROF%XY - XYHAT(TPSTATPROF%NJ_V) ) / ( XYHAT(TPSTATPROF%NJ_V+1) - XYHAT(TPSTATPROF%NJ_V) )
+ TPSTATPROF%XYVCOEF = ( TPSTATPROF%XY_CUR - XYHAT(TPSTATPROF%NJ_V) ) / ( XYHAT(TPSTATPROF%NJ_V+1) - XYHAT(TPSTATPROF%NJ_V) )
END IF
IF ( OPRESENT ) THEN
@@ -388,16 +150,17 @@ SUBROUTINE STATPROF_POSITION( TPSTATPROF, OINSIDE, OPRESENT )
TYPE IS( TSTATIONDATA )
! The closest K-level to the station altitude is chosen
JK = JPVEXT + 1
- DO WHILE ( ( STATPROF_INTERP_2D( TPSTATPROF, XZZ(:,:,JK) ) - STATPROF_INTERP_2D( TPSTATPROF, XZZ(:,:,JPVEXT+1) ) ) &
- < TPSTATPROF%XZ)
+ DO WHILE ( ( TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XZZ(:,:,JK) ) &
+ - TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XZZ(:,:,JPVEXT+1) ) ) &
+ < TPSTATPROF%XZ_CUR )
JK = JK + 1
END DO
- ZLOW = STATPROF_INTERP_2D( TPSTATPROF, XZZ(:,:,JK-1) ) - STATPROF_INTERP_2D( TPSTATPROF, XZZ(:,:,JPVEXT+1) )
- ZHIGH = STATPROF_INTERP_2D( TPSTATPROF, XZZ(:,:,JK ) ) - STATPROF_INTERP_2D( TPSTATPROF, XZZ(:,:,JPVEXT+1) )
+ ZLOW = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XZZ(:,:,JK-1) ) - TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XZZ(:,:,JPVEXT+1) )
+ ZHIGH = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XZZ(:,:,JK ) ) - TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XZZ(:,:,JPVEXT+1) )
!If the station/profiler is nearer from the lower level, select it
- IF ( ( ZHIGH - TPSTATPROF%XZ ) > ( TPSTATPROF%XZ - ZLOW ) ) JK = JK - 1
+ IF ( ( ZHIGH - TPSTATPROF%XZ_CUR ) > ( TPSTATPROF%XZ_CUR - ZLOW ) ) JK = JK - 1
TPSTATPROF%NK = JK
- TPSTATPROF%XZMEAS = STATPROF_INTERP_2D( TPSTATPROF, XZZ(:,:,JK) )
+ TPSTATPROF%XZMEAS = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XZZ(:,:,JK) )
CLASS DEFAULT
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'STATPROF_POSITION', 'unknown type for TPSTATPROF', OLOCAL = .TRUE. )
@@ -409,7 +172,7 @@ END SUBROUTINE STATPROF_POSITION
! ###################################
SUBROUTINE PROFILER_ADD( TPPROFILER )
! ###################################
-! Subroutine to add a station to the local list of profilers
+! Subroutine to add a profiler to the local list of profilers
USE MODD_PROFILER_n, ONLY: NUMBPROFILER_LOC, TPROFILERS
IMPLICIT NONE
@@ -426,24 +189,7 @@ SUBROUTINE PROFILER_ADD( TPPROFILER )
TZPROFILERS(JS) = TPROFILERS(JS)
END DO
- !Copy fields available in TSTATPROFDATA
- !other fields are not yet set
- TZPROFILERS(NUMBPROFILER_LOC)%CNAME = TPPROFILER%CNAME
- TZPROFILERS(NUMBPROFILER_LOC)%NID = TPPROFILER%NID
- TZPROFILERS(NUMBPROFILER_LOC)%XX = TPPROFILER%XX
- TZPROFILERS(NUMBPROFILER_LOC)%XY = TPPROFILER%XY
- TZPROFILERS(NUMBPROFILER_LOC)%XZ = TPPROFILER%XZ
- TZPROFILERS(NUMBPROFILER_LOC)%XLON = TPPROFILER%XLON
- TZPROFILERS(NUMBPROFILER_LOC)%XLAT = TPPROFILER%XLAT
- TZPROFILERS(NUMBPROFILER_LOC)%NI_M = TPPROFILER%NI_M
- TZPROFILERS(NUMBPROFILER_LOC)%NJ_M = TPPROFILER%NJ_M
- TZPROFILERS(NUMBPROFILER_LOC)%NI_U = TPPROFILER%NI_U
- TZPROFILERS(NUMBPROFILER_LOC)%NJ_V = TPPROFILER%NJ_V
- TZPROFILERS(NUMBPROFILER_LOC)%XXMCOEF = TPPROFILER%XXMCOEF
- TZPROFILERS(NUMBPROFILER_LOC)%XYMCOEF = TPPROFILER%XYMCOEF
- TZPROFILERS(NUMBPROFILER_LOC)%XXUCOEF = TPPROFILER%XXUCOEF
- TZPROFILERS(NUMBPROFILER_LOC)%XYVCOEF = TPPROFILER%XYVCOEF
- TZPROFILERS(NUMBPROFILER_LOC)%CTYPE = TPPROFILER%CTYPE
+ TZPROFILERS(NUMBPROFILER_LOC) = TPPROFILER
IF ( ASSOCIATED( TPROFILERS ) ) DEALLOCATE( TPROFILERS ) !Can be done without memory leak because allocatable arrays were
!not yet allocated (will be done in PROFILER_ALLOCATE)
@@ -471,25 +217,7 @@ SUBROUTINE STATION_ADD( TPSTATION )
TZSTATIONS(JS) = TSTATIONS(JS)
END DO
- !Copy fields available in TSTATPROFDATA
- !other fields are not yet set
- TZSTATIONS(NUMBSTAT_LOC)%CNAME = TPSTATION%CNAME
- TZSTATIONS(NUMBSTAT_LOC)%NID = TPSTATION%NID
- TZSTATIONS(NUMBSTAT_LOC)%XX = TPSTATION%XX
- TZSTATIONS(NUMBSTAT_LOC)%XY = TPSTATION%XY
- TZSTATIONS(NUMBSTAT_LOC)%XZ = TPSTATION%XZ
- TZSTATIONS(NUMBSTAT_LOC)%XLON = TPSTATION%XLON
- TZSTATIONS(NUMBSTAT_LOC)%XLAT = TPSTATION%XLAT
- TZSTATIONS(NUMBSTAT_LOC)%NI_M = TPSTATION%NI_M
- TZSTATIONS(NUMBSTAT_LOC)%NJ_M = TPSTATION%NJ_M
- TZSTATIONS(NUMBSTAT_LOC)%NI_U = TPSTATION%NI_U
- TZSTATIONS(NUMBSTAT_LOC)%NJ_V = TPSTATION%NJ_V
- TZSTATIONS(NUMBSTAT_LOC)%XXMCOEF = TPSTATION%XXMCOEF
- TZSTATIONS(NUMBSTAT_LOC)%XYMCOEF = TPSTATION%XYMCOEF
- TZSTATIONS(NUMBSTAT_LOC)%XXUCOEF = TPSTATION%XXUCOEF
- TZSTATIONS(NUMBSTAT_LOC)%XYVCOEF = TPSTATION%XYVCOEF
- TZSTATIONS(NUMBSTAT_LOC)%NK = TPSTATION%NK
- TZSTATIONS(NUMBSTAT_LOC)%XZMEAS = TPSTATION%XZMEAS
+ TZSTATIONS(NUMBSTAT_LOC) = TPSTATION
IF ( ASSOCIATED( TSTATIONS ) ) DEALLOCATE( TSTATIONS ) !Can be done without memory leak because allocatable arrays were
!not yet allocated (will be done in STATION_ALLOCATE)
@@ -497,288 +225,75 @@ SUBROUTINE STATION_ADD( TPSTATION )
END SUBROUTINE STATION_ADD
-! ########################################################
-FUNCTION STATPROF_INTERP_2D( TPSTATPROF, PA ) RESULT( PB )
-! ########################################################
- USE MODD_CONF, ONLY: L1D
- USE MODD_PARAMETERS, ONLY: XUNDEF
-
- USE MODE_MSG
-
- IMPLICIT NONE
-
- CLASS(TSTATPROFDATA), INTENT(IN) :: TPSTATPROF
- REAL, DIMENSION(:,:), INTENT(IN) :: PA
- REAL :: PB
-
- INTEGER :: JI, JJ
-
- IF ( SIZE( PA, 1 ) == 2 ) THEN
- JI = 1
- JJ = 1
- ELSE IF ( L1D ) THEN
- JI = 2
- JJ = 2
- ELSE
- JI = TPSTATPROF%NI_M
- JJ = TPSTATPROF%NJ_M
- END IF
-
- IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
- .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) ) THEN
- PB = (1.-TPSTATPROF%XXMCOEF) * (1.-TPSTATPROF%XYMCOEF) * PA(JI, JJ ) + &
- ( TPSTATPROF%XXMCOEF) * (1.-TPSTATPROF%XYMCOEF) * PA(JI+1, JJ ) + &
- (1.-TPSTATPROF%XXMCOEF) * ( TPSTATPROF%XYMCOEF) * PA(JI, JJ+1) + &
- ( TPSTATPROF%XXMCOEF) * ( TPSTATPROF%XYMCOEF) * PA(JI+1, JJ+1)
- ELSE
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'STATPROF_INTERP_2D', 'value can not be interpolated', OLOCAL = .TRUE. )
- PB = XUNDEF
- END IF
-
-END FUNCTION STATPROF_INTERP_2D
-
-! ##########################################################
-FUNCTION STATPROF_INTERP_2D_U( TPSTATPROF, PA ) RESULT( PB )
-! ##########################################################
- USE MODD_CONF, ONLY: L1D
- USE MODD_PARAMETERS, ONLY: XUNDEF
-
- USE MODE_MSG
-
- IMPLICIT NONE
-
- CLASS(TSTATPROFDATA), INTENT(IN) :: TPSTATPROF
- REAL, DIMENSION(:,:), INTENT(IN) :: PA
- REAL :: PB
-
- INTEGER :: JI, JJ
-
- IF ( SIZE( PA, 1 ) == 2 ) THEN
- JI = 1
- JJ = 1
- ELSE IF ( L1D ) THEN
- JI = 2
- JJ = 2
- ELSE
- JI = TPSTATPROF%NI_U
- JJ = TPSTATPROF%NJ_M
- END IF
-
- IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
- .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) ) THEN
- PB = (1.-TPSTATPROF%XXUCOEF) * (1.-TPSTATPROF%XYMCOEF) * PA(JI, JJ ) + &
- ( TPSTATPROF%XXUCOEF) * (1.-TPSTATPROF%XYMCOEF) * PA(JI+1, JJ ) + &
- (1.-TPSTATPROF%XXUCOEF) * ( TPSTATPROF%XYMCOEF) * PA(JI, JJ+1) + &
- ( TPSTATPROF%XXUCOEF) * ( TPSTATPROF%XYMCOEF) * PA(JI+1, JJ+1)
- ELSE
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'STATPROF_INTERP_2D_U', 'value can not be interpolated', OLOCAL = .TRUE. )
- PB = XUNDEF
- END IF
-
-END FUNCTION STATPROF_INTERP_2D_U
-
-! ##########################################################
-FUNCTION STATPROF_INTERP_2D_V( TPSTATPROF, PA ) RESULT( PB )
-! ##########################################################
- USE MODD_CONF, ONLY: L1D
- USE MODD_PARAMETERS, ONLY: XUNDEF
-
- USE MODE_MSG
-
- IMPLICIT NONE
-
- CLASS(TSTATPROFDATA), INTENT(IN) :: TPSTATPROF
- REAL, DIMENSION(:,:), INTENT(IN) :: PA
- REAL :: PB
-
- INTEGER :: JI, JJ
-
- IF ( SIZE( PA, 1 ) == 2 ) THEN
- JI = 1
- JJ = 1
- ELSE IF ( L1D ) THEN
- JI = 2
- JJ = 2
- ELSE
- JI = TPSTATPROF%NI_M
- JJ = TPSTATPROF%NJ_V
- END IF
-
- IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
- .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) ) THEN
- PB = (1.-TPSTATPROF%XXMCOEF) * (1.-TPSTATPROF%XYVCOEF) * PA(JI, JJ ) + &
- ( TPSTATPROF%XXMCOEF) * (1.-TPSTATPROF%XYVCOEF) * PA(JI+1, JJ ) + &
- (1.-TPSTATPROF%XXMCOEF) * ( TPSTATPROF%XYVCOEF) * PA(JI, JJ+1) + &
- ( TPSTATPROF%XXMCOEF) * ( TPSTATPROF%XYVCOEF) * PA(JI+1, JJ+1)
- ELSE
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'STATPROF_INTERP_2D_V', 'value can not be interpolated', OLOCAL = .TRUE. )
- PB = XUNDEF
- END IF
-
-END FUNCTION STATPROF_INTERP_2D_V
-
-! ########################################################
-FUNCTION STATPROF_INTERP_3D( TPSTATPROF, PA ) RESULT( PB )
-! ########################################################
- USE MODD_CONF, ONLY: L1D
- USE MODD_PARAMETERS, ONLY: XUNDEF
-
- USE MODE_MSG
-
- IMPLICIT NONE
-
- CLASS(TSTATPROFDATA), INTENT(IN) :: TPSTATPROF
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
- REAL, DIMENSION(SIZE(PA,3)) :: PB
-
- INTEGER :: JI, JJ, JK
-
- IF ( SIZE( PA, 1 ) == 2 ) THEN
- JI = 1
- JJ = 1
- ELSE IF ( L1D ) THEN
- JI = 2
- JJ = 2
- ELSE
- JI = TPSTATPROF%NI_M
- JJ = TPSTATPROF%NJ_M
- END IF
-
- IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
- .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) ) THEN
- DO JK = 1, SIZE( PA, 3 )
- IF ( PA(JI, JJ, JK) /= XUNDEF .AND. PA(JI+1, JJ, JK) /= XUNDEF .AND. &
- PA(JI, JJ+1, JK) /= XUNDEF .AND. PA(JI+1, JJ+1, JK) /= XUNDEF ) THEN
- PB(JK) = (1.-TPSTATPROF%XXMCOEF) * (1.-TPSTATPROF%XYMCOEF) * PA(JI, JJ, JK) + &
- ( TPSTATPROF%XXMCOEF) * (1.-TPSTATPROF%XYMCOEF) * PA(JI+1, JJ, JK) + &
- (1.-TPSTATPROF%XXMCOEF) * ( TPSTATPROF%XYMCOEF) * PA(JI, JJ+1, JK) + &
- ( TPSTATPROF%XXMCOEF) * ( TPSTATPROF%XYMCOEF) * PA(JI+1, JJ+1, JK)
- ELSE
- PB(JK) = XUNDEF
- END IF
- END DO
- ELSE
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'STATPROF_INTERP_3D', 'value can not be interpolated', OLOCAL = .TRUE. )
- PB(:) = XUNDEF
- END IF
-
-END FUNCTION STATPROF_INTERP_3D
-
-! ##########################################################
-FUNCTION STATPROF_INTERP_3D_U( TPSTATPROF, PA ) RESULT( PB )
-! ##########################################################
- USE MODD_CONF, ONLY: L1D
- USE MODD_PARAMETERS, ONLY: XUNDEF
-
- USE MODE_MSG
-
- IMPLICIT NONE
-
- CLASS(TSTATPROFDATA), INTENT(IN) :: TPSTATPROF
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
- REAL, DIMENSION(SIZE(PA,3)) :: PB
-
- INTEGER :: JI, JJ
-
- IF ( SIZE( PA, 1 ) == 2 ) THEN
- JI = 1
- JJ = 1
- ELSE IF ( L1D ) THEN
- JI = 2
- JJ = 2
- ELSE
- JI = TPSTATPROF%NI_U
- JJ = TPSTATPROF%NJ_M
- END IF
-
- IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
- .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) ) THEN
- PB(:) = (1.-TPSTATPROF%XXUCOEF) * (1.-TPSTATPROF%XYMCOEF) * PA(JI, JJ, :) + &
- ( TPSTATPROF%XXUCOEF) * (1.-TPSTATPROF%XYMCOEF) * PA(JI+1, JJ, :) + &
- (1.-TPSTATPROF%XXUCOEF) * ( TPSTATPROF%XYMCOEF) * PA(JI, JJ+1, :) + &
- ( TPSTATPROF%XXUCOEF) * ( TPSTATPROF%XYMCOEF) * PA(JI+1, JJ+1, :)
- ELSE
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'STATPROF_INTERP_3D_U', 'value can not be interpolated', OLOCAL = .TRUE. )
- PB = XUNDEF
- END IF
-
-END FUNCTION STATPROF_INTERP_3D_U
-
-! ##########################################################
-FUNCTION STATPROF_INTERP_3D_V( TPSTATPROF, PA ) RESULT( PB )
-! ##########################################################
- USE MODD_CONF, ONLY: L1D
- USE MODD_PARAMETERS, ONLY: XUNDEF
-
- USE MODE_MSG
-
- IMPLICIT NONE
-
- CLASS(TSTATPROFDATA), INTENT(IN) :: TPSTATPROF
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
- REAL, DIMENSION(SIZE(PA,3)) :: PB
-
- INTEGER :: JI, JJ
-
- IF ( SIZE( PA, 1 ) == 2 ) THEN
- JI = 1
- JJ = 1
- ELSE IF ( L1D ) THEN
- JI = 2
- JJ = 2
- ELSE
- JI = TPSTATPROF%NI_M
- JJ = TPSTATPROF%NJ_V
- END IF
-
- IF ( JI >= 1 .AND. JI < SIZE( PA, 1 ) &
- .AND. JJ >= 1 .AND. JJ < SIZE( PA, 2 ) ) THEN
- PB(:) = (1.-TPSTATPROF%XXMCOEF) * (1.-TPSTATPROF%XYVCOEF) * PA(JI, JJ, :) + &
- ( TPSTATPROF%XXMCOEF) * (1.-TPSTATPROF%XYVCOEF) * PA(JI+1, JJ, :) + &
- (1.-TPSTATPROF%XXMCOEF) * ( TPSTATPROF%XYVCOEF) * PA(JI, JJ+1, :) + &
- ( TPSTATPROF%XXMCOEF) * ( TPSTATPROF%XYVCOEF) * PA(JI+1, JJ+1, :)
- ELSE
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'STATPROF_INTERP_3D_V', 'value can not be interpolated', OLOCAL = .TRUE. )
- PB = XUNDEF
- END IF
-
-END FUNCTION STATPROF_INTERP_3D_V
-
-! #################################################
-SUBROUTINE STATPROF_INSTANT( TPSTATPROF_TIME, KIN )
-! #################################################
- USE MODD_TIME_n, ONLY: TDTCUR
-
- USE MODE_DATETIME
- USE MODE_MSG
-
- IMPLICIT NONE
-
- TYPE(TSTATPROFTIME), INTENT(INOUT) :: TPSTATPROF_TIME
- INTEGER, INTENT(OUT) :: KIN ! Current step of storage
+! #################################
+SUBROUTINE STATPROF_DIAG_SURFRAD( TPSTATPROF, KSTORE )
+! #################################
+ ! Store surface and radiative values
+ USE MODD_DIAG_IN_RUN
+ USE MODD_PARAM_n, ONLY: CRAD
- IF ( TPSTATPROF_TIME%N_CUR == 0 ) THEN
- ! First store
- TPSTATPROF_TIME%N_CUR = 1
- TPSTATPROF_TIME%TPDATES(1) = TDTCUR
- KIN = 1
- ELSE
- IF ( TDTCUR - TPSTATPROF_TIME%TPDATES(TPSTATPROF_TIME%N_CUR) >= TPSTATPROF_TIME%XTSTEP - 1.E-6 ) THEN
- TPSTATPROF_TIME%N_CUR = TPSTATPROF_TIME%N_CUR + 1
- KIN = TPSTATPROF_TIME%N_CUR
-
- IF ( KIN < 1 .OR. KIN > SIZE( TPSTATPROF_TIME%TPDATES ) ) THEN
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'STATPROF_INSTANT', 'problem with step of storage' )
- KIN = -2
- ELSE
- TPSTATPROF_TIME%TPDATES(KIN) = TDTCUR
- END IF
- ELSE
- ! Return an invalid step number
- KIN = -1
- END IF
+ CLASS(TSTATPROFDATA), INTENT(INOUT) :: TPSTATPROF
+ INTEGER, INTENT(IN) :: KSTORE
+
+ TPSTATPROF%XZON10M(KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_ZON10M )
+ TPSTATPROF%XMER10M(KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_MER10M )
+ TPSTATPROF%XT2M (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_T2M )
+ TPSTATPROF%XQ2M (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_Q2M )
+ TPSTATPROF%XHU2M (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_HU2M )
+ TPSTATPROF%XRN (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_RN )
+ TPSTATPROF%XH (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_H )
+ TPSTATPROF%XLE (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_LE )
+ TPSTATPROF%XLEI (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_LEI )
+ TPSTATPROF%XGFLUX (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_GFLUX )
+ IF ( CRAD /= 'NONE' ) THEN
+ TPSTATPROF%XSWD (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_SWD )
+ TPSTATPROF%XSWU (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_SWU )
+ TPSTATPROF%XLWD (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_LWD )
+ TPSTATPROF%XLWU (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_LWU )
+ TPSTATPROF%XSWDIR (KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_SWDIR )
+ TPSTATPROF%XSWDIFF(KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_SWDIFF )
+ TPSTATPROF%XDSTAOD(KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_DSTAOD )
+ TPSTATPROF%XSLTAOD(KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_SLTAOD )
END IF
-
-END SUBROUTINE STATPROF_INSTANT
+ TPSTATPROF%XSFCO2(KSTORE) = TPSTATPROF%INTERP_HOR_FROM_MASSPOINT( XCURRENT_SFCO2 )
+
+END SUBROUTINE STATPROF_DIAG_SURFRAD
+
+! ############################################
+SUBROUTINE Add_diag_surfrad_data( TPSTATPROF )
+! ############################################
+ use modd_param_n, only: crad, csurf
+
+ use mode_sensor, only: Add_point
+
+ class(tstatprofdata), intent(in) :: tpstatprof
+
+ if ( csurf == "EXTE" ) then
+ call Add_point( 'T2m', '2-m temperature', 'K', tpstatprof%xt2m(:) )
+ call Add_point( 'Q2m', '2-m humidity', 'kg kg-1', tpstatprof%xq2m(:) )
+ call Add_point( 'HU2m', '2-m relative humidity', 'percent', tpstatprof%xhu2m(:) )
+ call Add_point( 'zon10m', '10-m zonal wind', 'm s-1', tpstatprof%xzon10m(:) )
+ call Add_point( 'mer10m', '10-m meridian wind', 'm s-1', tpstatprof%xmer10m(:) )
+ call Add_point( 'RN', 'Net radiation', 'W m-2', tpstatprof%xrn(:) )
+ call Add_point( 'H', 'Sensible heat flux', 'W m-2', tpstatprof%xh(:) )
+ call Add_point( 'LE', 'Total Latent heat flux', 'W m-2', tpstatprof%xle(:) )
+ call Add_point( 'G', 'Storage heat flux', 'W m-2', tpstatprof%xgflux(:) )
+ call Add_point( 'LEI', 'Solid Latent heat flux', 'W m-2', tpstatprof%xlei(:) )
+ end if
+
+ if ( crad /= 'NONE' ) then
+ call Add_point( 'SWD', 'Downward short-wave radiation', 'W m-2', tpstatprof%xswd(:) )
+ call Add_point( 'SWU', 'Upward short-wave radiation', 'W m-2', tpstatprof%xswu(:) )
+ call Add_point( 'LWD', 'Downward long-wave radiation', 'W m-2', tpstatprof%xlwd(:) )
+ call Add_point( 'LWU', 'Upward long-wave radiation', 'W m-2', tpstatprof%xlwu(:) )
+ call Add_point( 'SWDIR', 'Downward direct short-wave radiation', 'W m-2', tpstatprof%xswdir(:) )
+ call Add_point( 'SWDIFF', 'Downward diffuse short-wave radiation', 'W m-2', tpstatprof%xswdiff(:) )
+ call Add_point( 'DSTAOD', 'Dust aerosol optical depth', 'm', tpstatprof%xdstaod(:) )
+ call Add_point( 'SLTAOD', 'Salt aerosol optical depth', 'm', tpstatprof%xsltaod(:) )
+ end if
+
+ call Add_point( 'SFCO2', 'CO2 Surface Flux', 'mg m-2 s-1', tpstatprof%xsfco2(:) )
+
+END SUBROUTINE Add_diag_surfrad_data
END MODULE MODE_STATPROF_TOOLS
diff --git a/src/MNH/version.f90 b/src/MNH/version.f90
index c8283e7235c7a52cb15dcbb16e2b2d2516cce9ed..9451e48ac0ab1019b5d01504531f22aaa63b52c5 100644
--- a/src/MNH/version.f90
+++ b/src/MNH/version.f90
@@ -44,9 +44,9 @@ IMPLICIT NONE
!
NMNHVERSION(1)=5
NMNHVERSION(2)=6
-NMNHVERSION(3)=0
+NMNHVERSION(3)=1
NMASDEV=56
-NBUGFIX=0
+NBUGFIX=1
CBIBUSER=''
!
END SUBROUTINE VERSION
diff --git a/src/MNH/write_aircraft_balloon.f90 b/src/MNH/write_aircraft_balloon.f90
index 9c3c5b5849ed8591196b57cc81690e35eb862485..a1b978be286734a3a65d09439ffd0d0792e0300c 100644
--- a/src/MNH/write_aircraft_balloon.f90
+++ b/src/MNH/write_aircraft_balloon.f90
@@ -7,7 +7,7 @@
MODULE MODE_WRITE_AIRCRAFT_BALLOON
! ###########################
-use modd_parameters, only: NCOMMENTLGTMAX, NMNHNAMELGTMAX, NUNITLGTMAX
+use modd_parameters, only: NMNHNAMELGTMAX
use mode_msg
@@ -18,12 +18,6 @@ private
PUBLIC :: AIRCRAFT_BALLOON_FREE_NONLOCAL
public :: WRITE_AIRCRAFT_BALLOON
-CHARACTER(LEN=NCOMMENTLGTMAX), DIMENSION(:), ALLOCATABLE :: CCOMMENT ! comment string(
-CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CTITLE ! title
-CHARACTER(LEN=NUNITLGTMAX), DIMENSION(:), ALLOCATABLE :: CUNIT ! physical unit
-
-REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: XWORK6 ! contains temporal serie
-
contains
! ##########################################
@@ -84,9 +78,9 @@ SUBROUTINE WRITE_AIRCRAFT_BALLOON(TPDIAFILE)
!
USE MODD_AIRCRAFT_BALLOON
USE MODD_IO, ONLY: ISP, TFILEDATA
-!
-USE MODE_AIRCRAFT_BALLOON, ONLY: FLYER_RECV_AND_ALLOCATE, FLYER_SEND
-!
+
+USE MODE_MODELN_HANDLER, ONLY: GET_CURRENT_MODEL_INDEX
+
IMPLICIT NONE
!
!
@@ -98,16 +92,21 @@ TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
!
! 0.2 declaration of local variables
!
+INTEGER :: IMI
INTEGER :: JI
+LOGICAL :: GEMPTYCOMM ! if TRUE, the communication is empty (no data is exchanged)
!
!----------------------------------------------------------------------------
+IMI = GET_CURRENT_MODEL_INDEX()
+
DO JI = 1, NBALLOONS
! The balloon data is only available on the process where it is physically located => transfer it if necessary
! Send data from owner to writer if necessary
IF ( ISP == NRANKCUR_BALLOON(JI) .AND. NRANKCUR_BALLOON(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
- CALL FLYER_SEND( TBALLOONS(JI)%TBALLOON, TPDIAFILE%NMASTER_RANK )
+ GEMPTYCOMM = ( TBALLOONS(JI)%TBALLOON%NMODEL /= IMI )
+ CALL TBALLOONS(JI)%TBALLOON%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE., OEMPTYSEND = GEMPTYCOMM )
END IF
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
@@ -116,11 +115,12 @@ DO JI = 1, NBALLOONS
IF ( ASSOCIATED( TBALLOONS(JI)%TBALLOON ) ) &
call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_AIRCRAFT_BALLOON', 'balloon already associated' )
ALLOCATE( TBALLOONS(JI)%TBALLOON )
- CALL FLYER_RECV_AND_ALLOCATE( TBALLOONS(JI)%TBALLOON, NRANKCUR_BALLOON(JI) )
+ CALL TBALLOONS(JI)%TBALLOON%RECV_ALLOCATE( KFROM = NRANKCUR_BALLOON(JI), ORECV_SIZE_FROM_OWNER = .TRUE., &
+ OEMPTYRECV = GEMPTYCOMM )
END IF
- ! Write data
- CALL FLYER_DIACHRO( TPDIAFILE, TBALLOONS(JI)%TBALLOON )
+ ! Write data (if balloon is on this model (GEMPTYCOMM=F))
+ IF ( .NOT. GEMPTYCOMM ) CALL FLYER_DIACHRO( TPDIAFILE, TBALLOONS(JI)%TBALLOON )
! Remark: release of memory is done later by a call to AIRCRAFT_BALLOON_FREE_NONLOCAL
! This call must be done after the file is closed because flyer data is needed on the
@@ -133,7 +133,8 @@ DO JI = 1, NAIRCRAFTS
! Send data from owner to writer if necessary
IF ( ISP == NRANKCUR_AIRCRAFT(JI) .AND. NRANKCUR_AIRCRAFT(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
- CALL FLYER_SEND( TAIRCRAFTS(JI)%TAIRCRAFT, TPDIAFILE%NMASTER_RANK )
+ GEMPTYCOMM = ( TAIRCRAFTS(JI)%TAIRCRAFT%NMODEL /= IMI )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE., OEMPTYSEND = GEMPTYCOMM )
END IF
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
@@ -142,11 +143,12 @@ DO JI = 1, NAIRCRAFTS
IF ( ASSOCIATED( TAIRCRAFTS(JI)%TAIRCRAFT ) ) &
call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_AIRCRAFT_BALLOON', 'aircraft already associated' )
ALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
- CALL FLYER_RECV_AND_ALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT, NRANKCUR_AIRCRAFT(JI) )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%RECV_ALLOCATE( KFROM = NRANKCUR_AIRCRAFT(JI), ORECV_SIZE_FROM_OWNER = .TRUE., &
+ OEMPTYRECV = GEMPTYCOMM )
END IF
- ! Write data
- CALL FLYER_DIACHRO( TPDIAFILE, TAIRCRAFTS(JI)%TAIRCRAFT )
+ ! Write data (if aircraft is on this model (GEMPTYCOMM=F))
+ IF ( .NOT. GEMPTYCOMM ) CALL FLYER_DIACHRO( TPDIAFILE, TAIRCRAFTS(JI)%TAIRCRAFT )
! Remark: release of memory is done later by a call to AIRCRAFT_BALLOON_FREE_NONLOCAL
! This call must be done after the file is closed because flyer data is needed on the
@@ -164,8 +166,6 @@ SUBROUTINE AIRCRAFT_BALLOON_FREE_NONLOCAL( TPDIAFILE )
USE MODD_AIRCRAFT_BALLOON, ONLY: NAIRCRAFTS, NBALLOONS, NRANKCUR_AIRCRAFT, NRANKCUR_BALLOON, TAIRCRAFTS, TBALLOONS
USE MODD_IO, ONLY: ISP, TFILEDATA
-USE MODE_INI_AIRCRAFT_BALLOON, ONLY: DEALLOCATE_FLYER
-
IMPLICIT NONE
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE
@@ -178,7 +178,7 @@ IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
DO JI = 1, NBALLOONS
! Free ballon data if it was not stored on this process
IF ( NRANKCUR_BALLOON(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
- CALL DEALLOCATE_FLYER( TBALLOONS(JI)%TBALLOON )
+ IF ( TBALLOONS(JI)%TBALLOON%NSTORE_MAX >= 0 ) CALL TBALLOONS(JI)%TBALLOON%DATA_ARRAYS_DEALLOCATE()
DEALLOCATE( TBALLOONS(JI)%TBALLOON )
END IF
END DO
@@ -186,7 +186,7 @@ IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
DO JI = 1, NAIRCRAFTS
! Free aircraft data if it was not stored on this process
IF ( NRANKCUR_AIRCRAFT(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
- CALL DEALLOCATE_FLYER( TAIRCRAFTS(JI)%TAIRCRAFT )
+ IF ( TAIRCRAFTS(JI)%TAIRCRAFT%NSTORE_MAX >= 0 ) CALL TAIRCRAFTS(JI)%TAIRCRAFT%DATA_ARRAYS_DEALLOCATE()
DEALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
END IF
END DO
@@ -202,38 +202,35 @@ SUBROUTINE FLYER_DIACHRO( TPDIAFILE, TPFLYER )
USE MODD_AIRCRAFT_BALLOON
use modd_budget, only: NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
tbudiachrometadata
-USE MODD_CST, ONLY: XRV
-use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_FLYER_PROC, NMNHDIM_FLYER_TIME, NMNHDIM_UNUSED, &
+USE MODD_CH_AEROSOL, ONLY: JPMODE, LORILAM, NCARB, NSOA, NSP
+USE MODD_CST, ONLY: XP00, XCPD, XRD, XRV
+USE MODD_DUST, ONLY: LDUST, NMODE_DST
+use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, NMNHDIM_FLYER_PROC, NMNHDIM_FLYER_TIME, NMNHDIM_UNUSED, &
tfieldmetadata_base, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NSV, ONLY: tsvlist, nsv, nsv_aer, nsv_aerbeg, nsv_aerend, nsv_dst, nsv_dstbeg, nsv_dstend, &
- nsv_lima_beg, nsv_lima_end
+USE MODD_NSV, ONLY: tsvlist, nsv
USE MODD_PARAMETERS, ONLY: XUNDEF
USE MODD_PARAM_n, ONLY: CCLOUD
+USE MODD_SALT, ONLY: LSALT, NMODE_SLT
-USE MODE_AERO_PSD
use mode_aircraft_balloon, only: Aircraft_balloon_longtype_get
-USE MODE_DUST_PSD
USE MODE_MODELN_HANDLER, ONLY: GET_CURRENT_MODEL_INDEX
+use mode_sensor, only: Add_dust_data, Add_orilam_data, Add_point, Add_profile, Add_salt_data, &
+ Sensor_current_processes_number_get, &
+ ccomment, ctitle, cunit, xwork6, &
+ Sensor_write_workarrays_allocate, Sensor_write_workarrays_deallocate
use mode_write_diachro, only: Write_diachro
-
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
CLASS(TFLYERDATA), INTENT(IN) :: TPFLYER
!
!* 0.2 declaration of local variables for diachro
!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZSIG, ZRG
-REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZPTOTA
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
-!
CHARACTER(LEN=NMNHNAMELGTMAX) :: YTITLE
-CHARACTER(LEN=NCOMMENTLGTMAX) :: YCOMMENT
-CHARACTER(LEN=NUNITLGTMAX) :: YUNIT
-!
INTEGER :: IMI ! current model index
INTEGER :: IPROC ! number of variables records
INTEGER :: JPROC ! loop counter
+integer :: jproc_w
INTEGER :: ISTORE
INTEGER :: IPROCZ ! number of variables records
INTEGER :: IRR ! number of hydrometeors
@@ -241,7 +238,8 @@ INTEGER :: JRR ! loop counter
INTEGER :: JSV ! loop counter
INTEGER :: JPT ! loop counter
INTEGER :: IKU
-REAL, DIMENSION(:), ALLOCATABLE :: ZLWC ! Temporary array to store/compute Liquid Water Content at flyer position
+REAL, DIMENSION(:), ALLOCATABLE :: ZLWC ! Temporary array to store/compute Liquid Water Content at flyer position
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
type(tbudiachrometadata) :: tzbudiachro
type(tfieldmetadata_base), dimension(:), allocatable :: tzfields
!
@@ -249,46 +247,34 @@ type(tfieldmetadata_base), dimension(:), allocatable :: tzfields
!
IMI = GET_CURRENT_MODEL_INDEX()
-IRR = SIZE( tpflyer%xr, 2 )
+IRR = SIZE( tpflyer%xr, 3 )
-IF (TPFLYER%NMODEL==0) RETURN
-IF (ALL(TPFLYER%XX==XUNDEF)) RETURN
-IF (COUNT(TPFLYER%XX/=XUNDEF)<=1) RETURN
IF ( IMI /= TPFLYER%NMODEL ) RETURN
+IF ( ALL( TPFLYER%XX == XUNDEF ) ) RETURN
!
-IKU = SIZE(TPFLYER%XRTZ,2) !number of vertical levels
+IKU = SIZE(TPFLYER%XRTZ,1) !number of vertical levels
!
-IPROC = 21 + IRR + SIZE(TPFLYER%XSV,2) &
- + 2 + SIZE(TPFLYER%XSVW_FLUX,2)
-IPROCZ = SIZE(TPFLYER%XRTZ,2)+ SIZE(TPFLYER%XRZ,2)+ SIZE(TPFLYER%XRZ,3)+ SIZE(TPFLYER%XCRARE,2)+ &
- SIZE(TPFLYER%XCRARE_ATT,2)+ SIZE(TPFLYER%XWZ,2) + SIZE(TPFLYER%XFFZ,2)+ &
- SIZE(TPFLYER%XIWCZ,2)+ SIZE(TPFLYER%XLWCZ,2) + SIZE(TPFLYER%XCIZ,2) + &
- SIZE(TPFLYER%XZZ,2)
-
-IF (NSV_LIMA_BEG<=NSV_LIMA_END) IPROCZ= IPROCZ+ SIZE(TPFLYER%XCCZ,2) + SIZE(TPFLYER%XCRZ,2)
-IF (SIZE(TPFLYER%XTKE )>0) IPROC = IPROC + 1
+IPROC = 10 + IRR + SIZE(TPFLYER%XSV,3) + 2 + SIZE(TPFLYER%XSVW_FLUX,2)
+IF ( IRR > 1 ) IPROC = IPROC + 1
+IF ( SIZE( TPFLYER%XTKE ) > 0 ) IPROC = IPROC + 1
IPROC = IPROC + 1 ! TKE_DISS
-IF (LORILAM) IPROC = IPROC + JPMODE*3
-IF (LDUST) IPROC = IPROC + NMODE_DST*3
-IF (SIZE(TPFLYER%XTSRAD)>0) IPROC = IPROC + 1
+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( TPFLYER%XTSRAD ) > 0 ) IPROC = IPROC + 1
!
ISTORE = SIZE( TPFLYER%TFLYER_TIME%TPDATES )
!
!----------------------------------------------------------------------------
!Treat point values
-ALLOCATE (XWORK6(1,1,1,ISTORE,1,IPROC))
-ALLOCATE (CCOMMENT(IPROC))
-ALLOCATE (CTITLE (IPROC))
-ALLOCATE (CUNIT (IPROC))
-
-jproc = 0
+call Sensor_write_workarrays_allocate( 1, istore, iproc )
call Add_point( 'ZS', 'orography', 'm', tpflyer%xzs(:) )
!
SELECT TYPE ( TPFLYER )
CLASS IS ( TAIRCRAFTDATA )
IF (TPFLYER%LALTDEF) THEN
- call Add_point( 'P', 'pressure', 'Pascal', tpflyer%xp(:) )
+ call Add_point( 'P', 'pressure', 'Pascal', tpflyer%xp(1,:) )
ELSE
call Add_point( 'Z', 'altitude', 'm', tpflyer%xz(:) )
ENDIF
@@ -301,39 +287,38 @@ END SELECT
call Add_point( 'MODEL', 'model on which data was computed', '1', REAL( tpflyer%nmodelhist(:) ) )
call Add_point( 'LON', 'longitude', 'degree', tpflyer%xlon(:) )
call Add_point( 'LAT', 'latitude', 'degree', tpflyer%xlat(:) )
-call Add_point( 'ZON_WIND', 'zonal wind', 'm s-1', tpflyer%xzon(:) )
-call Add_point( 'MER_WIND', 'meridian wind', 'm s-1', tpflyer%xmer(:) )
-call Add_point( 'W', 'air vertical speed', 'm s-1', tpflyer%xw(:) )
-call Add_point( 'Th', 'potential temperature', 'K', tpflyer%xth(:) )
-!
-if ( irr >= 1 ) call Add_point( 'Rv', 'water vapor mixing ratio', 'kg kg-1', tpflyer%xr(:,1) )
-if ( irr >= 2 ) call Add_point( 'Rc', 'liquid cloud water mixing ratio', 'kg kg-1', tpflyer%xr(:,2) )
-if ( irr >= 3 ) call Add_point( 'Rr', 'Rain water mixing ratio', 'kg kg-1', tpflyer%xr(:,3) )
-if ( irr >= 4 ) call Add_point( 'Ri', 'Ice cloud water mixing ratio', 'kg kg-1', tpflyer%xr(:,4) )
-if ( irr >= 5 ) call Add_point( 'Rs', 'Snow mixing ratio', 'kg kg-1', tpflyer%xr(:,5) )
-if ( irr >= 6 ) call Add_point( 'Rg', 'Graupel mixing ratio', 'kg kg-1', tpflyer%xr(:,6) )
-if ( irr >= 7 ) call Add_point( 'Rh', 'Hail mixing ratio', 'kg kg-1', tpflyer%xr(:,7) )
+call Add_point( 'ZON_WIND', 'zonal wind', 'm s-1', tpflyer%xzon(1,:) )
+call Add_point( 'MER_WIND', 'meridian wind', 'm s-1', tpflyer%xmer(1,:) )
+call Add_point( 'W', 'air vertical speed', 'm s-1', tpflyer%xw(1,:) )
+call Add_point( 'Th', 'potential temperature', 'K', tpflyer%xth(1,:) )
+!
+if ( irr >= 1 ) call Add_point( 'Rv', 'water vapor mixing ratio', 'kg kg-1', tpflyer%xr(1,:,1) )
+if ( irr >= 2 ) call Add_point( 'Rc', 'liquid cloud water mixing ratio', 'kg kg-1', tpflyer%xr(1,:,2) )
+if ( irr >= 3 ) call Add_point( 'Rr', 'Rain water mixing ratio', 'kg kg-1', tpflyer%xr(1,:,3) )
+if ( irr >= 4 ) call Add_point( 'Ri', 'Ice cloud water mixing ratio', 'kg kg-1', tpflyer%xr(1,:,4) )
+if ( irr >= 5 ) call Add_point( 'Rs', 'Snow mixing ratio', 'kg kg-1', tpflyer%xr(1,:,5) )
+if ( irr >= 6 ) call Add_point( 'Rg', 'Graupel mixing ratio', 'kg kg-1', tpflyer%xr(1,:,6) )
+if ( irr >= 7 ) call Add_point( 'Rh', 'Hail mixing ratio', 'kg kg-1', tpflyer%xr(1,:,7) )
!
!add cloud liquid water content in g/m3 to compare to measurements from FSSP
-!IF (.NOT.(ANY(TPFLYER%XP(:) == 0.))) THEN
IF ( IRR > 1 ) THEN !cloud water is present
ALLOCATE( ZRHO(1, 1, ISTORE) )
ALLOCATE( ZLWC(ISTORE) )
ZRHO(1,1,:) = 0.
DO JRR = 1, IRR
- ZRHO(1,1,:) = ZRHO(1,1,:) + TPFLYER%XR(:,JRR)
+ ZRHO(1,1,:) = ZRHO(1,1,:) + TPFLYER%XR(1,:,JRR)
ENDDO
- ZRHO(1,1,:) = TPFLYER%XTH(:) * ( 1. + XRV/XRD*TPFLYER%XR(:,1) ) &
- / ( 1. + ZRHO(1,1,:) )
+ ZRHO(1,1,:) = TPFLYER%XTH(1,:) * ( 1. + XRV/XRD*TPFLYER%XR(1,:,1) ) &
+ / ( 1. + ZRHO(1,1,:) )
DO JPT=1,ISTORE
IF ( TPFLYER%NMODELHIST(JPT) > 0 ) THEN !Compute LWC only if flyer is flying
- IF (TPFLYER%XP(JPT) == 0.) THEN
+ IF (TPFLYER%XP(1,JPT) == 0.) THEN
ZRHO(1,1,JPT) = 0.
ELSE
- ZRHO(1,1,JPT) = TPFLYER%XP(JPT) / &
- (XRD *ZRHO(1,1,JPT) *((TPFLYER%XP(JPT)/XP00)**(XRD/XCPD)) )
+ ZRHO(1,1,JPT) = TPFLYER%XP(1,JPT) / &
+ (XRD *ZRHO(1,1,JPT) *((TPFLYER%XP(1,JPT)/XP00)**(XRD/XCPD)) )
ENDIF
- ZLWC(JPT) = TPFLYER%XR(JPT,2) * ZRHO(1,1,JPT) * 1.E3
+ ZLWC(JPT) = TPFLYER%XR(1,JPT,2) * ZRHO(1,1,JPT) * 1.E3
ELSE
ZLWC(JPT) = XUNDEF
END IF
@@ -341,8 +326,10 @@ IF ( IRR > 1 ) THEN !cloud water is present
call Add_point( 'LWC', 'cloud liquid water content', 'g m-3', ZLWC(:) )
DEALLOCATE( ZLWC, ZRHO )
END IF
-!
-IF (SIZE(TPFLYER%XTKE)>0) call Add_point( 'Tke', 'Turbulent kinetic energy', 'm2 s-2', tpflyer%xtke(:) )
+
+call Add_point( 'Rhod', 'Density of dry air', 'kg m-3', tpflyer%xrhod_sensor )
+
+IF (SIZE(TPFLYER%XTKE)>0) call Add_point( 'Tke', 'Turbulent kinetic energy', 'm2 s-2', tpflyer%xtke(1,:) )
!
call Add_point( 'H_FLUX', 'sensible flux', 'W m-2', tpflyer%xthw_flux(:) )
call Add_point( 'LE_FLUX', 'latent flux', 'W m-2', tpflyer%xrcw_flux(:) )
@@ -353,182 +340,25 @@ DO JSV=1,SIZE(TPFLYER%XSVW_FLUX,2)
END DO
call Add_point( 'Tke_Diss', 'TKE dissipation rate', 'm2 s-2', tpflyer%xtke_diss(:) )
!
-IF (SIZE(TPFLYER%XSV,2)>=1) THEN
+IF (SIZE(TPFLYER%XSV,3)>=1) THEN
! Scalar variables
DO JSV = 1, NSV
IF ( TRIM( TSVLIST(JSV)%CUNITS ) == 'ppv' ) THEN
- call Add_point( Trim( tsvlist(jsv)%cmnhname ), '', 'ppb', tpflyer%xsv(:,jsv) * 1.e9 ) !*1e9 for conversion ppv->ppb
+ call Add_point( Trim( tsvlist(jsv)%cmnhname ), '', 'ppb', tpflyer%xsv(1,:,jsv) * 1.e9 ) !*1e9 for conversion ppv->ppb
ELSE
- call Add_point( Trim( tsvlist(jsv)%cmnhname ), '', Trim( tsvlist(jsv)%cunits ), tpflyer%xsv(:,jsv) )
+ call Add_point( Trim( tsvlist(jsv)%cmnhname ), '', Trim( tsvlist(jsv)%cunits ), tpflyer%xsv(1,:,jsv) )
END IF
END DO
- IF ((LORILAM).AND. .NOT.(ANY(TPFLYER%XP(:) == 0.))) THEN
-
- ALLOCATE (ZSV(1,1,ISTORE,NSV_AER))
- ALLOCATE (ZRHO(1,1,ISTORE))
- ALLOCATE (ZN0(1,1,ISTORE,JPMODE))
- ALLOCATE (ZRG(1,1,ISTORE,JPMODE))
- ALLOCATE (ZSIG(1,1,ISTORE,JPMODE))
- ALLOCATE (ZPTOTA(1,1,ISTORE,NSP+NCARB+NSOA,JPMODE))
- ZSV(1,1,:,1:NSV_AER) = TPFLYER%XSV(:,NSV_AERBEG:NSV_AEREND)
- IF (IRR >0) THEN
- ZRHO(1,1,:) = 0.
- DO JRR=1,IRR
- ZRHO(1,1,:) = ZRHO(1,1,:) + TPFLYER%XR(:,JRR)
- ENDDO
- ZRHO(1,1,:) = TPFLYER%XTH(:) * ( 1. + XRV/XRD*TPFLYER%XR(:,1) ) &
- / ( 1. + ZRHO(1,1,:) )
- ELSE
- ZRHO(1,1,:) = TPFLYER%XTH(:)
- ENDIF
- ZRHO(1,1,:) = TPFLYER%XP(:) / &
- (XRD *ZRHO(1,1,:) *((TPFLYER%XP(:)/XP00)**(XRD/XCPD)) )
- ZSIG = 0.
- ZRG = 0.
- ZN0 = 0.
- ZPTOTA = 0.
- DO JPT=1,ISTORE ! prevent division by zero if ZSV = 0.
- IF (ALL(ZSV(1,1,JPT,:)/=0.)) THEN
- CALL PPP2AERO(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0, PCTOTA=ZPTOTA)
- ENDIF
- ENDDO
- DO JSV=1,JPMODE
- ! mean radius
- WRITE(YTITLE,'(A,I1)')'AERRGA',JSV
- WRITE(YCOMMENT,'(A,I1)')'RG (nb) AERO MODE ',JSV
- call Add_point( Trim( ytitle ), 'um', Trim( ycomment ), ZRG(1,1,:,JSV) )
- ! standard deviation
- WRITE(YTITLE,'(A,I1)')'AERSIGA',JSV
- WRITE(YCOMMENT,'(A,I1)')'SIGMA AERO MODE ',JSV
- call Add_point( Trim( ytitle ), '1', Trim( ycomment ), ZSIG(1,1,:,JSV) )
- ! particles number
- WRITE(YTITLE,'(A,I1)')'AERN0A',JSV
- WRITE(YCOMMENT,'(A,I1)')'N0 AERO MODE ',JSV
- call Add_point( Trim( ytitle ), 'm-3', Trim( ycomment ), ZN0(1,1,:,JSV) )
- ! mass concentration in microg/m3
- ! sulfate
- WRITE(YTITLE,'(A,I1)')'MSO4',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SO4 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SO4,JSV) )
- ! nitrate
- WRITE(YTITLE,'(A,I1)')'MNO3',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS NO3 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_NO3,JSV) )
- ! amoniac
- WRITE(YTITLE,'(A,I1)')'MNH3',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS NH3 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_NH3,JSV) )
- ! water
- WRITE(YTITLE,'(A,I1)')'MH2O',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS H2O AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_H2O,JSV) )
- IF (NSOA .EQ. 10) THEN
- ! SOA1
- WRITE(YTITLE,'(A,I1)')'MSOA1',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SOA1 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SOA1,JSV) )
- ! SOA2
- WRITE(YTITLE,'(A,I1)')'MSOA2',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SOA2 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SOA2,JSV) )
- ! SOA3
- WRITE(YTITLE,'(A,I1)')'MSOA3',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SOA3 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SOA3,JSV) )
- ! SOA4
- WRITE(YTITLE,'(A,I1)')'MSOA4',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SOA4 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SOA4,JSV) )
- ! SOA5
- WRITE(YTITLE,'(A,I1)')'MSOA5',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SOA5 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SOA5,JSV) )
- ! SOA6
- WRITE(YTITLE,'(A,I1)')'MSOA6',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SOA6 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SOA6,JSV) )
- ! SOA7
- WRITE(YTITLE,'(A,I1)')'MSOA7',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SOA7 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SOA7,JSV) )
- ! SOA8
- WRITE(YTITLE,'(A,I1)')'MSOA8',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SOA8 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SOA8,JSV) )
- ! SOA9
- WRITE(YTITLE,'(A,I1)')'MSOA9',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SOA9 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SOA9,JSV) )
- ! SOA10
- WRITE(YTITLE,'(A,I1)')'MSOA10',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS SOA10 AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_SOA10,JSV) )
- ENDIF
- ! OC
- WRITE(YTITLE,'(A,I1)')'MOC',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS OC AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_OC,JSV) )
- ! BC
- WRITE(YTITLE,'(A,I1)')'MBC',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS BC AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_BC,JSV) )
- ! dust
- WRITE(YTITLE,'(A,I1)')'MDUST',JSV
- WRITE(YCOMMENT,'(A,I1)')'MASS DUST AEROSOL MODE ',JSV
- call Add_point( Trim( ytitle ), 'ug m-3', Trim( ycomment ), ZPTOTA(1,1,:,JP_AER_DST,JSV) )
- ENDDO
- DEALLOCATE (ZSV,ZRHO)
- DEALLOCATE (ZN0,ZRG,ZSIG,ZPTOTA)
- END IF
-
- IF ((LDUST).AND. .NOT.(ANY(TPFLYER%XP(:) == 0.))) THEN
- ALLOCATE (ZSV(1,1,ISTORE,NSV_DST))
- ALLOCATE (ZRHO(1,1,ISTORE))
- ALLOCATE (ZN0(1,1,ISTORE,NMODE_DST))
- ALLOCATE (ZRG(1,1,ISTORE,NMODE_DST))
- ALLOCATE (ZSIG(1,1,ISTORE,NMODE_DST))
- ZSV(1,1,:,1:NSV_DST) = TPFLYER%XSV(:,NSV_DSTBEG:NSV_DSTEND)
- IF (IRR >0) THEN
- ZRHO(1,1,:) = 0.
- DO JRR=1,IRR
- ZRHO(1,1,:) = ZRHO(1,1,:) + TPFLYER%XR(:,JRR)
- ENDDO
- ZRHO(1,1,:) = TPFLYER%XTH(:) * ( 1. + XRV/XRD*TPFLYER%XR(:,1) ) &
- / ( 1. + ZRHO(1,1,:) )
- ELSE
- ZRHO(1,1,:) = TPFLYER%XTH(:)
- ENDIF
- ZRHO(1,1,:) = TPFLYER%XP(:) / &
- (XRD *ZRHO(1,1,:) *((TPFLYER%XP(:)/XP00)**(XRD/XCPD)) )
- CALL PPP2DUST(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0)
- DO JSV=1,NMODE_DST
- ! mean radius
- WRITE(YTITLE,'(A,I1)')'DSTRGA',JSV
- WRITE(YCOMMENT,'(A,I1)')'RG (nb) DUST MODE ',JSV
- call Add_point( Trim( ytitle ), 'um', Trim( ycomment ), ZRG(1,1,:,JSV) )
- ! standard deviation
- WRITE(YTITLE,'(A,I1)')'DSTSIGA',JSV
- WRITE(YCOMMENT,'(A,I1)')'SIGMA DUST MODE ',JSV
- call Add_point( Trim( ytitle ), '1', Trim( ycomment ), ZSIG(1,1,:,JSV) )
- ! particles number
- WRITE(YTITLE,'(A,I1)')'DSTN0A',JSV
- WRITE(YCOMMENT,'(A,I1)')'N0 DUST MODE ',JSV
- call Add_point( Trim( ytitle ), 'm-3', Trim( ycomment ), ZN0(1,1,:,JSV) )
- ENDDO
- DEALLOCATE (ZSV,ZRHO)
- DEALLOCATE (ZN0,ZRG,ZSIG)
- END IF
+ if ( lorilam ) call Add_orilam_data( tpflyer, 1, istore )
+ if ( ldust ) call Add_dust_data ( tpflyer, 1, istore )
+ if ( lsalt ) call Add_salt_data ( tpflyer, 1, istore )
ENDIF
!
-IF (SIZE(TPFLYER%XTSRAD)>0) THEN
- JPROC = JPROC+1
- CTITLE (JPROC) = 'Tsrad'
- CUNIT (JPROC) = 'K'
- CCOMMENT (JPROC) = 'Radiative Surface Temperature'
- XWORK6 (1,1,1,:,1,JPROC) = TPFLYER%XTSRAD(:)
-END IF
+IF ( SIZE( TPFLYER%XTSRAD ) > 0 ) call Add_point( 'Tsrad', 'Radiative Surface Temperature', 'K', TPFLYER%XTSRAD(:) )
!
+jproc = Sensor_current_processes_number_get()
+
allocate( tzfields( jproc ) )
tzfields(:)%cmnhname = ctitle(1 : jproc)
@@ -555,12 +385,12 @@ call Aircraft_balloon_longtype_get( tpflyer, tzbudiachro%clevels(NLVL_SUBCATEGOR
tzbudiachro%ccomments(NLVL_SUBCATEGORY) = 'Level for the flyers of type: ' // Trim( tzbudiachro%clevels(NLVL_SUBCATEGORY) )
tzbudiachro%lleveluse(NLVL_GROUP) = .true.
-tzbudiachro%clevels (NLVL_GROUP) = Trim( tpflyer%ctitle )
-tzbudiachro%ccomments(NLVL_GROUP) = 'Values for flyer ' // Trim( tpflyer%ctitle )
+tzbudiachro%clevels (NLVL_GROUP) = Trim( tpflyer%cname )
+tzbudiachro%ccomments(NLVL_GROUP) = 'Values for flyer ' // Trim( tpflyer%cname )
tzbudiachro%lleveluse(NLVL_SHAPE) = .true.
tzbudiachro%clevels (NLVL_SHAPE) = 'Point'
-tzbudiachro%ccomments(NLVL_SHAPE) = 'Values at position of flyer ' // Trim( tpflyer%ctitle )
+tzbudiachro%ccomments(NLVL_SHAPE) = 'Values at position of flyer ' // Trim( tpflyer%cname )
tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
@@ -595,20 +425,16 @@ call Write_diachro( tpdiafile, tzbudiachro, tzfields, tpflyer%tflyer_time%tpdate
tpflyer = tpflyer )
Deallocate( tzfields )
-Deallocate( xwork6 )
-Deallocate( ccomment )
-Deallocate( ctitle )
-Deallocate( cunit )
+call Sensor_write_workarrays_deallocate( )
!----------------------------------------------------------------------------
!Treat vertical profiles
-ALLOCATE (XWORK6(1,1,IKU,ISTORE,1,IPROCZ))
-ALLOCATE (CCOMMENT(IPROCZ))
-ALLOCATE (CTITLE (IPROCZ))
-ALLOCATE (CUNIT (IPROCZ))
+IPROCZ = 9 + IRR
+IF ( CCLOUD == 'LIMA' ) IPROCZ = IPROCZ + 3
+IF ( CCLOUD(1:3) == 'ICE' ) IPROCZ = IPROCZ + 1
-JPROC = 0
+call Sensor_write_workarrays_allocate( iku, istore, iprocz )
call Add_profile( 'Rt', '1D Total hydrometeor mixing ratio', 'kg kg-1', tpflyer%xrtz(:,:) )
@@ -625,20 +451,25 @@ call Add_profile( 'FF', 'Horizontal wind', 'm s-1', tpflyer%xffz(:,:) )
call Add_profile( 'IWC', 'Ice water content', 'kg m-3', tpflyer%xiwcz(:,:) )
call Add_profile( 'LWC', 'Liquid water content', 'kg m-3', tpflyer%xlwcz(:,:) )
+call Add_profile( 'Rhod', 'Density of dry air', 'kg m-3', tpflyer%xrhod(:,:) )
IF ( CCLOUD == 'LIMA' ) THEN
call Add_profile( 'CCLOUDT', 'liquid cloud concentration', 'kg-1', tpflyer%xccz(:,:) )
call Add_profile( 'CRAINT', 'Rain concentration', 'kg-1', tpflyer%xcrz(:,:) )
call Add_profile( 'CICET', 'Ice concentration', 'kg-1', tpflyer%xciz(:,:) )
ELSE IF ( CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4' ) THEN
- call Add_profile( 'CIT', 'Ice concentration', 'm-3', tpflyer%xciz(:,:) )
+ call Add_profile( 'CIT', 'Ice concentration', 'm-3', tpflyer%xciz(:,:) )
END IF
call Add_profile( 'RARE', '1D cloud radar reflectivity', 'dBZ', tpflyer%xcrare(:,:) )
call Add_profile( 'RAREatt', '1D cloud radar attenuated reflectivity', 'dBZ', tpflyer%xcrare_att(:,:) )
call Add_profile( 'W', '1D vertical velocity', 'm s-1', tpflyer%xwz(:,:) )
+!Store position of W in the field list. Useful because it is not computed on the same Arakawa-grid points
+jproc_w = Sensor_current_processes_number_get()
call Add_profile( 'Z', '1D altitude above sea', 'm', tpflyer%xzz(:,:) )
+jproc = Sensor_current_processes_number_get()
+
allocate( tzfields( jproc ) )
tzfields(:)%cmnhname = ctitle(1 : jproc)
@@ -652,6 +483,7 @@ tzfields(:)%ndims = 3
tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(3) = NMNHDIM_LEVEL
+tzfields(jproc_w)%ndimlist(3) = NMNHDIM_LEVEL_W
tzfields(:)%ndimlist(4) = NMNHDIM_FLYER_TIME
tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(6) = NMNHDIM_FLYER_PROC
@@ -665,12 +497,12 @@ call Aircraft_balloon_longtype_get( tpflyer, tzbudiachro%clevels(NLVL_SUBCATEGOR
tzbudiachro%ccomments(NLVL_SUBCATEGORY) = 'Level for the flyers of type: ' // Trim( tzbudiachro%clevels(NLVL_SUBCATEGORY) )
tzbudiachro%lleveluse(NLVL_GROUP) = .true.
-tzbudiachro%clevels (NLVL_GROUP) = Trim( tpflyer%ctitle )
-tzbudiachro%ccomments(NLVL_GROUP) = 'Values for flyer ' // Trim( tpflyer%ctitle )
+tzbudiachro%clevels (NLVL_GROUP) = Trim( tpflyer%cname )
+tzbudiachro%ccomments(NLVL_GROUP) = 'Values for flyer ' // Trim( tpflyer%cname )
tzbudiachro%lleveluse(NLVL_SHAPE) = .true.
tzbudiachro%clevels (NLVL_SHAPE) = 'Vertical_profile'
-tzbudiachro%ccomments(NLVL_SHAPE) = 'Vertical profiles at position of flyer ' // Trim( tpflyer%ctitle )
+tzbudiachro%ccomments(NLVL_SHAPE) = 'Vertical profiles at position of flyer ' // Trim( tpflyer%cname )
tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
@@ -710,59 +542,7 @@ call Write_diachro( tpdiafile, tzbudiachro, tzfields, tpflyer%tflyer_time%tpdate
tpflyer = tpflyer )
deallocate( tzfields )
-
-DEALLOCATE (XWORK6)
-DEALLOCATE (CCOMMENT)
-DEALLOCATE (CTITLE )
-DEALLOCATE (CUNIT )
-
-contains
-
-
-subroutine Add_profile( htitle, hcomment, hunits, pfield )
-
-character(len=*), intent(in) :: htitle
-character(len=*), intent(in) :: hcomment
-character(len=*), intent(in) :: hunits
-real, dimension(:,:), intent(in) :: pfield
-
-integer :: jk
-
-jproc = jproc + 1
-
-if ( jproc > iprocz ) call Print_msg( NVERB_FATAL, 'IO', 'Add_profile', 'more processes than expected' )
-
-ctitle(jproc) = Trim( htitle )
-ccomment(jproc) = Trim( hcomment )
-cunit(jproc) = Trim( hunits )
-
-do jk = 1, iku
- xwork6(1, 1, jk, :, 1, jproc) = pfield(:, jk)
-end do
-
-end subroutine Add_profile
-
-
-subroutine Add_point( htitle, hcomment, hunits, pfield )
-
-character(len=*), intent(in) :: htitle
-character(len=*), intent(in) :: hcomment
-character(len=*), intent(in) :: hunits
-real, dimension(:), intent(in) :: pfield
-
-integer :: jk
-
-jproc = jproc + 1
-
-if ( jproc > iproc ) call Print_msg( NVERB_FATAL, 'IO', 'Add_point', 'more processes than expected' )
-
-ctitle(jproc) = Trim( htitle)
-ccomment(jproc) = Trim( hcomment )
-cunit(jproc) = Trim( hunits )
-
-xwork6(1, 1, 1, :, 1, jproc) = pfield(:)
-
-end subroutine Add_point
+call Sensor_write_workarrays_deallocate( )
!----------------------------------------------------------------------------
END SUBROUTINE FLYER_DIACHRO
diff --git a/src/MNH/write_balloonn.f90 b/src/MNH/write_balloonn.f90
index e20c046d59996c34ef2f64fff9a88a71deaa2a05..e519c2b99e0d289941727eb4106293c8abab8ac6 100644
--- a/src/MNH/write_balloonn.f90
+++ b/src/MNH/write_balloonn.f90
@@ -60,8 +60,6 @@ CONTAINS
USE MODD_AIRCRAFT_BALLOON, only: NBALLOONS, NRANKCUR_BALLOON, TBALLOONS
USE MODD_IO, ONLY: GSMONOPROC, ISP, TFILEDATA
!
-USE MODE_AIRCRAFT_BALLOON, ONLY: FLYER_RECV_AND_ALLOCATE, FLYER_SEND
-USE MODE_INI_AIRCRAFT_BALLOON, ONLY: DEALLOCATE_FLYER
USE MODE_MODELN_HANDLER, ONLY: GET_CURRENT_MODEL_INDEX
!
IMPLICIT NONE
@@ -75,12 +73,13 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
!
INTEGER :: IMI
INTEGER :: JI
-LOGICAL :: OMONOPROC_SAVE ! Copy of true value of GSMONOPROC
+LOGICAL :: GEMPTYCOMM ! if TRUE, the communication is empty (no data is exchanged)
+LOGICAL :: GMONOPROC_SAVE ! Copy of true value of GSMONOPROC
IMI = GET_CURRENT_MODEL_INDEX()
! Save GSMONOPROC value
-OMONOPROC_SAVE = GSMONOPROC
+GMONOPROC_SAVE = GSMONOPROC
! Force GSMONOPROC to true to allow IO_Field_write on only 1 process! (not very clean hack)
GSMONOPROC = .TRUE.
@@ -89,30 +88,33 @@ DO JI = 1, NBALLOONS
! Send data from owner to writer if necessary
IF ( ISP == NRANKCUR_BALLOON(JI) .AND. NRANKCUR_BALLOON(JI) /= TPFILE%NMASTER_RANK ) THEN
- CALL FLYER_SEND( TBALLOONS(JI)%TBALLOON, TPFILE%NMASTER_RANK )
+ GEMPTYCOMM = ( TBALLOONS(JI)%TBALLOON%NMODEL /= IMI )
+ CALL TBALLOONS(JI)%TBALLOON%SEND( KTO = TPFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE., OEMPTYSEND = GEMPTYCOMM )
END IF
IF ( ISP == TPFILE%NMASTER_RANK ) THEN
! Receive data from owner if not available on the writer process
IF ( NRANKCUR_BALLOON(JI) /= TPFILE%NMASTER_RANK ) THEN
ALLOCATE( TBALLOONS(JI)%TBALLOON )
- CALL FLYER_RECV_AND_ALLOCATE( TBALLOONS(JI)%TBALLOON, NRANKCUR_BALLOON(JI) )
+ CALL TBALLOONS(JI)%TBALLOON%RECV_ALLOCATE( KFROM = NRANKCUR_BALLOON(JI), ORECV_SIZE_FROM_OWNER = .TRUE., &
+ OEMPTYRECV = GEMPTYCOMM )
END IF
! Write data (only if flyer is on the current model)
! It will also be written in the ancestry model files
- IF ( TBALLOONS(JI)%TBALLOON%NMODEL == IMI ) CALL WRITE_BALLOON_POSITION( TPFILE, TBALLOONS(JI)%TBALLOON )
+ ! if GEMPTYCOMM=FALSE => flyer is on the current model (equivalent to TBALLOONS(JI)%TBALLOON%NMODEL==IMI)
+ IF ( .NOT. GEMPTYCOMM ) CALL WRITE_BALLOON_POSITION( TPFILE, TBALLOONS(JI)%TBALLOON )
! Free ballon data if it was not stored on this process
IF ( NRANKCUR_BALLOON(JI) /= TPFILE%NMASTER_RANK ) THEN
- CALL DEALLOCATE_FLYER( TBALLOONS(JI)%TBALLOON )
+ IF ( TBALLOONS(JI)%TBALLOON%NSTORE_MAX >= 0 ) CALL TBALLOONS(JI)%TBALLOON%DATA_ARRAYS_DEALLOCATE()
DEALLOCATE( TBALLOONS(JI)%TBALLOON )
END IF
END IF
END DO
! Restore correct value of GSMONOPROC
-GSMONOPROC = OMONOPROC_SAVE
+GSMONOPROC = GMONOPROC_SAVE
END SUBROUTINE WRITE_BALLOON_n
!-------------------------------------------------------------------------------
@@ -153,13 +155,13 @@ REAL :: ZLON ! longitude of the balloon
type(tfiledata) :: tzfile
TYPE(TFIELDMETADATA) :: TZFIELD
-! Do not write balloon position if not yet in fly or crashed
+! Do not write balloon position if not yet in flight or crashed
IF ( .NOT.TPFLYER%LFLY .OR. TPFLYER%LCRASH ) RETURN
! Check if current model time is the same as the time corresponding to the balloon position
IF ( ABS( TDTCUR - TPFLYER%TPOS_CUR ) > 1.e-6 ) &
call Print_msg( NVERB_WARNING, 'IO', 'WRITE_BALLOON_POSITION', 'position time does not corresponds to current time for balloon ' &
- // Trim( tpflyer%ctitle ) )
+ // Trim( tpflyer%cname ) )
! Recursive call up to grand parent file
! This way balloon position is also available on all ancestry model files (useful for restart with different number of models)
@@ -178,9 +180,9 @@ IF ( TPFILE%CFORMAT == 'LFI' .OR. TPFILE%CFORMAT == 'LFICDF4' ) THEN
TZFILE%CFORMAT = 'LFI'
TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(TPFLYER%CTITLE)//'LAT', &
+ CMNHNAME = TRIM(TPFLYER%CNAME)//'LAT', &
CSTDNAME = '', &
- CLONGNAME = TRIM(TPFLYER%CTITLE)//'LAT', &
+ CLONGNAME = TRIM(TPFLYER%CNAME)//'LAT', &
CUNITS = 'degree', &
CDIR = '--', &
CCOMMENT = '', &
@@ -191,9 +193,9 @@ IF ( TPFILE%CFORMAT == 'LFI' .OR. TPFILE%CFORMAT == 'LFICDF4' ) THEN
CALL IO_Field_write(TZFILE,TZFIELD,ZLAT)
TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(TPFLYER%CTITLE)//'LON', &
+ CMNHNAME = TRIM(TPFLYER%CNAME)//'LON', &
CSTDNAME = '', &
- CLONGNAME = TRIM(TPFLYER%CTITLE)//'LON', &
+ CLONGNAME = TRIM(TPFLYER%CNAME)//'LON', &
CUNITS = 'degree', &
CDIR = '--', &
CCOMMENT = '', &
@@ -204,9 +206,9 @@ IF ( TPFILE%CFORMAT == 'LFI' .OR. TPFILE%CFORMAT == 'LFICDF4' ) THEN
CALL IO_Field_write(TZFILE,TZFIELD,ZLON)
TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(TPFLYER%CTITLE)//'ALT', &
+ CMNHNAME = TRIM(TPFLYER%CNAME)//'ALT', &
CSTDNAME = '', &
- CLONGNAME = TRIM(TPFLYER%CTITLE)//'ALT', &
+ CLONGNAME = TRIM(TPFLYER%CNAME)//'ALT', &
CUNITS = 'm', &
CDIR = '--', &
CCOMMENT = '', &
@@ -217,9 +219,9 @@ IF ( TPFILE%CFORMAT == 'LFI' .OR. TPFILE%CFORMAT == 'LFICDF4' ) THEN
CALL IO_Field_write(TZFILE,TZFIELD,TPFLYER%XZ_CUR)
TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(TPFLYER%CTITLE)//'WASCENT', &
+ CMNHNAME = TRIM(TPFLYER%CNAME)//'WASCENT', &
CSTDNAME = '', &
- CLONGNAME = TRIM(TPFLYER%CTITLE)//'WASCENT', &
+ CLONGNAME = TRIM(TPFLYER%CNAME)//'WASCENT', &
CUNITS = 'm s-1', &
CDIR = '--', &
CCOMMENT = '', &
@@ -230,9 +232,9 @@ IF ( TPFILE%CFORMAT == 'LFI' .OR. TPFILE%CFORMAT == 'LFICDF4' ) THEN
CALL IO_Field_write(TZFILE,TZFIELD,TPFLYER%XWASCENT)
TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(TPFLYER%CTITLE)//'RHO', &
+ CMNHNAME = TRIM(TPFLYER%CNAME)//'RHO', &
CSTDNAME = '', &
- CLONGNAME = TRIM(TPFLYER%CTITLE)//'RHO', &
+ CLONGNAME = TRIM(TPFLYER%CNAME)//'RHO', &
CUNITS = 'kg m-3', &
CDIR = '--', &
CCOMMENT = '', &
@@ -252,20 +254,20 @@ IF ( TPFILE%CFORMAT == 'NETCDF4' .OR. TPFILE%CFORMAT == 'LFICDF4' ) THEN
TZFILE%CFORMAT = 'NETCDF4'
if ( isp == tzfile%nmaster_rank ) then
- istatus = NF90_INQ_NCID( tzfile%nncid, Trim( tpflyer%ctitle ), igroupid )
+ istatus = NF90_INQ_NCID( tzfile%nncid, Trim( tpflyer%cname ), igroupid )
if ( istatus == NF90_NOERR ) then
! The group already exists (should not)
- call Print_msg( NVERB_WARNING, 'IO', 'WRITE_BALLOON_POSITION', 'group '// Trim( tpflyer%ctitle ) // ' already exists' )
+ call Print_msg( NVERB_WARNING, 'IO', 'WRITE_BALLOON_POSITION', 'group '// Trim( tpflyer%cname ) // ' already exists' )
else
! Create the group
- istatus = NF90_DEF_GRP( tzfile%nncid, Trim( tpflyer%ctitle ), igroupid )
+ istatus = NF90_DEF_GRP( tzfile%nncid, Trim( tpflyer%cname ), igroupid )
if ( istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'WRITE_BALLOON_POSITION', 'NF90_DEF_GRP', 'for ' // Trim( tpflyer%ctitle ) )
+ call IO_Err_handle_nc4( istatus, 'WRITE_BALLOON_POSITION', 'NF90_DEF_GRP', 'for ' // Trim( tpflyer%cname ) )
! Add a comment attribute
- istatus = NF90_PUT_ATT( igroupid, NF90_GLOBAL, 'comment', 'Current position of balloon '// Trim( tpflyer%ctitle ) )
+ istatus = NF90_PUT_ATT( igroupid, NF90_GLOBAL, 'comment', 'Current position of balloon '// Trim( tpflyer%cname ) )
if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'WRITE_BALLOON_POSITION', 'NF90_PUT_ATT', 'comment for '// Trim( tpflyer%ctitle ) )
+ call IO_Err_handle_nc4( istatus, 'WRITE_BALLOON_POSITION', 'NF90_PUT_ATT', 'comment for '// Trim( tpflyer%cname ) )
end if
end if
diff --git a/src/MNH/write_les_rt_budgetn.f90 b/src/MNH/write_les_rt_budgetn.f90
index 66df13adebabdf556d771123572774257abae163..94d5c9902cc8ee16a8ce57e1a087f18bd1aa0393 100644
--- a/src/MNH/write_les_rt_budgetn.f90
+++ b/src/MNH/write_les_rt_budgetn.f90
@@ -467,7 +467,6 @@ ZLES_BUDGET(:,:,ILES) = XG * XLES_SUBGRID_RtThv(:,:,1) &
!* 3.6 dissipation
! -----------
!
-!PW: not in the documentation, but set to 0 anyway
ILES=ILES+1
YFIELDNAMES(ILES) = 'SBG_DISS'
YFIELDCOMMENTS(ILES) = 'subgrid dissipation'
diff --git a/src/MNH/write_les_sv_budgetn.f90 b/src/MNH/write_les_sv_budgetn.f90
index 8a412845f16ad91b5122ef961529ff316a551f09..538e1a3f3108c56ddc0769d62e66e145131d606d 100644
--- a/src/MNH/write_les_sv_budgetn.f90
+++ b/src/MNH/write_les_sv_budgetn.f90
@@ -520,7 +520,6 @@ END IF
! -----------
!
ILES=ILES+1
-!PW: not in documentation. Always set to 0
YFIELDNAMES(ILES) = 'SBG_DISS'
YFIELDCOMMENTS(ILES) = 'subgrid dissipation'
!
diff --git a/src/MNH/write_lesn.f90 b/src/MNH/write_lesn.f90
index 2e18f72adf934925770b2fd3bd323df5a37274c7..43a186a4f4c2338313762aa19475020ab5d5b1ac 100644
--- a/src/MNH/write_lesn.f90
+++ b/src/MNH/write_lesn.f90
@@ -1150,14 +1150,12 @@ if ( nspectra_k > 0 ) then
call Les_diachro_2pt_write( tpdiafile, XCORRi_WRi, XCORRj_WRi, 'WRI', 'W*ri 2 points correlations', 'm kg s-1 kg-1' )
end if
-!PW: TODO: ameliorer le ygroup (tenir compte de ce qu'est la variable scalaire et pas juste son jsv!)
do jsv = 1, nsv
Write( ygroup, fmt = "( a2, i3.3 )" ) "SS", jsv
call Les_diachro_2pt_write( tpdiafile, XCORRi_SvSv(:,:,:,JSV), XCORRj_SvSv(:,:,:,JSV), ygroup, &
'Sv*Sv 2 points correlations','kg2 kg-2' )
end do
-!PW: TODO: ameliorer le ygroup (tenir compte de ce qu'est la variable scalaire et pas juste son jsv!)
do jsv = 1, nsv
Write( ygroup, fmt = "( a2, i3.3 )" ) "WS", jsv
call Les_diachro_2pt_write( tpdiafile, XCORRi_WSv(:,:,:,JSV), XCORRj_WSv(:,:,:,JSV), ygroup, &
diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90
index a6099e6a0f4eb779347699adbcf1e6f85fc896ca..84ff78bdab8ce9d1759df3baa7a02dc307bd0382 100644
--- a/src/MNH/write_lfifm1_for_diag.f90
+++ b/src/MNH/write_lfifm1_for_diag.f90
@@ -1087,7 +1087,6 @@ IF (LLIMA_DIAG) THEN
END IF
!
DO JSV = NSV_LIMA_BEG,NSV_LIMA_END
-!PW: bases sur CLIMA_*_CONC et pas CLIMA_*_NAMES !!!
!
TZFIELD%CUNITS = 'cm-3'
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
@@ -1194,7 +1193,6 @@ IF (LLIMA_DIAG) THEN
END IF
!
END IF
-!PW: TODO: a documenter
IF (LELECDIAG .AND. CELEC .NE. "NONE") THEN
DO JSV = NSV_ELECBEG,NSV_ELECEND
TZFIELD = TSVLIST(JSV)
@@ -1279,7 +1277,6 @@ IF (LPASPOL) THEN
END IF
! Conditional sampling variables
IF (LCONDSAMP) THEN
-!PW: TODO: a documenter!!!
DO JSV = NSV_CSBEG, NSV_CSEND
TZFIELD = TSVLIST(JSV)
CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
@@ -1319,7 +1316,6 @@ IF (LCHAQDIAG) THEN !aqueous concentration in M
-!PW: TODO: LCHICDIAG n'existe pas => les variables correspondantes ne sont pas ecrites...
! ZWORK31(:,:,:)=0.
! DO JSV = NSV_CHICBEG,NSV_CHICEND ! ice phase
@@ -1348,8 +1344,26 @@ IF ((LCHEMDIAG).AND.(LORILAM).AND.(LUSECHEM)) THEN
IF (.NOT.(ASSOCIATED(XSIG3D))) &
ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
!
- CALL PPP2AERO(XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XRHODREF, &
- PSIG3D=XSIG3D, PRG3D=XRG3D, PN3D=XN3D, PCTOTA=ZPTOTA)
+ IF (CRGUNIT=="MASS") THEN
+ XRG3D(:,:,:,1) = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2)
+ XRG3D(:,:,:,2) = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2)
+ ELSE
+ XRG3D(:,:,:,1) = XINIRADIUSI
+ XRG3D(:,:,:,2) = XINIRADIUSJ
+ END IF
+ XSIG3D(:,:,:,1) = XINISIGI
+ XSIG3D(:,:,:,2) = XINISIGJ
+ XN3D(:,:,:,1) = XN0IMIN
+ XN3D(:,:,:,2) = XN0JMIN
+
+ ZPTOTA(:,:,:,:,:) = 0.
+
+ CALL PPP2AERO(XSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_AERBEG:NSV_AEREND),&
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
+ PSIG3D=XSIG3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PRG3D=XRG3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PN3D=XN3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PCTOTA=ZPTOTA(IIB:IIE,IJB:IJE,IKB:IKE,:,:))
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'generic for aerosol modes', &
@@ -1868,7 +1882,6 @@ END IF
! Blowing snow variables
!
IF(LBLOWSNOW) THEN
-!PW:TODO?:variables scalaires XSVT pas ecrites ici. Voulu?
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'SNWSUBL3D', &
CSTDNAME = '', &
diff --git a/src/MNH/write_lfifm1_for_diag_supp.f90 b/src/MNH/write_lfifm1_for_diag_supp.f90
index 06eee20bcc610436ccd8d4d40c01d3c16c9aaad3..d55684efa88ed69971bfd94e404eefa170f95806 100644
--- a/src/MNH/write_lfifm1_for_diag_supp.f90
+++ b/src/MNH/write_lfifm1_for_diag_supp.f90
@@ -91,6 +91,9 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!! J.-P. Chaboureau 07/2018 bug fix on XEMIS when calling CALL_RTTOVxx
!! J.-P. Chaboureau 09/04/2021 add the call to RTTOV13
! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
+!! D. Ricard & Q.Rodier 08/2023 add some diagnostics on pressure levels
+!! (temperature, relative and specific humidity, vertical velocity, TKE)
+!! D. Ricard 08/2023 add a diagnostic: maximum of cloud fraction on vertical levels
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -100,7 +103,7 @@ USE MODD_CH_AEROSOL, ONLY: LORILAM
USE MODD_CH_BUDGET_n, ONLY: CNAMES_BUDGET, NEQ_BUDGET, XTCHEM
USE MODD_CH_FLX_n, ONLY: XCHFLX
USE MODD_CH_PRODLOSSTOT_n, ONLY: CNAMES_PRODLOSST, NEQ_PLT, XLOSS, XPROD
-USE MODD_CST, ONLY: XCPD, XP00, XRD, XTT
+USE MODD_CST, ONLY: XCPD, XP00, XRD, XTT, XMV, XMD, XALPI, XGAMI, XBETAI
USE MODD_CURVCOR_n, ONLY: XCORIOZ
USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_ZON10M, XCURRENT_MER10M, &
XCURRENT_SFCO2, XCURRENT_SWD, XCURRENT_LWD, &
@@ -111,7 +114,7 @@ use modd_field, only: NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED, NMN
use modd_field
USE MODD_IO, ONLY: TFILEDATA
USE MODD_CONF, ONLY: LCARTESIAN
-USE MODD_CONF_n, ONLY: LUSERC, LUSERI, NRR
+USE MODD_CONF_n, ONLY: LUSERC, LUSERI, LUSERV, NRR
USE MODD_DEEP_CONVECTION_n, ONLY: NCLBASCONV, NCLTOPCONV, XCAPE, XDMFCONV, XDRCCONV, XDRICONV, XDRVCONV, &
XDTHCONV, XDSVCONV, XMFCONV, XPRLFLXCONV, XPRSFLXCONV, XUMFCONV
USE MODD_DIAG_FLAG, ONLY: CRAD_SAT, LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL, LISOPR, LISOTH, LRAD_SUBG_COND, &
@@ -122,7 +125,7 @@ USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
USE MODD_NSV, ONLY: NSV, NSV_CHEMBEG, NSV_CHEMEND, TSVLIST
USE MODD_PARAMETERS, ONLY: JPVEXT, NUNDEF, XUNDEF
USE MODD_PARAM_KAFR_n, ONLY: LCHTRANS
-USE MODD_PARAM_n, ONLY: CRAD, CSURF
+USE MODD_PARAM_n, ONLY: CRAD, CSURF, CCLOUD
USE MODD_PARAM_RAD_n, only: NRAD_COLNBR
USE MODD_RADIATIONS_N, ONLY: NCLEARCOL_TM1, NDLON, NFLEV, NSTATM, &
XAER, XAZIM, XCCO2, XDIR_ALB, XDIRFLASWD, XDIRSRFSWD, XDTHRAD, XEMIS, &
@@ -137,6 +140,7 @@ use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
USE MODE_NEIGHBORAVG, ONLY: BLOCKAVG, MOVINGAVG
+USE MODE_THERMO, ONLY: SM_FOES
USE MODE_TOOLS_LL, ONLY: GET_INDICE_ll
#ifdef MNH_RTTOV_8
@@ -171,7 +175,7 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
INTEGER :: IKRAD
!
-INTEGER :: JI,JJ,JK,JSV ! loop index
+INTEGER :: JI,JJ,JK,JSV,JRR ! loop index
!
! variables for Diagnostic variables related to deep convection
REAL,DIMENSION(:,:), ALLOCATABLE :: ZWORK21,ZWORK22
@@ -197,7 +201,8 @@ INTEGER :: IPRES, ITH
CHARACTER(LEN=4) :: YCAR4
CHARACTER(LEN=4), DIMENSION(SIZE(XISOPR)) :: YPRES
CHARACTER(LEN=4), DIMENSION(SIZE(XISOTH)) :: YTH
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK32,ZWORK33,ZWORK34,ZWRES,ZPRES,ZWTH
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK32,ZWORK33,ZWORK34,ZWRES,ZPRES,ZWTH, &
+ ZRT,ZQV,ZMRVP,ZWRES1,ZTEMPP
REAL, DIMENSION(:), ALLOCATABLE :: ZTH
REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPOVO
REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZVOX,ZVOY,ZVOZ
@@ -433,6 +438,22 @@ IF (LCLD_COV .AND. LUSERC) THEN
CALL IO_Field_write(TPFILE,'CLDFR',XCLDFR)
CALL IO_Field_write(TPFILE,'ICEFR',XICEFR)
!
+ ZWORK21(:,:)=0.0
+ ZWORK21(IIB:IIE,IJB:IJE)=MAXVAL(XCLDFR(IIB:IIE,IJB:IJE,JPVEXT+1:IKE),DIM=3)
+
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CLDFRMAX', &
+ !Invalid CF convention standard name: CSTDNAME = 'max_cloud_fraction', &
+ CLONGNAME = 'CLDFRMAX', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_MAx of CLoud fraction', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ !
! Visibility
!
ZWORK31(:,:,:)= 1.E4 ! 10 km for clear sky
@@ -997,6 +1018,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
END DO
ALLOCATE(ZWRES(IIU,IJU,IPRES))
+ ALLOCATE(ZTEMPP(IIU,IJU,IPRES))
ZWRES(:,:,:)=XUNDEF
ALLOCATE(ZPRES(IIU,IJU,IPRES))
IPRES=0
@@ -1032,6 +1054,17 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
END DO
! *********************
+! Temperature
+! *********************
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'TEMP'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'K'
+ TZFIELD%CCOMMENT = 'X_Y_air temperature '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK)*(ZPRES(:,:,JK)/XP00)**(XRD/XCPD))
+ END DO
+ ZTEMPP(:,:,:)=ZWRES(:,:,:)
+! *********************
! Wind
! *********************
ZWORK31(:,:,:) = MXF(XUT(:,:,:))
@@ -1055,6 +1088,29 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YPRES(JK))//' hPa'
CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
END DO
+ !
+ ZWORK31(:,:,:) = MZF(XWT(:,:,:))
+ CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'WT'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+! *********************
+! Turbulent kinetic energy
+! *********************
+ CALL PINTER(XTKET, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'TKET'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm 2 s-2'
+ TZFIELD%CCOMMENT = 'X_Y_turbulent kinetic energy '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
! *********************
! Water Vapour Mixing Ratio
! *********************
@@ -1067,6 +1123,55 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CCOMMENT = 'X_Y_Vapor Mixing Ratio '//TRIM(YPRES(JK))//' hPa'
CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK)*1.E3)
END DO
+!
+! *********************
+! Relative humidity
+! *********************
+ IF (LUSERV) THEN
+ ALLOCATE(ZWRES1(IIU,IJU,IPRES))
+ ALLOCATE(ZMRVP(IIU,IJU,IPRES))
+ ZMRVP(:,:,:)=ZWRES(:,:,:)
+ ZWRES1(:,:,:)=SM_FOES(ZTEMPP(:,:,:))
+ ZWRES1(:,:,:)=(XMV/XMD)*ZWRES1(:,:,:)/(ZPRES(:,:,:)-ZWRES1(:,:,:))
+ ZWRES(:,:,:)=100.*ZMRVP(:,:,:)/ZWRES1(:,:,:)
+ IF (CCLOUD(1:3) =='ICE' .OR. CCLOUD =='C3R5' .OR. CCLOUD == 'LIMA') THEN
+ WHERE ( ZTEMPP(:,:,:)< XTT)
+ ZWRES1(:,:,:) = EXP( XALPI - XBETAI/ZTEMPP(:,:,:) &
+ - XGAMI*ALOG(ZTEMPP(:,:,:)) ) !saturation over ice
+ ZWRES1(:,:,:)=(XMV/XMD)*ZWRES1(:,:,:)/(ZPRES(:,:,:)-ZWRES1(:,:,:))
+ ZWRES(:,:,:)=100.*ZMRVP(:,:,:)/ZWRES1(:,:,:)
+ END WHERE
+ END IF
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'REHU'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'percent'
+ TZFIELD%CCOMMENT = 'X_Y_Relative humidity '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+ DEALLOCATE(ZWRES1,ZMRVP,ZTEMPP)
+ END IF
+ !
+ ALLOCATE(ZRT(IIU,IJU,IKU))
+ ALLOCATE(ZQV(IIU,IJU,IKU))
+ ZRT(:,:,:)=0.
+ DO JRR=1,NRR
+ ZRT(:,:,:) = ZRT(:,:,:) + XRT(:,:,:,JRR)
+ END DO
+ ZQV(:,:,:) = XRT(:,:,:,1) / (1.0 + ZRT(:,:,:))
+ ! *********************
+ ! Water specific humidity
+ ! *********************
+ CALL PINTER(ZQV, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'QV'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Vapor Specific humidity '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+ DEALLOCATE(ZRT,ZQV)
! *********************
! Geopotential in meters
! *********************
diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90
index 98e73e04c80ffa866f208ccd3299bf70d8ab2845..a5f1ddd398c231fed6087c15cf4b9da3a372d016 100644
--- a/src/MNH/write_profilern.f90
+++ b/src/MNH/write_profilern.f90
@@ -25,323 +25,15 @@
MODULE MODE_WRITE_PROFILER_n
! ###########################
-use modd_parameters, only: NCOMMENTLGTMAX, NMNHNAMELGTMAX, NUNITLGTMAX
+use modd_parameters, only: NMNHNAMELGTMAX, NUNITLGTMAX
implicit none
private
-public :: WRITE_PROFILER_n
-
-CHARACTER(LEN=NCOMMENTLGTMAX), DIMENSION(:), ALLOCATABLE :: CCOMMENT ! comment string
-CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CTITLE ! title
-CHARACTER(LEN=NUNITLGTMAX), DIMENSION(:), ALLOCATABLE :: CUNIT ! physical unit
-
-REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: XWORK6 ! contains temporal serie
+public :: PROFILER_DIACHRO_n
contains
-!
-!#######################################
-SUBROUTINE WRITE_PROFILER_n( TPDIAFILE )
-!#######################################
-!
-!
-!**** *WRITE_PROFILER* - write the profilers records in the diachronic file
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
-USE MODD_CONF_n, ONLY: NRR
-USE MODD_DIM_n, ONLY: NKMAX
-USE MODD_IO, ONLY: ISNPROC, ISP, TFILEDATA
-USE MODD_MPIF
-USE MODD_NSV, ONLY: NSV
-USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_PARAM_n, ONLY: CCLOUD, CRAD, CTURB
-USE MODD_PRECISION, ONLY: MNHINT_MPI, MNHREAL_MPI
-USE MODD_PROFILER_n, only: NUMBPROFILER_LOC, TPROFILERS, tprofilers_time
-USE MODD_RADIATIONS_n, ONLY: NAER
-USE MODD_TYPE_STATPROF, ONLY: TPROFILERDATA
-!
-USE MODE_MSG
-USE MODE_STATPROF_TOOLS, ONLY: PROFILER_ALLOCATE
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-INTEGER, PARAMETER :: ITAG = 100
-INTEGER :: IERR
-INTEGER :: IKU
-INTEGER :: JP, JS
-INTEGER :: IDX
-INTEGER :: INUMPROF ! Total number of profilers (for the current model)
-INTEGER :: IPACKSIZE ! Size of the ZPACK buffer
-INTEGER :: IPOS ! Position in the ZPACK buffer
-INTEGER :: ISTORE
-INTEGER, DIMENSION(:), ALLOCATABLE :: INPROFPRC ! Array to store the number of profilers per process (for the current model)
-INTEGER, DIMENSION(:), ALLOCATABLE :: IPROFIDS ! Intermediate array for MPI communication
-INTEGER, DIMENSION(:), ALLOCATABLE :: IPROFPRCRANK ! Array to store the ranks of the processes where the profilers are
-INTEGER, DIMENSION(:), ALLOCATABLE :: IDS ! Array to store the profiler number to send
-INTEGER, DIMENSION(:), ALLOCATABLE :: IDISP ! Array to store the displacements for MPI communications
-REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! Buffer to store raw data of a profiler (used for MPI communication)
-TYPE(TPROFILERDATA) :: TZPROFILER
-!
-!----------------------------------------------------------------------------
-!
-IKU = NKMAX + 2 * JPVEXT
-
-ALLOCATE( INPROFPRC(ISNPROC) )
-ALLOCATE( IDS(NUMBPROFILER_LOC) )
-
-!Gather number of profiler present on each process
-CALL MPI_ALLGATHER( NUMBPROFILER_LOC, 1, MNHINT_MPI, INPROFPRC, 1, MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
-
-!Store the identification number of local profilers (these numbers are globals)
-DO JS = 1, NUMBPROFILER_LOC
- IDS(JS) = TPROFILERS(JS)%NID
-END DO
-
-ALLOCATE( IDISP(ISNPROC) )
-IDISP(1) = 0
-DO JP = 2, ISNPROC
- IDISP(JP) = IDISP(JP-1) + INPROFPRC(JP-1)
-END DO
-
-INUMPROF = SUM( INPROFPRC(:) )
-ALLOCATE( IPROFIDS(INUMPROF) )
-ALLOCATE( IPROFPRCRANK(INUMPROF) )
-
-!Gather the list of all the profilers of all processes
-CALL MPI_ALLGATHERV( IDS(:), NUMBPROFILER_LOC, MNHINT_MPI, IPROFIDS(:), INPROFPRC(:), &
- IDISP(:), MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
-
-!Store the rank of each process corresponding to a given profiler
-IDX = 1
-IPROFPRCRANK(:) = -1
-DO JP = 1, ISNPROC
- DO JS = 1, INPROFPRC(JP)
- IPROFPRCRANK(IPROFIDS(IDX)) = JP
- IDX = IDX + 1
- END DO
-END DO
-
-CALL PROFILER_ALLOCATE( TZPROFILER, SIZE( tprofilers_time%tpdates ) )
-
-!Determine the size of the ZPACK buffer used to transfer profiler data in 1 MPI communication
-IF ( ISNPROC > 1 ) THEN
- ISTORE = SIZE( TPROFILERS_TIME%TPDATES )
- IPACKSIZE = 6
- IPACKSIZE = IPACKSIZE + ISTORE * IKU * ( 14 + NRR + NSV + NAER )
- IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) IPACKSIZE = IPACKSIZE + ISTORE * IKU !VISIGUL
- IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) IPACKSIZE = IPACKSIZE + ISTORE * IKU !VISIKUN
- IF ( CTURB == 'TKEL') IPACKSIZE = IPACKSIZE + ISTORE * IKU !Tke term
- IF ( CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4' ) IPACKSIZE = IPACKSIZE + ISTORE * IKU !CIZ term
- IPACKSIZE = IPACKSIZE + 4 * ISTORE
- IF ( LDIAG_SURFRAD_PROF ) THEN
- IPACKSIZE = IPACKSIZE + ISTORE * 10
- IF ( CRAD /= 'NONE' ) IPACKSIZE = IPACKSIZE + ISTORE * 8
- IPACKSIZE = IPACKSIZE + ISTORE !XSFCO2 term
- END IF
- IPACKSIZE = IPACKSIZE + ISTORE * IKU !XTKE_DISS term
-
- ALLOCATE( ZPACK(IPACKSIZE) )
-END IF
-
-IDX = 1
-
-PROFILER: DO JS = 1, INUMPROF
- IF ( IPROFPRCRANK(JS) == TPDIAFILE%NMASTER_RANK ) THEN
- !No communication necessary, the profiler data is already on the writer process
- IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
- TZPROFILER = TPROFILERS(IDX)
- IDX = IDX + 1
- END IF
- ELSE
- !The profiler data is not on the writer process
- IF ( ISP == IPROFPRCRANK(JS) ) THEN
- ! This process has the data and needs to send it to the writer process
- IPOS = 1
- ZPACK(IPOS) = TPROFILERS(IDX)%NID; IPOS = IPOS + 1
- ZPACK(IPOS) = TPROFILERS(IDX)%XX; IPOS = IPOS + 1
- ZPACK(IPOS) = TPROFILERS(IDX)%XY; IPOS = IPOS + 1
- ZPACK(IPOS) = TPROFILERS(IDX)%XZ; IPOS = IPOS + 1
- ZPACK(IPOS) = TPROFILERS(IDX)%XLON; IPOS = IPOS + 1
- ZPACK(IPOS) = TPROFILERS(IDX)%XLAT; IPOS = IPOS + 1
-
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XZON(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XMER(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XFF(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XDD(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XW(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XP(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XZZ(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- IF ( CTURB == 'TKEL') THEN
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XTKE(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- END IF
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XTH(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XTHV(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) THEN
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XVISIGUL(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- END IF
- IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XVISIKUN(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- END IF
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XCRARE(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XCRARE_ATT(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- IF ( CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4' ) THEN
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XCIZ(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- END IF
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XLWCZ(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XIWCZ(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XRHOD(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
-
- ZPACK(IPOS:IPOS+ISTORE*IKU*NRR-1) = RESHAPE( TPROFILERS(IDX)%XR(:,:,:), [ISTORE*IKU*NRR] )
- IPOS = IPOS + ISTORE * IKU * NRR
- ZPACK(IPOS:IPOS+ISTORE*IKU*NSV-1) = RESHAPE( TPROFILERS(IDX)%XSV(:,:,:), [ISTORE*IKU*NSV] )
- IPOS = IPOS + ISTORE * IKU * NSV
- ZPACK(IPOS:IPOS+ISTORE*IKU*NAER-1) = RESHAPE( TPROFILERS(IDX)%XAER(:,:,:), [ISTORE*IKU*NAER] )
- IPOS = IPOS + ISTORE * IKU * NAER
-
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XIWV(:); IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XZTD(:); IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XZWD(:); IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XZHD(:); IPOS = IPOS + ISTORE
-
- IF ( LDIAG_SURFRAD_PROF ) THEN
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XT2M; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XQ2M; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XHU2M; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XZON10M; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XMER10M; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XRN; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XH; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XLE; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XGFLUX; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XLEI; IPOS = IPOS + ISTORE
- IF ( CRAD /= 'NONE' ) THEN
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XSWD; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XSWU; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XLWD; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XLWU; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XSWDIR; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XSWDIFF; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XDSTAOD; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XSLTAOD; IPOS = IPOS + ISTORE
- END IF
- ZPACK(IPOS:IPOS+ISTORE-1) = TPROFILERS(IDX)%XSFCO2; IPOS = IPOS + ISTORE
- END IF
-
- ZPACK(IPOS:IPOS+ISTORE*IKU-1) = RESHAPE( TPROFILERS(IDX)%XTKE_DISS(:,:), [ISTORE*IKU] ) ; IPOS = IPOS + ISTORE * IKU
-
- IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_WARNING, 'IO', 'WRITE_PROFILER_n', 'IPOS-1 /= IPACKSIZE (sender side)', OLOCAL = .TRUE. )
-
- CALL MPI_SEND( TPROFILERS(IDX)%CNAME, LEN(TPROFILERS(IDX)%CNAME), MPI_CHARACTER, TPDIAFILE%NMASTER_RANK - 1, &
- ITAG, TPDIAFILE%NMPICOMM, IERR )
- CALL MPI_SEND( ZPACK, IPACKSIZE, MNHREAL_MPI, TPDIAFILE%NMASTER_RANK - 1, ITAG, TPDIAFILE%NMPICOMM, IERR )
-
- IDX = IDX + 1
-
- ELSE IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
- ! This process is the writer and will receive the profiler data from its owner
- CALL MPI_RECV( TZPROFILER%CNAME, LEN(TZPROFILER%CNAME), MPI_CHARACTER, &
- IPROFPRCRANK(JS) - 1, ITAG, TPDIAFILE%NMPICOMM, MPI_STATUS_IGNORE, IERR )
- CALL MPI_RECV( ZPACK, IPACKSIZE, MNHREAL_MPI, IPROFPRCRANK(JS) - 1, ITAG, TPDIAFILE%NMPICOMM, MPI_STATUS_IGNORE, IERR )
-
- IPOS = 1
- TZPROFILER%NID = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
- TZPROFILER%XX = ZPACK(IPOS); IPOS = IPOS + 1
- TZPROFILER%XY = ZPACK(IPOS); IPOS = IPOS + 1
- TZPROFILER%XZ = ZPACK(IPOS); IPOS = IPOS + 1
- TZPROFILER%XLON = ZPACK(IPOS); IPOS = IPOS + 1
- TZPROFILER%XLAT = ZPACK(IPOS); IPOS = IPOS + 1
-
- TZPROFILER%XZON(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- TZPROFILER%XMER(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- TZPROFILER%XFF(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- TZPROFILER%XDD(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- TZPROFILER%XW(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- TZPROFILER%XP(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- TZPROFILER%XZZ(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- IF ( CTURB == 'TKEL') THEN
- TZPROFILER%XTKE(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- END IF
- TZPROFILER%XTH(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- TZPROFILER%XTHV(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) THEN
- TZPROFILER%XVISIGUL(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- END IF
- IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
- TZPROFILER%XVISIKUN(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- END IF
- TZPROFILER%XCRARE(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- TZPROFILER%XCRARE_ATT(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- IF ( CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4' ) THEN
- TZPROFILER%XCIZ(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- END IF
- TZPROFILER%XLWCZ(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- TZPROFILER%XIWCZ(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
- TZPROFILER%XRHOD(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
-
- TZPROFILER%XR(:,:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU*NRR-1), [ ISTORE, IKU, NRR ] )
- IPOS = IPOS + ISTORE * IKU * NRR
- TZPROFILER%XSV(:,:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU*NSV-1), [ ISTORE, IKU, NSV ] )
- IPOS = IPOS + ISTORE * IKU * NSV
- TZPROFILER%XAER(:,:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU*NAER-1), [ ISTORE, IKU, NAER ] )
- IPOS = IPOS + ISTORE * IKU * NAER
-
- TZPROFILER%XIWV(:) = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XZTD(:) = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XZWD(:) = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XZHD(:) = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
-
- IF ( LDIAG_SURFRAD_PROF ) THEN
- TZPROFILER%XT2M = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XQ2M = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XHU2M = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XZON10M = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XMER10M = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XRN = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XH = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XLE = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XGFLUX = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- TZPROFILER%XLEI = ZPACK(IPOS:IPOS+ISTORE-1) ; IPOS = IPOS + ISTORE
- IF ( CRAD /= 'NONE' ) THEN
- TZPROFILER%XSWD = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZPROFILER%XSWU = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZPROFILER%XLWD = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZPROFILER%XLWU = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZPROFILER%XSWDIR = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZPROFILER%XSWDIFF = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZPROFILER%XDSTAOD = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZPROFILER%XSLTAOD = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- END IF
- TZPROFILER%XSFCO2 = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- END IF
-
- TZPROFILER%XTKE_DISS(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*IKU-1), [ ISTORE, IKU ] ) ; IPOS = IPOS + ISTORE * IKU
-
- IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_WARNING, 'IO', 'WRITE_PROFILER_n', 'IPOS-1 /= IPACKSIZE (receiver side)', OLOCAL = .TRUE. )
- END IF
- END IF
-
- CALL PROFILER_DIACHRO_n( TPDIAFILE, TZPROFILER )
-
-END DO PROFILER
-
-
-END SUBROUTINE WRITE_PROFILER_n
-
! ####################################################
SUBROUTINE PROFILER_DIACHRO_n( TPDIAFILE, TPPROFILER )
@@ -350,7 +42,7 @@ SUBROUTINE PROFILER_DIACHRO_n( TPDIAFILE, TPPROFILER )
USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
use modd_budget, only: NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
tbudiachrometadata
-USE MODD_CH_AEROSOL, ONLY: LORILAM, JPMODE
+USE MODD_CH_AEROSOL, ONLY: JPMODE, LORILAM, NCARB, NSOA, NSP
USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_CONF_n, ONLY: NRR
USE MODD_CST, ONLY: XRV
@@ -359,16 +51,19 @@ USE MODD_DIM_n, ONLY: NKMAX
use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, NMNHDIM_PROFILER_TIME, NMNHDIM_PROFILER_PROC, NMNHDIM_UNUSED, &
tfieldmetadata_base, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NSV, ONLY: tsvlist, nsv, nsv_aer, nsv_aerbeg, nsv_aerend, nsv_dst, nsv_dstbeg, nsv_dstend
+USE MODD_NSV, ONLY: tsvlist, nsv
USE MODD_PARAMETERS, ONLY: JPVEXT, XUNDEF
USE MODD_PARAM_n, ONLY: CCLOUD, CRAD, CTURB
USE MODD_PROFILER_n
USE MODD_RADIATIONS_n, ONLY: NAER
-USE MODD_SALT, ONLY: LSALT
+USE MODD_SALT, ONLY: LSALT, NMODE_SLT
USE MODD_TYPE_STATPROF
!
-USE MODE_AERO_PSD
-USE MODE_DUST_PSD
+use mode_sensor, only: Add_dust_data, Add_fixpoint, Add_orilam_data, Add_point, Add_profile, Add_salt_data, &
+ Sensor_current_processes_number_get, &
+ ccomment, ctitle, cunit, xwork6, &
+ Sensor_write_workarrays_allocate, Sensor_write_workarrays_deallocate
+use mode_statprof_tools, only: Add_diag_surfrad_data
use mode_write_diachro, only: Write_diachro
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
@@ -376,48 +71,41 @@ TYPE(TPROFILERDATA), INTENT(IN) :: TPPROFILER
!
!* 0.2 declaration of local variables for diachro
!
-character(len=NMNHNAMELGTMAX) :: yname
-character(len=NUNITLGTMAX) :: yunits
+character(len=NMNHNAMELGTMAX) :: ytitle
+character(len=NUNITLGTMAX) :: yunit
INTEGER :: IKU
INTEGER :: IPROC ! number of variables records
INTEGER :: JPROC
integer :: jproc_alt, jproc_w
INTEGER :: JRR ! loop counter
INTEGER :: JSV ! loop counter
-integer :: ji
INTEGER :: ISTORE
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZSIG, ZRG
type(tbudiachrometadata) :: tzbudiachro
type(tfieldmetadata_base), dimension(:), allocatable :: tzfields
!
!----------------------------------------------------------------------------
IKU = NKMAX + 2 * JPVEXT !Number of vertical levels
-!
-!IPROC is too large (not a big problem) due to the separation between vertical profiles and point values
-IPROC = 25 + NRR + NSV
-IF (LDIAG_SURFRAD_PROF) THEN
- IPROC = IPROC + 10
- IF(CRAD/="NONE") IPROC = IPROC + 8
- IPROC = IPROC + 1 ! XSFCO2 term
-END IF
-IF (LORILAM) IPROC = IPROC + JPMODE*3
-IF (LDUST) IPROC = IPROC + NMODE_DST*3
+
+IPROC = 13 + NRR + NSV
+if ( ccloud == 'C2R2' .or. ccloud == 'KHKO' ) IPROC = IPROC + 1
+if ( ccloud /= 'NONE' .and. ccloud /= 'REVE' ) IPROC = IPROC + 1
+if ( ccloud == 'ICE3' .or. ccloud == 'ICE4' ) IPROC = IPROC + 1
+if ( ccloud == 'LIMA' ) IPROC = IPROC + 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 (LDUST .OR. LORILAM .OR. LSALT) IPROC=IPROC+NAER
IF ( CTURB == 'TKEL' ) IPROC = IPROC + 1
ISTORE = SIZE( TPROFILERS_TIME%TPDATES )
-ALLOCATE ( XWORK6(1, 1, IKU, ISTORE, 1, IPROC) )
-ALLOCATE ( CCOMMENT(IPROC) )
-ALLOCATE ( CTITLE (IPROC) )
-ALLOCATE ( CUNIT (IPROC) )
+call Sensor_write_workarrays_allocate( iku, istore, iproc )
!
!----------------------------------------------------------------------------
!Treat vertical profiles
-jproc = 0
call Add_profile( 'Th', 'Potential temperature', 'K', tpprofiler%xth )
call Add_profile( 'Thv', 'Virtual Potential temperature', 'K', tpprofiler%xthv )
@@ -430,19 +118,24 @@ call Add_profile( 'RAREatt', 'Radar attenuated reflectivity', 'dBZ', tpprofi
call Add_profile( 'P', 'Pressure', 'Pa', tpprofiler%xp )
call Add_profile( 'ALT', 'Altitude', 'm', tpprofiler%xzz )
!Store position of ALT in the field list. Useful because it is not computed on the same Arakawa-grid points
-jproc_alt = jproc
+jproc_alt = Sensor_current_processes_number_get()
call Add_profile( 'ZON_WIND', 'Zonal wind', 'm s-1', tpprofiler%xzon )
-call Add_profile( 'MER_WIND', 'Meridional wind', 'm s-1', tpprofiler%xmer )
+call Add_profile( 'MER_WIND', 'Meridian wind', 'm s-1', tpprofiler%xmer )
call Add_profile( 'FF', 'Wind intensity', 'm s-1', tpprofiler%xff )
call Add_profile( 'DD', 'Wind direction', 'degree', tpprofiler%xdd )
call Add_profile( 'W', 'Air vertical speed', 'm s-1', tpprofiler%xw )
!Store position of W in the field list. Useful because it is not computed on the same Arakawa-grid points
-jproc_w = jproc
+jproc_w = Sensor_current_processes_number_get()
call Add_profile( 'TKE_DISS', 'TKE dissipation rate', 'm2 s-2', tpprofiler%xtke_diss )
-if ( ccloud == 'ICE3' .or. ccloud == 'ICE4' ) &
- call Add_profile( 'CIT', 'Ice concentration', 'kg-3', tpprofiler%xciz )
+if ( ccloud == 'LIMA' ) then
+ call Add_profile( 'CCLOUDT', 'liquid cloud concentration', 'kg-1', tpprofiler%xccz(:,:) )
+ call Add_profile( 'CRAINT', 'Rain concentration', 'kg-1', tpprofiler%xcrz(:,:) )
+ call Add_profile( 'CICET', 'Ice concentration', 'kg-1', tpprofiler%xciz(:,:) )
+else if ( ccloud == 'ICE3' .or. ccloud == 'ICE4' ) then
+ call Add_profile( 'CIT', 'Ice concentration', 'm-3', tpprofiler%xciz(:,:) )
+end if
if ( nrr >= 1 ) call Add_profile( 'Rv', 'Water vapor mixing ratio', 'kg kg-1', tpprofiler%xr(:,:,1) )
if ( nrr >= 2 ) call Add_profile( 'Rc', 'Liquid cloud water mixing ratio', 'kg kg-1', tpprofiler%xr(:,:,2) )
@@ -452,7 +145,7 @@ if ( nrr >= 5 ) call Add_profile( 'Rs', 'Snow mixing ratio', 'kg k
if ( nrr >= 6 ) call Add_profile( 'Rg', 'Graupel mixing ratio', 'kg kg-1', tpprofiler%xr(:,:,6) )
if ( nrr >= 7 ) call Add_profile( 'Rh', 'Hail mixing ratio', 'kg kg-1', tpprofiler%xr(:,:,7) )
-call Add_profile( 'Rhod', 'Density of dry air in moist', 'kg m-3', tpprofiler%xrhod )
+call Add_profile( 'Rhod', 'Density of dry air', 'kg m-3', tpprofiler%xrhod )
if ( cturb == 'TKEL') &
call Add_profile( 'Tke', 'Turbulent kinetic energy', 'm2 s-2', tpprofiler%xtke )
@@ -461,138 +154,30 @@ if ( nsv > 0 ) then
Allocate( zwork, mold = tpprofiler%xsv(:,:,1) )
do jsv = 1, nsv
if ( Trim( tsvlist(jsv)%cunits ) == 'ppv' ) then
- yunits = 'ppb'
+ yunit = 'ppb'
zwork = tpprofiler%xsv(:,:,jsv) * 1.e9 !*1e9 for conversion ppv->ppb
else
- yunits = Trim( tsvlist(jsv)%cunits )
+ yunit = Trim( tsvlist(jsv)%cunits )
zwork = tpprofiler%xsv(:,:,jsv)
end if
- call Add_profile( tsvlist(jsv)%cmnhname, '', yunits, zwork )
+ call Add_profile( tsvlist(jsv)%cmnhname, '', yunit, zwork )
end do
Deallocate( zwork )
- IF ( LORILAM .AND. .NOT.(ANY(TPPROFILER%XP(:,:) == 0.)) ) THEN
- ALLOCATE (ZSV (1,iku,ISTORE,NSV_AER))
- ALLOCATE (ZRHO(1,iku,ISTORE))
- ALLOCATE (ZN0 (1,iku,ISTORE,JPMODE))
- ALLOCATE (ZRG (1,iku,ISTORE,JPMODE))
- ALLOCATE (ZSIG(1,iku,ISTORE,JPMODE))
- do ji = 1, iku
- ZSV(1,ji,:,1:NSV_AER) = TPPROFILER%XSV(:,ji,NSV_AERBEG:NSV_AEREND)
- end do
- IF ( NRR > 0) THEN
- ZRHO(1,:,:) = 0.
- do ji = 1, iku
- DO JRR = 1, NRR
- ZRHO(1,ji,:) = ZRHO(1,ji,:) + TPPROFILER%XR(:,ji,JRR)
- ENDDO
- ZRHO(1,ji,:) = TPPROFILER%XTH(:,ji) * ( 1. + XRV/XRD*TPPROFILER%XR(:,ji,1) ) &
- / ( 1. + ZRHO(1,ji,:) )
- end do
- ELSE
- do ji = 1, iku
- ZRHO(1,ji,:) = TPPROFILER%XTH(:,ji)
- end do
- ENDIF
- do ji = 1, iku
- ZRHO(1,ji,:) = TPPROFILER%XP(:,ji) / &
- (XRD *ZRHO(1,ji,:) *((TPPROFILER%XP(:,ji)/XP00)**(XRD/XCPD)) )
- end do
- CALL PPP2AERO(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0)
- DO JSV=1,JPMODE
- ! mean radius
- JPROC = JPROC+1
- WRITE(CTITLE(JPROC),'(A6,I1)')'AERRGA',JSV
- CUNIT(JPROC) = 'um'
- WRITE(CCOMMENT(JPROC),'(A18,I1)')'RG (nb) AERO MODE ',JSV
- do ji = 1, iku
- XWORK6(1,1,ji,:,1,JPROC) = ZRG(1,ji,:,JSV)
- end do
- ! standard deviation
- JPROC = JPROC+1
- WRITE(CTITLE(JPROC),'(A7,I1)')'AERSIGA',JSV
- CUNIT(JPROC) = ' '
- WRITE(CCOMMENT(JPROC),'(A16,I1)')'SIGMA AERO MODE ',JSV
- do ji = 1, iku
- XWORK6(1,1,ji,:,1,JPROC) = ZSIG(1,ji,:,JSV)
- end do
- ! particles number
- JPROC = JPROC+1
- WRITE(CTITLE(JPROC),'(A6,I1)')'AERN0A',JSV
- CUNIT(JPROC) = 'm-3'
- WRITE(CCOMMENT(JPROC),'(A13,I1)')'N0 AERO MODE ',JSV
- do ji = 1, iku
- XWORK6(1,1,ji,:,1,JPROC) = ZN0(1,ji,:,JSV)
- end do
- ENDDO
- DEALLOCATE (ZSV,ZRHO)
- DEALLOCATE (ZN0,ZRG,ZSIG)
- END IF
- IF ((LDUST).AND. .NOT.(ANY(TPPROFILER%XP(:,:) == 0.))) THEN
- ALLOCATE (ZSV (1,iku,ISTORE,NSV_DST))
- ALLOCATE (ZRHO(1,iku,ISTORE))
- ALLOCATE (ZN0 (1,iku,ISTORE,NMODE_DST))
- ALLOCATE (ZRG (1,iku,ISTORE,NMODE_DST))
- ALLOCATE (ZSIG(1,iku,ISTORE,NMODE_DST))
- do ji = 1, iku
- ZSV(1,ji,:,1:NSV_DST) = TPPROFILER%XSV(:,ji,NSV_DSTBEG:NSV_DSTEND)
- end do
- IF ( NRR > 0 ) THEN
- ZRHO(1,:,:) = 0.
- do ji = 1, iku
- DO JRR = 1, NRR
- ZRHO(1,ji,:) = ZRHO(1,ji,:) + TPPROFILER%XR(:,ji,JRR)
- ENDDO
- ZRHO(1,ji,:) = TPPROFILER%XTH(:,ji) * ( 1. + XRV/XRD*TPPROFILER%XR(:,ji,1) ) &
- / ( 1. + ZRHO(1,ji,:) )
- end do
- ELSE
- do ji = 1, iku
- ZRHO(1,ji,:) = TPPROFILER%XTH(:,ji)
- end do
- ENDIF
- do ji = 1, iku
- ZRHO(1,ji,:) = TPPROFILER%XP(:,ji) / &
- (XRD *ZRHO(1,ji,:) *((TPPROFILER%XP(:,ji)/XP00)**(XRD/XCPD)) )
- end do
- CALL PPP2DUST(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0)
- DO JSV=1,NMODE_DST
- ! mean radius
- JPROC = JPROC+1
- WRITE(CTITLE(JPROC),'(A6,I1)')'DSTRGA',JSV
- CUNIT(JPROC) = 'um'
- WRITE(CCOMMENT(JPROC),'(A18,I1)')'RG (nb) DUST MODE ',JSV
- do ji = 1, iku
- XWORK6 (1,1,ji,:,1,JPROC) = ZRG(1,ji,:,JSV)
- end do
- ! standard deviation
- JPROC = JPROC+1
- WRITE(CTITLE(JPROC),'(A7,I1)')'DSTSIGA',JSV
- CUNIT(JPROC) = ' '
- WRITE(CCOMMENT(JPROC),'(A16,I1)')'SIGMA DUST MODE ',JSV
- do ji = 1, iku
- XWORK6 (1,1,ji,:,1,JPROC) = ZSIG(1,ji,:,JSV)
- end do
- ! particles number
- JPROC = JPROC+1
- WRITE(CTITLE(JPROC),'(A6,I1)')'DSTN0A',JSV
- CUNIT(JPROC) = 'm-3'
- WRITE(CCOMMENT(JPROC),'(A13,I1)')'N0 DUST MODE ',JSV
- do ji = 1, iku
- XWORK6 (1,1,ji,:,1,JPROC) = ZN0(1,ji,:,JSV)
- end do
- ENDDO
- DEALLOCATE (ZSV,ZRHO)
- DEALLOCATE (ZN0,ZRG,ZSIG)
- END IF
+ if ( lorilam ) call Add_orilam_data( tpprofiler, iku, istore )
+ if ( ldust ) call Add_dust_data ( tpprofiler, iku, istore )
+ if ( lsalt ) call Add_salt_data ( tpprofiler, iku, istore )
+
if ( ldust .or. lorilam .or. lsalt ) then
do jsv = 1, naer
- Write( yname, '( a, i1 )' ) 'AEREXT', jsv
- call Add_profile( yname, 'Aerosol Extinction', '1', tpprofiler%xaer(:,:,jsv) )
+ Write( ytitle, '( a, i1 )' ) 'AEREXT', jsv
+ call Add_profile( ytitle, 'Aerosol Extinction', '1', tpprofiler%xaer(:,:,jsv) )
end do
end if
end if
+jproc = Sensor_current_processes_number_get()
+
allocate( tzfields( jproc ) )
tzfields(:)%cmnhname = ctitle(1 : jproc)
@@ -665,44 +250,35 @@ tzbudiachro%nkh = iku
call Write_diachro( tpdiafile, tzbudiachro, tzfields, tprofilers_time%tpdates, xwork6(:,:,:,:,:,:jproc) )
Deallocate( tzfields )
-Deallocate( xwork6 )
+call Sensor_write_workarrays_deallocate( )
!----------------------------------------------------------------------------
!Treat point values
-ALLOCATE ( XWORK6(1, 1, 1, ISTORE, 1, IPROC) )
-
-jproc = 0
-
-if ( ldiag_surfrad_prof ) then
- call Add_point( 'T2m', '2-m temperature', 'K', tpprofiler%xt2m )
- call Add_point( 'Q2m', '2-m humidity', 'kg kg-1', tpprofiler%xq2m )
- call Add_point( 'HU2m', '2-m relative humidity', 'percent', tpprofiler%xhu2m )
- call Add_point( 'zon10m', '10-m zonal wind', 'm s-1', tpprofiler%xzon10m )
- call Add_point( 'mer10m', '10-m meridian wind', 'm s-1', tpprofiler%xmer10m )
- call Add_point( 'RN', 'Net radiation', 'W m-2', tpprofiler%xrn )
- call Add_point( 'H', 'Sensible heat flux', 'W m-2', tpprofiler%xh )
- call Add_point( 'LE', 'Total Latent heat flux', 'W m-2', tpprofiler%xle )
- call Add_point( 'G', 'Storage heat flux', 'W m-2', tpprofiler%xgflux )
- if ( crad /= 'NONE' ) then
- call Add_point( 'SWD', 'Downward short-wave radiation', 'W m-2', tpprofiler%xswd )
- call Add_point( 'SWU', 'Upward short-wave radiation', 'W m-2', tpprofiler%xswu )
- call Add_point( 'LWD', 'Downward long-wave radiation', 'W m-2', tpprofiler%xlwd )
- call Add_point( 'LWU', 'Upward long-wave radiation', 'W m-2', tpprofiler%xlwu )
- call Add_point( 'SWDIR', 'Downward direct short-wave radiation', 'W m-2', tpprofiler%xswdir(:) )
- call Add_point( 'SWDIFF', 'Downward diffuse short-wave radiation', 'W m-2', tpprofiler%xswdiff(:) )
- call Add_point( 'DSTAOD', 'Dust aerosol optical depth', 'm', tpprofiler%xdstaod(:) )
- call Add_point( 'SLTAOD', 'Salt aerosol optical depth', 'm', tpprofiler%xsltaod(:) )
- end if
- call Add_point( 'LEI', 'Solid Latent heat flux', 'W m-2', tpprofiler%xlei )
-end if
+IPROC = 4
+IF (LDIAG_SURFRAD_PROF) THEN
+ IPROC = IPROC + 10
+ IF(CRAD/="NONE") IPROC = IPROC + 8
+ IPROC = IPROC + 1 ! XSFCO2 term
+END IF
+IF( CRAD /= 'NONE' ) IPROC = IPROC + 1 !Tsrad term
+
+call Sensor_write_workarrays_allocate( 1, istore, iproc )
+
+! xrhod_sensor NOT computed => not written
+! if needed, please add its computation in STATION_n
+! call Add_point( 'Rhod', 'Density of dry air', 'kg m-3', tpstation%xrhod_sensor )
+
+if ( ldiag_surfrad_prof ) call Add_diag_surfrad_data( tpprofiler )
call Add_point( 'IWV', 'Integrated Water Vapour', 'kg m-2', tpprofiler%xiwv )
call Add_point( 'ZTD', 'Zenith Tropospheric Delay', 'm', tpprofiler%xztd )
call Add_point( 'ZWD', 'Zenith Wet Delay', 'm', tpprofiler%xzwd )
call Add_point( 'ZHD', 'Zenith Hydrostatic Delay', 'm', tpprofiler%xzhd )
-if ( ldiag_surfrad_prof ) call Add_point( 'SFCO2', 'CO2 Surface Flux', 'mg m-2 s-1', tpprofiler%xsfco2(:) )
+if ( crad /= 'NONE' ) call Add_point( 'Tsrad', 'Radiative Surface Temperature', 'K', tpprofiler%xtsrad(:) )
+
+jproc = Sensor_current_processes_number_get()
Allocate( tzfields( jproc ) )
@@ -770,44 +346,26 @@ tzbudiachro%nkh = 1
call Write_diachro( tpdiafile, tzbudiachro, tzfields, tprofilers_time%tpdates, xwork6(:,:,:,:,:,:jproc) )
Deallocate( tzfields )
-
+call Sensor_write_workarrays_deallocate( )
!----------------------------------------------------------------------------
!Treat position
-jproc = 0
+IPROC = 3
+
+call Sensor_write_workarrays_allocate( 1, 1, iproc )
if ( lcartesian ) then
- JPROC = JPROC + 1
- CTITLE (JPROC) = 'X'
- CUNIT (JPROC) = 'm'
- CCOMMENT (JPROC) = 'X Pos'
- XWORK6 (1,1,1,:,1,JPROC) = TPPROFILER%XX
-
- JPROC = JPROC + 1
- CTITLE (JPROC) = 'Y'
- CUNIT (JPROC) = 'm'
- CCOMMENT (JPROC) = 'Y Pos'
- XWORK6 (1,1,1,:,1,JPROC) = TPPROFILER%XY
+ call Add_fixpoint( 'X', 'X position', 'm', TPPROFILER%XX_CUR )
+ call Add_fixpoint( 'Y', 'Y position', 'm', TPPROFILER%XY_CUR )
else
- JPROC = JPROC + 1
- CTITLE (JPROC) = 'LON'
- CUNIT (JPROC) = 'degree'
- CCOMMENT (JPROC) = 'Longitude'
- XWORK6 (1,1,1,:,1,JPROC) = TPPROFILER%XLON
-
- JPROC = JPROC + 1
- CTITLE (JPROC) = 'LAT'
- CUNIT (JPROC) = 'degree'
- CCOMMENT (JPROC) = 'Latitude'
- XWORK6 (1,1,1,:,1,JPROC) = TPPROFILER%XLAT
+ call Add_fixpoint( 'LON', 'longitude', 'degree', TPPROFILER%XLON_CUR )
+ call Add_fixpoint( 'LAT', 'latitude', 'degree', TPPROFILER%XLAT_CUR )
end if
-JPROC = JPROC + 1
-CTITLE (JPROC) = 'Z'
-CUNIT (JPROC) = 'm'
-CCOMMENT (JPROC) = 'altitude'
-XWORK6 (1,1,1,:,1,JPROC) = TPPROFILER%XZ
+call Add_fixpoint( 'Z', 'altitude', 'm', TPPROFILER%XZ_CUR )
+
+jproc = Sensor_current_processes_number_get()
Allocate( tzfields( jproc ) )
@@ -828,64 +386,8 @@ tzfields(:)%ndimlist(6) = NMNHDIM_PROFILER_PROC
call Write_diachro( tpdiafile, tzbudiachro, tzfields, tprofilers_time%tpdates, xwork6(:,:,:,:,:,:jproc) )
-
-!Necessary because global variables (private inside module)
-Deallocate( xwork6 )
-Deallocate (ccomment)
-Deallocate (ctitle )
-Deallocate (cunit )
-
-contains
-
-
-subroutine Add_profile( htitle, hcomment, hunits, pfield )
-
-use mode_msg
-
-character(len=*), intent(in) :: htitle
-character(len=*), intent(in) :: hcomment
-character(len=*), intent(in) :: hunits
-real, dimension(:,:), intent(in) :: pfield
-
-integer :: jk
-
-jproc = jproc + 1
-
-if ( jproc > iproc ) call Print_msg( NVERB_FATAL, 'IO', 'Add_profile', 'more processes than expected' )
-
-ctitle(jproc) = Trim( htitle )
-ccomment(jproc) = Trim( hcomment )
-cunit(jproc) = Trim( hunits )
-
-do jk = 1, iku
- xwork6(1, 1, jk, :, 1, jproc) = pfield(:, jk)
-end do
-
-end subroutine Add_profile
-
-
-subroutine Add_point( htitle, hcomment, hunits, pfield )
-
-use mode_msg
-
-character(len=*), intent(in) :: htitle
-character(len=*), intent(in) :: hcomment
-character(len=*), intent(in) :: hunits
-real, dimension(:), intent(in) :: pfield
-
-integer :: jk
-
-jproc = jproc + 1
-
-if ( jproc > iproc ) call Print_msg( NVERB_FATAL, 'IO', 'Add_point', 'more processes than expected' )
-
-ctitle(jproc) = Trim( htitle)
-ccomment(jproc) = Trim( hcomment )
-cunit(jproc) = Trim( hunits )
-
-xwork6(1, 1, 1, :, 1, jproc) = pfield(:)
-
-end subroutine Add_point
+Deallocate( tzfields )
+call Sensor_write_workarrays_deallocate( )
END SUBROUTINE PROFILER_DIACHRO_n
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index 903380597d8454e9743a91097c1f9a47f0b5d8e9..cbdaa5748e648415c397bc3e139ba852b8468fe5 100644
--- a/src/MNH/write_stationn.f90
+++ b/src/MNH/write_stationn.f90
@@ -18,263 +18,13 @@
MODULE MODE_WRITE_STATION_n
! ###########################
-use modd_parameters, only: NCOMMENTLGTMAX, NMNHNAMELGTMAX, NUNITLGTMAX
-
implicit none
private
-public :: WRITE_STATION_n
-
-CHARACTER(LEN=NCOMMENTLGTMAX), DIMENSION(:), ALLOCATABLE :: CCOMMENT ! comment string
-CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CTITLE ! title
-CHARACTER(LEN=NUNITLGTMAX), DIMENSION(:), ALLOCATABLE :: CUNIT ! physical unit
-
-REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: XWORK6 ! contains temporal serie
+public :: STATION_DIACHRO_n
contains
-!
-! #####################################
-SUBROUTINE WRITE_STATION_n( TPDIAFILE )
-! #####################################
-!
-!
-!**** *WRITE_STATION* - write the stations records in the diachronic file
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_ALLSTATION_n, ONLY: LDIAG_SURFRAD_STAT
-USE MODD_CONF_n, ONLY: NRR
-USE MODD_IO, ONLY: ISNPROC, ISP, TFILEDATA
-USE MODD_MPIF
-USE MODD_NSV, ONLY: nsv
-USE MODD_PARAM_n, ONLY: CRAD, CSURF, CTURB
-USE MODD_PRECISION, ONLY: MNHINT_MPI, MNHREAL_MPI
-USE MODD_STATION_n, only: NUMBSTAT_LOC, TSTATIONS, tstations_time
-USE MODD_TYPE_STATPROF, ONLY: TSTATIONDATA
-!
-USE MODE_MSG
-USE MODE_STATPROF_TOOLS, ONLY: STATION_ALLOCATE
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-INTEGER, PARAMETER :: ITAG = 100
-INTEGER :: IERR
-INTEGER :: JP, JS
-INTEGER :: IDX
-INTEGER :: INUMSTAT ! Total number of stations (for the current model)
-INTEGER :: IPACKSIZE ! Size of the ZPACK buffer
-INTEGER :: IPOS ! Position in the ZPACK buffer
-INTEGER :: ISTORE
-INTEGER, DIMENSION(:), ALLOCATABLE :: INSTATPRC ! Array to store the number of stations per process (for the current model)
-INTEGER, DIMENSION(:), ALLOCATABLE :: ISTATIDS ! Intermediate array for MPI communication
-INTEGER, DIMENSION(:), ALLOCATABLE :: ISTATPRCRANK ! Array to store the ranks of the processes where the stations are
-INTEGER, DIMENSION(:), ALLOCATABLE :: IDS ! Array to store the station number to send
-INTEGER, DIMENSION(:), ALLOCATABLE :: IDISP ! Array to store the displacements for MPI communications
-REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! Buffer to store raw data of a station (used for MPI communication)
-TYPE(TSTATIONDATA) :: TZSTATION
-!
-!----------------------------------------------------------------------------
-
-ALLOCATE( INSTATPRC(ISNPROC) )
-ALLOCATE( IDS(NUMBSTAT_LOC) )
-
-!Gather number of station present on each process
-CALL MPI_ALLGATHER( NUMBSTAT_LOC, 1, MNHINT_MPI, INSTATPRC, 1, MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
-
-!Store the identification number of local stations (these numbers are globals)
-DO JS = 1, NUMBSTAT_LOC
- IDS(JS) = TSTATIONS(JS)%NID
-END DO
-
-ALLOCATE( IDISP(ISNPROC) )
-IDISP(1) = 0
-DO JP = 2, ISNPROC
- IDISP(JP) = IDISP(JP-1) + INSTATPRC(JP-1)
-END DO
-
-INUMSTAT = SUM( INSTATPRC(:) )
-ALLOCATE( ISTATIDS(INUMSTAT) )
-ALLOCATE( ISTATPRCRANK(INUMSTAT) )
-
-!Gather the list of all the stations of all processes
-CALL MPI_ALLGATHERV( IDS(:), NUMBSTAT_LOC, MNHINT_MPI, ISTATIDS(:), INSTATPRC(:), &
- IDISP(:), MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
-
-!Store the rank of each process corresponding to a given station
-IDX = 1
-ISTATPRCRANK(:) = -1
-DO JP = 1, ISNPROC
- DO JS = 1, INSTATPRC(JP)
- ISTATPRCRANK(ISTATIDS(IDX)) = JP
- IDX = IDX + 1
- END DO
-END DO
-
-CALL STATION_ALLOCATE( TZSTATION, SIZE( tstations_time%tpdates ) )
-
-!Determine the size of the ZPACK buffer used to transfer station data in 1 MPI communication
-IF ( ISNPROC > 1 ) THEN
- ISTORE = SIZE( TSTATIONS_TIME%TPDATES )
- IPACKSIZE = 9
- IPACKSIZE = IPACKSIZE + ISTORE * ( 5 + NRR + NSV )
- IF ( CTURB == 'TKEL') IPACKSIZE = IPACKSIZE + ISTORE !Tke term
- IF ( CRAD /= 'NONE' ) IPACKSIZE = IPACKSIZE + ISTORE !XTSRAD term
- IF ( LDIAG_SURFRAD_STAT ) THEN
- IF ( CSURF == 'EXTE' ) IPACKSIZE = IPACKSIZE + ISTORE * 10
- IF ( CRAD /= 'NONE' ) IPACKSIZE = IPACKSIZE + ISTORE * 8
- IPACKSIZE = IPACKSIZE + ISTORE !XSFCO2 term
- END IF
-
- ALLOCATE( ZPACK(IPACKSIZE) )
-END IF
-
-IDX = 1
-
-STATION: DO JS = 1, INUMSTAT
- IF ( ISTATPRCRANK(JS) == TPDIAFILE%NMASTER_RANK ) THEN
- !No communication necessary, the station data is already on the writer process
- IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
- TZSTATION = TSTATIONS(IDX)
- IDX = IDX + 1
- END IF
- ELSE
- !The station data is not on the writer process
- IF ( ISP == ISTATPRCRANK(JS) ) THEN
- ! This process has the data and needs to send it to the writer process
- IPOS = 1
- ZPACK(IPOS) = TSTATIONS(IDX)%NID; IPOS = IPOS + 1
- ZPACK(IPOS) = TSTATIONS(IDX)%XX; IPOS = IPOS + 1
- ZPACK(IPOS) = TSTATIONS(IDX)%XY; IPOS = IPOS + 1
- ZPACK(IPOS) = TSTATIONS(IDX)%XZ; IPOS = IPOS + 1
- ZPACK(IPOS) = TSTATIONS(IDX)%XLON; IPOS = IPOS + 1
- ZPACK(IPOS) = TSTATIONS(IDX)%XLAT; IPOS = IPOS + 1
- ZPACK(IPOS) = TSTATIONS(IDX)%XZS; IPOS = IPOS + 1
- ZPACK(IPOS) = TSTATIONS(IDX)%NK; IPOS = IPOS + 1
- ZPACK(IPOS) = TSTATIONS(IDX)%XZMEAS; IPOS = IPOS + 1
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XZON(:); IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XMER(:); IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XW(:); IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XP(:); IPOS = IPOS + ISTORE
- IF ( CTURB == 'TKEL') THEN
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XTKE(:); IPOS = IPOS + ISTORE
- END IF
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XTH(:); IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE*NRR-1) = RESHAPE( TSTATIONS(IDX)%XR(:,:), [ISTORE*NRR] ); IPOS = IPOS + ISTORE * NRR
- ZPACK(IPOS:IPOS+ISTORE*NSV-1) = RESHAPE( TSTATIONS(IDX)%XSV(:,:), [ISTORE*NSV] ); IPOS = IPOS + ISTORE * NSV
- IF ( CRAD /= 'NONE' ) THEN
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XTSRAD(:); IPOS = IPOS + ISTORE
- END IF
- IF ( LDIAG_SURFRAD_STAT ) THEN
- IF ( CSURF == 'EXTE') THEN
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XT2M; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XQ2M; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XHU2M; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XZON10M; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XMER10M; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XRN; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XH; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XLE; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XGFLUX; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XLEI; IPOS = IPOS + ISTORE
- END IF
- IF ( CRAD /= 'NONE' ) THEN
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XSWD; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XSWU; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XLWD; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XLWU; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XSWDIR; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XSWDIFF; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XDSTAOD; IPOS = IPOS + ISTORE
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XSLTAOD; IPOS = IPOS + ISTORE
- END IF
- ZPACK(IPOS:IPOS+ISTORE-1) = TSTATIONS(IDX)%XSFCO2; IPOS = IPOS + ISTORE
- END IF
-
- IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_WARNING, 'IO', 'WRITE_STATION_n', 'IPOS-1 /= IPACKSIZE (sender side)', OLOCAL = .TRUE. )
-
- CALL MPI_SEND( TSTATIONS(IDX)%CNAME, LEN(TSTATIONS(IDX)%CNAME), MPI_CHARACTER, TPDIAFILE%NMASTER_RANK - 1, &
- ITAG, TPDIAFILE%NMPICOMM, IERR )
- CALL MPI_SEND( ZPACK, IPACKSIZE, MNHREAL_MPI, TPDIAFILE%NMASTER_RANK - 1, ITAG, TPDIAFILE%NMPICOMM, IERR )
-
- IDX = IDX + 1
-
- ELSE IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
- ! This process is the writer and will receive the station data from its owner
- CALL MPI_RECV( TZSTATION%CNAME, LEN(TZSTATION%CNAME), MPI_CHARACTER, &
- ISTATPRCRANK(JS) - 1, ITAG, TPDIAFILE%NMPICOMM, MPI_STATUS_IGNORE, IERR )
- CALL MPI_RECV( ZPACK, IPACKSIZE, MNHREAL_MPI, ISTATPRCRANK(JS) - 1, ITAG, TPDIAFILE%NMPICOMM, MPI_STATUS_IGNORE, IERR )
-
- IPOS = 1
- TZSTATION%NID = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
- TZSTATION%XX = ZPACK(IPOS); IPOS = IPOS + 1
- TZSTATION%XY = ZPACK(IPOS); IPOS = IPOS + 1
- TZSTATION%XZ = ZPACK(IPOS); IPOS = IPOS + 1
- TZSTATION%XLON = ZPACK(IPOS); IPOS = IPOS + 1
- TZSTATION%XLAT = ZPACK(IPOS); IPOS = IPOS + 1
- TZSTATION%XZS = ZPACK(IPOS); IPOS = IPOS + 1
- TZSTATION%NK = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
- TZSTATION%XZMEAS = ZPACK(IPOS); IPOS = IPOS + 1
- TZSTATION%XZON(:) = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XMER(:) = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XW(:) = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XP(:) = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- IF ( CTURB == 'TKEL') THEN
- TZSTATION%XTKE(:) = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- END IF
- TZSTATION%XTH(:) = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XR(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*NRR-1), [ ISTORE, NRR ] ); IPOS = IPOS + ISTORE * NRR
- TZSTATION%XSV(:,:) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE*NSV-1), [ ISTORE, NSV ] ); IPOS = IPOS + ISTORE * NSV
- IF ( CRAD /= 'NONE' ) THEN
- TZSTATION%XTSRAD(:) = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- END IF
- IF ( LDIAG_SURFRAD_STAT ) THEN
- IF ( CSURF == 'EXTE' ) THEN
- TZSTATION%XT2M = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XQ2M = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XHU2M = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XZON10M = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XMER10M = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XRN = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XH = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XLE = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XGFLUX = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XLEI = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- END IF
- IF ( CRAD /= 'NONE' ) THEN
- TZSTATION%XSWD = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XSWU = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XLWD = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XLWU = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XSWDIR = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XSWDIFF = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XDSTAOD = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- TZSTATION%XSLTAOD = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- END IF
- TZSTATION%XSFCO2 = ZPACK(IPOS:IPOS+ISTORE-1); IPOS = IPOS + ISTORE
- END IF
-
- IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_WARNING, 'IO', 'WRITE_STATION_n', 'IPOS-1 /= IPACKSIZE (receiver side)', OLOCAL = .TRUE. )
- END IF
- END IF
-
- CALL STATION_DIACHRO_n( TPDIAFILE, TZSTATION )
-
-END DO STATION
-
-END SUBROUTINE WRITE_STATION_n
! ##################################################
SUBROUTINE STATION_DIACHRO_n( TPDIAFILE, TPSTATION )
@@ -283,21 +33,23 @@ SUBROUTINE STATION_DIACHRO_n( TPDIAFILE, TPSTATION )
USE MODD_ALLSTATION_n, ONLY: LDIAG_SURFRAD_STAT
use modd_budget, only: NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
tbudiachrometadata
+USE MODD_CH_AEROSOL, ONLY: JPMODE, LORILAM, NCARB, NSOA, NSP
USE MODD_CONF, ONLY: LCARTESIAN
-USE MODD_CST, ONLY: XRV
+USE MODD_DUST, ONLY: LDUST, NMODE_DST
use modd_field, only: NMNHDIM_STATION_TIME, NMNHDIM_STATION_PROC, NMNHDIM_UNUSED, &
tfieldmetadata_base, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NSV, ONLY: nsv, nsv_aer, nsv_aerbeg, nsv_aerend, &
- nsv_dst, nsv_dstbeg, nsv_dstend, nsv_slt, nsv_sltbeg, nsv_sltend, &
- tsvlist
+USE MODD_NSV, ONLY: nsv, tsvlist
USE MODD_PARAM_n, ONLY: CRAD, CSURF, CTURB
+USE MODD_SALT, ONLY: LSALT, NMODE_SLT
use modd_station_n, only: tstations_time
use modd_type_statprof, only: tstationdata
-USE MODE_AERO_PSD
-USE MODE_DUST_PSD
-USE MODE_SALT_PSD
+use mode_sensor, only: Add_dust_data, Add_fixpoint, Add_orilam_data, Add_point, Add_salt_data, &
+ Sensor_current_processes_number_get, &
+ ccomment, ctitle, cunit, xwork6, &
+ Sensor_write_workarrays_allocate, Sensor_write_workarrays_deallocate
+use mode_statprof_tools, only: Add_diag_surfrad_data
use MODE_WRITE_DIACHRO, ONLY: Write_diachro
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
@@ -305,14 +57,6 @@ TYPE(TSTATIONDATA), INTENT(IN) :: TPSTATION
!
!* 0.2 declaration of local variables for diachro
!
-REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: XWORK6 ! contains temporal series
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZSIG, ZRG
-REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZPTOTA
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
-!
-CHARACTER(LEN=NCOMMENTLGTMAX) :: YCOMMENT ! comment string
-CHARACTER(LEN=NMNHNAMELGTMAX) :: YTITLE ! title
-!
!!! do not forget to increment the IPROC value if you add diagnostic !!!
INTEGER :: IPROC ! number of variables records
!!! do not forget to increment the JPROC value if you add diagnostic !!!
@@ -326,7 +70,7 @@ type(tfieldmetadata_base), dimension(:), allocatable :: tzfields
!
!----------------------------------------------------------------------------
!
-IPROC = 5 + SIZE(TPSTATION%XR,2) + SIZE(TPSTATION%XSV,2)
+IPROC = 6 + SIZE(TPSTATION%XR,3) + SIZE(TPSTATION%XSV,3)
IF ( CTURB == 'TKEL' ) IPROC = IPROC + 1
IF (LDIAG_SURFRAD_STAT) THEN
@@ -334,300 +78,78 @@ IF (LDIAG_SURFRAD_STAT) THEN
IF(CRAD/="NONE") IPROC = IPROC + 8
IPROC = IPROC + 1 ! XSFCO2 term
END IF
-IF (LORILAM) IPROC = IPROC + JPMODE*(3+NSOA+NCARB+NSP)
-IF (LDUST) IPROC = IPROC + NMODE_DST*3
-IF (LSALT) IPROC = IPROC + NMODE_SLT*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 ( CRAD /= 'NONE' ) IPROC = IPROC + 1
-!
-IPROC = MAX( IPROC, 6 ) !6 correspond to the number of fixed values written later
-!
+
ISTORE = SIZE( TSTATIONS_TIME%TPDATES )
-ALLOCATE( XWORK6(1, 1, 1, ISTORE, 1, IPROC) )
-ALLOCATE( CCOMMENT(IPROC) )
-ALLOCATE( CTITLE (IPROC) )
-ALLOCATE( CUNIT (IPROC) )
-!
-JPROC = 0
+call Sensor_write_workarrays_allocate( 1, istore, iproc )
!
!----------------------------------------------------------------------------
!
-call Add_point( 'P', 'Pressure', 'Pa', tpstation%xp(:) )
+call Add_point( 'P', 'Pressure', 'Pa', tpstation%xp(1,:) )
if ( lcartesian ) then
- call Add_point( 'U', 'Axial velocity', 'm s-1', tpstation%xzon(:) )
- call Add_point( 'V', 'Transversal velocity', 'm s-1', tpstation%xmer(:) )
+ call Add_point( 'U', 'Axial velocity', 'm s-1', tpstation%xzon(1,:) )
+ call Add_point( 'V', 'Transversal velocity', 'm s-1', tpstation%xmer(1,:) )
else
- call Add_point( 'ZON_WIND', 'Zonal wind', 'm s-1', tpstation%xzon(:) )
- call Add_point( 'MER_WIND', 'Meridional wind', 'm s-1', tpstation%xmer(:) )
+ call Add_point( 'ZON_WIND', 'Zonal wind', 'm s-1', tpstation%xzon(1,:) )
+ call Add_point( 'MER_WIND', 'Meridional wind', 'm s-1', tpstation%xmer(1,:) )
end if
-call Add_point( 'W', 'Air vertical speed', 'm s-1', tpstation%xw(:) )
-call Add_point( 'Th', 'Potential temperature', 'K', tpstation%xth(:) )
-
-if ( ldiag_surfrad_stat ) then
- if ( csurf == "EXTE" ) then
- call Add_point( 'T2m', '2-m temperature', 'K', tpstation%xt2m(:) )
- call Add_point( 'Q2m', '2-m humidity', 'kg kg-1', tpstation%xq2m(:) )
- call Add_point( 'HU2m', '2-m relative humidity', 'percent', tpstation%xhu2m(:) )
- call Add_point( 'zon10m', '10-m zonal wind', 'm s-1', tpstation%xzon10m(:) )
- call Add_point( 'mer10m', '10-m meridian wind', 'm s-1', tpstation%xmer10m(:) )
- call Add_point( 'RN', 'Net radiation', 'W m-2', tpstation%xrn(:) )
- call Add_point( 'H', 'Sensible heat flux', 'W m-2', tpstation%xh(:) )
- call Add_point( 'LE', 'Total Latent heat flux', 'W m-2', tpstation%xle(:) )
- call Add_point( 'G', 'Storage heat flux', 'W m-2', tpstation%xgflux(:) )
- call Add_point( 'LEI', 'Solid Latent heat flux', 'W m-2', tpstation%xlei(:) )
- end if
- if ( crad /= 'NONE' ) then
- call Add_point( 'SWD', 'Downward short-wave radiation', 'W m-2', tpstation%xswd(:) )
- call Add_point( 'SWU', 'Upward short-wave radiation', 'W m-2', tpstation%xswu(:) )
- call Add_point( 'LWD', 'Downward long-wave radiation', 'W m-2', tpstation%xlwd(:) )
- call Add_point( 'LWU', 'Upward long-wave radiation', 'W m-2', tpstation%xlwu(:) )
- call Add_point( 'SWDIR', 'Downward direct short-wave radiation', 'W m-2', tpstation%xswdir(:) )
- call Add_point( 'SWDIFF', 'Downward diffuse short-wave radiation', 'W m-2', tpstation%xswdiff(:) )
- call Add_point( 'DSTAOD', 'Dust aerosol optical depth', 'm', tpstation%xdstaod(:) )
- call Add_point( 'SLTAOD', 'Salt aerosol optical depth', 'm', tpstation%xsltaod(:) )
- end if
-end if
+call Add_point( 'W', 'Air vertical speed', 'm s-1', tpstation%xw(1,:) )
+call Add_point( 'Th', 'Potential temperature', 'K', tpstation%xth(1,:) )
-do jrr = 1, SIZE( tpstation%xr, 2 )
+if ( ldiag_surfrad_stat ) call Add_diag_surfrad_data( tpstation )
+
+do jrr = 1, SIZE( tpstation%xr, 3 )
select case( jrr )
case (1)
- call Add_point( 'Rv', 'Water vapor mixing ratio', 'kg kg-1', tpstation%xr(:,jrr) )
+ call Add_point( 'Rv', 'Water vapor mixing ratio', 'kg kg-1', tpstation%xr(1,:,jrr) )
case (2)
- call Add_point( 'Rc', 'Liquid cloud water mixing ratio', 'kg kg-1', tpstation%xr(:,jrr) )
+ call Add_point( 'Rc', 'Liquid cloud water mixing ratio', 'kg kg-1', tpstation%xr(1,:,jrr) )
case (3)
- call Add_point( 'Rr', 'Rain water mixing ratio', 'kg kg-1', tpstation%xr(:,jrr) )
+ call Add_point( 'Rr', 'Rain water mixing ratio', 'kg kg-1', tpstation%xr(1,:,jrr) )
case (4)
- call Add_point( 'Ri', 'Ice cloud water mixing ratio', 'kg kg-1', tpstation%xr(:,jrr) )
+ call Add_point( 'Ri', 'Ice cloud water mixing ratio', 'kg kg-1', tpstation%xr(1,:,jrr) )
case (5)
- call Add_point( 'Rs', 'Snow mixing ratio', 'kg kg-1', tpstation%xr(:,jrr) )
+ call Add_point( 'Rs', 'Snow mixing ratio', 'kg kg-1', tpstation%xr(1,:,jrr) )
case (6)
- call Add_point( 'Rg', 'Graupel mixing ratio', 'kg kg-1', tpstation%xr(:,jrr) )
+ call Add_point( 'Rg', 'Graupel mixing ratio', 'kg kg-1', tpstation%xr(1,:,jrr) )
case (7)
- call Add_point( 'Rh', 'Hail mixing ratio', 'kg kg-1', tpstation%xr(:,jrr) )
+ call Add_point( 'Rh', 'Hail mixing ratio', 'kg kg-1', tpstation%xr(1,:,jrr) )
end select
end do
-if ( cturb == 'TKEL' ) call Add_point( 'Tke', 'Turbulent kinetic energy', 'm2 s-2', tpstation%xtke(:) )
+call Add_point( 'Rhod', 'Density of dry air', 'kg m-3', tpstation%xrhod_sensor )
+
+if ( cturb == 'TKEL' ) call Add_point( 'Tke', 'Turbulent kinetic energy', 'm2 s-2', tpstation%xtke(1,:) )
if ( nsv > 0 ) then
! Scalar variables
DO JSV = 1, NSV
IF ( TRIM( TSVLIST(JSV)%CUNITS ) == 'ppv' ) THEN
!*1e9 for conversion ppv->ppb
- call Add_point( TRIM( TSVLIST(JSV)%CMNHNAME ), '', 'ppb', TPSTATION%XSV(:,JSV) * 1.e9 )
+ call Add_point( TRIM( TSVLIST(JSV)%CMNHNAME ), '', 'ppb', TPSTATION%XSV(1,:,JSV) * 1.e9 )
ELSE
- call Add_point( TRIM( TSVLIST(JSV)%CMNHNAME ), '', TSVLIST(JSV)%CUNITS, TPSTATION%XSV(:,JSV) )
+ call Add_point( TRIM( TSVLIST(JSV)%CMNHNAME ), '', TSVLIST(JSV)%CUNITS, TPSTATION%XSV(1,:,JSV) )
END IF
END DO
- IF ((LORILAM).AND. .NOT.(ANY(TPSTATION%XP(:) == 0.))) THEN
- ALLOCATE (ZSV(1,1,ISTORE,NSV_AER))
- ALLOCATE (ZRHO(1,1,ISTORE))
- ALLOCATE (ZN0(1,1,ISTORE,JPMODE))
- ALLOCATE (ZRG(1,1,ISTORE,JPMODE))
- ALLOCATE (ZSIG(1,1,ISTORE,JPMODE))
- ALLOCATE (ZPTOTA(1,1,ISTORE,NSP+NCARB+NSOA,JPMODE))
- ZSV(1,1,:,1:NSV_AER) = TPSTATION%XSV(:,NSV_AERBEG:NSV_AEREND)
- IF (SIZE(TPSTATION%XR,2) >0) THEN
- ZRHO(1,1,:) = 0.
- DO JRR=1,SIZE(TPSTATION%XR,2)
- ZRHO(1,1,:) = ZRHO(1,1,:) + TPSTATION%XR(:,JRR)
- ENDDO
- ZRHO(1,1,:) = TPSTATION%XTH(:) * ( 1. + XRV/XRD*TPSTATION%XR(:,1) ) &
- / ( 1. + ZRHO(1,1,:) )
- ELSE
- ZRHO(1,1,:) = TPSTATION%XTH(:)
- ENDIF
- ZRHO(1,1,:) = TPSTATION%XP(:) / &
- (XRD *ZRHO(1,1,:) *((TPSTATION%XP(:)/XP00)**(XRD/XCPD)) )
-
- CALL PPP2AERO(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0,PCTOTA=ZPTOTA)
-
- DO JSV=1,JPMODE
- ! mean radius
- WRITE(YTITLE,'(A6,I1)')'AERRGA',JSV
- WRITE(YCOMMENT,'(A18,I1)')'RG (nb) AERO MODE ',JSV
- call Add_point( ytitle, ycomment, 'um', ZRG(1,1,:,JSV) )
-
- ! standard deviation
- WRITE(YTITLE,'(A7,I1)')'AERSIGA',JSV
- WRITE(YCOMMENT,'(A16,I1)')'SIGMA AERO MODE ',JSV
- call Add_point( ytitle, ycomment, '',ZSIG(1,1,:,JSV) )
-
- ! particles number
- WRITE(YTITLE,'(A6,I1)')'AERN0A',JSV
- WRITE(YCOMMENT,'(A13,I1)')'N0 AERO MODE ',JSV
- call Add_point( ytitle, ycomment, 'm-3', ZN0(1,1,:,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MOC ',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS OC AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_OC,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MBC ',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS BC AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_BC,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MDST ',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS DST AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_DST,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MSO4 ',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS SO4 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SO4,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MNO3 ',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS NO3 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_NO3,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MH2O ',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS H2O AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_H2O,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MNH3 ',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS NH3 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_NH3,JSV) )
-
- IF ( NSOA == 10 ) THEN
- WRITE(YTITLE,'(A5,I1)')'MSOA1',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS SOA1 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SOA1,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MSOA2',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS SOA2 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SOA2,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MSOA3',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS SOA3 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SOA3,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MSOA4',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS SOA4 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SOA4,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MSOA5',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS SOA5 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SOA5,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MSOA6',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS SOA6 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SOA6,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MSOA7',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS SOA7 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SOA7,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MSOA8',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS SOA8 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SOA8,JSV) )
-
- WRITE(YTITLE,'(A5,I1)')'MSOA9',JSV
- WRITE(CCOMMENT,'(A23,I1)')'MASS SOA9 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SOA9,JSV) )
-
- WRITE(YTITLE,'(A6,I1)')'MSOA10',JSV
- WRITE(CCOMMENT,'(A24,I1)')'MASS SOA10 AEROSOL MODE ',JSV
- call Add_point( ytitle, ycomment, 'ug m-3', ZPTOTA(1,1,:,JP_AER_SOA10,JSV) )
- END IF
- END DO
-
- DEALLOCATE (ZSV,ZRHO)
- DEALLOCATE (ZN0,ZRG,ZSIG)
- END IF
-
- IF ((LDUST).AND. .NOT.(ANY(TPSTATION%XP(:) == 0.))) THEN
- ALLOCATE (ZSV(1,1,ISTORE,NSV_DST))
- ALLOCATE (ZRHO(1,1,ISTORE))
- ALLOCATE (ZN0(1,1,ISTORE,NMODE_DST))
- ALLOCATE (ZRG(1,1,ISTORE,NMODE_DST))
- ALLOCATE (ZSIG(1,1,ISTORE,NMODE_DST))
- ZSV(1,1,:,1:NSV_DST) = TPSTATION%XSV(:,NSV_DSTBEG:NSV_DSTEND)
- IF (SIZE(TPSTATION%XR,2) >0) THEN
- ZRHO(1,1,:) = 0.
- DO JRR=1,SIZE(TPSTATION%XR,2)
- ZRHO(1,1,:) = ZRHO(1,1,:) + TPSTATION%XR(:,JRR)
- ENDDO
- ZRHO(1,1,:) = TPSTATION%XTH(:) * ( 1. + XRV/XRD*TPSTATION%XR(:,1) ) &
- / ( 1. + ZRHO(1,1,:) )
- ELSE
- ZRHO(1,1,:) = TPSTATION%XTH(:)
- ENDIF
- ZRHO(1,1,:) = TPSTATION%XP(:) / &
- (XRD *ZRHO(1,1,:) *((TPSTATION%XP(:)/XP00)**(XRD/XCPD)) )
- CALL PPP2DUST(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0)
- DO JSV=1,NMODE_DST
- ! mean radius
- JPROC = JPROC+1
- WRITE(CTITLE(JPROC),'(A6,I1)')'DSTRGA',JSV
- CUNIT (JPROC) = 'um'
- WRITE(CCOMMENT(JPROC),'(A18,I1)')'RG (nb) DUST MODE ',JSV
- XWORK6 (1,1,1,:,1,JPROC) = ZRG(1,1,:,JSV)
- ! standard deviation
- JPROC = JPROC+1
- WRITE(CTITLE(JPROC),'(A7,I1)')'DSTSIGA',JSV
- CUNIT (JPROC) = ' '
- WRITE(CCOMMENT(JPROC),'(A16,I1)')'SIGMA DUST MODE ',JSV
- XWORK6 (1,1,1,:,1,JPROC) = ZSIG(1,1,:,JSV)
- ! particles number
- JPROC = JPROC+1
- WRITE(CTITLE(JPROC),'(A6,I1)')'DSTN0A',JSV
- CUNIT (JPROC) = 'm-3'
- WRITE(CCOMMENT(JPROC),'(A13,I1)')'N0 DUST MODE ',JSV
- XWORK6 (1,1,1,:,1,JPROC) = ZN0(1,1,:,JSV)
- ENDDO
- DEALLOCATE (ZSV,ZRHO)
- DEALLOCATE (ZN0,ZRG,ZSIG)
- END IF
-
- IF ((LSALT).AND. .NOT.(ANY(TPSTATION%XP(:) == 0.))) THEN
- ALLOCATE (ZSV(1,1,ISTORE,NSV_SLT))
- ALLOCATE (ZRHO(1,1,ISTORE))
- ALLOCATE (ZN0(1,1,ISTORE,NMODE_SLT))
- ALLOCATE (ZRG(1,1,ISTORE,NMODE_SLT))
- ALLOCATE (ZSIG(1,1,ISTORE,NMODE_SLT))
- ZSV(1,1,:,1:NSV_SLT) = TPSTATION%XSV(:,NSV_SLTBEG:NSV_SLTEND)
- IF (SIZE(TPSTATION%XR,2) >0) THEN
- ZRHO(1,1,:) = 0.
- DO JRR=1,SIZE(TPSTATION%XR,2)
- ZRHO(1,1,:) = ZRHO(1,1,:) + TPSTATION%XR(:,JRR)
- ENDDO
- ZRHO(1,1,:) = TPSTATION%XTH(:) * ( 1. + XRV/XRD*TPSTATION%XR(:,1) ) &
- / ( 1. + ZRHO(1,1,:) )
- ELSE
- ZRHO(1,1,:) = TPSTATION%XTH(:)
- ENDIF
- ZRHO(1,1,:) = TPSTATION%XP(:) / &
- (XRD *ZRHO(1,1,:) *((TPSTATION%XP(:)/XP00)**(XRD/XCPD)) )
- CALL PPP2SALT(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0)
- DO JSV=1,NMODE_SLT
- ! mean radius
- WRITE(CTITLE(JPROC),'(A6,I1)')'SLTRGA',JSV
- WRITE(CCOMMENT(JPROC),'(A18,I1)')'RG (nb) SALT MODE ',JSV
- call Add_point( ytitle, ycomment, 'um', ZRG(1,1,:,JSV) )
-
- ! standard deviation
- WRITE(CTITLE(JPROC),'(A7,I1)')'SLTSIGA',JSV
- WRITE(CCOMMENT(JPROC),'(A16,I1)')'SIGMA DUST MODE ',JSV
- call Add_point( ytitle, ycomment, '',ZSIG(1,1,:,JSV) )
-
- ! particles number
- WRITE(CTITLE(JPROC),'(A6,I1)')'SLTN0A',JSV
- WRITE(CCOMMENT(JPROC),'(A13,I1)')'N0 DUST MODE ',JSV
- call Add_point( ytitle, ycomment, 'm-3', ZN0(1,1,:,JSV) )
- ENDDO
- DEALLOCATE (ZSV,ZRHO)
- DEALLOCATE (ZN0,ZRG,ZSIG)
- END IF
+ if ( lorilam ) call Add_orilam_data( tpstation, 1, istore )
+ if ( ldust ) call Add_dust_data ( tpstation, 1, istore )
+ if ( lsalt ) call Add_salt_data ( tpstation, 1, istore )
end if
if ( crad /= 'NONE' ) call Add_point( 'Tsrad', 'Radiative Surface Temperature', 'K', tpstation%xtsrad(:) )
-
-if ( ldiag_surfrad_stat ) call Add_point( 'SFCO2', 'CO2 Surface Flux', 'mg m-2 s-1', tpstation%xsfco2(:) )
!
!----------------------------------------------------------------------------
!
!
+jproc = Sensor_current_processes_number_get()
+
allocate( tzfields( jproc ) )
tzfields(:)%cmnhname = ctitle(1 : jproc)
@@ -694,61 +216,29 @@ tzbudiachro%nkh = 1
call Write_diachro( tpdiafile, tzbudiachro, tzfields, tstations_time%tpdates, xwork6(:,:,:,:,:,:jproc) )
deallocate( tzfields )
+call Sensor_write_workarrays_deallocate( )
!----------------------------------------------------------------------------
!Treat position and fix values (not changing during simulation)
-jproc = 0
+IPROC = 6
+
+call Sensor_write_workarrays_allocate( 1, 1, iproc )
if ( lcartesian ) then
- JPROC = JPROC + 1
- CTITLE (JPROC) = 'X'
- CUNIT (JPROC) = 'm'
- CCOMMENT (JPROC) = 'X Pos'
- XWORK6 (1,1,1,:,1,JPROC) = TPSTATION%XX
-
- JPROC = JPROC + 1
- CTITLE (JPROC) = 'Y'
- CUNIT (JPROC) = 'm'
- CCOMMENT (JPROC) = 'Y Pos'
- XWORK6 (1,1,1,:,1,JPROC) = TPSTATION%XY
+ call Add_fixpoint( 'X', 'X position', 'm', TPSTATION%XX_CUR )
+ call Add_fixpoint( 'Y', 'Y position', 'm', TPSTATION%XY_CUR )
else
- JPROC = JPROC + 1
- CTITLE (JPROC) = 'LON'
- CUNIT (JPROC) = 'degree'
- CCOMMENT (JPROC) = 'Longitude'
- XWORK6 (1,1,1,:,1,JPROC) = TPSTATION%XLON
-
- JPROC = JPROC + 1
- CTITLE (JPROC) = 'LAT'
- CUNIT (JPROC) = 'degree'
- CCOMMENT (JPROC) = 'Latitude'
- XWORK6 (1,1,1,:,1,JPROC) = TPSTATION%XLAT
+ call Add_fixpoint( 'LON', 'longitude', 'degree', TPSTATION%XLON_CUR )
+ call Add_fixpoint( 'LAT', 'latitude', 'degree', TPSTATION%XLAT_CUR )
end if
-JPROC = JPROC + 1
-CTITLE (JPROC) = 'Z'
-CUNIT (JPROC) = 'm'
-CCOMMENT (JPROC) = 'Altitude'
-XWORK6 (1,1,1,:,1,JPROC) = TPSTATION%XZ
-
-JPROC = JPROC + 1
-CTITLE (JPROC) = 'ZS'
-CUNIT (JPROC) = 'm'
-CCOMMENT (JPROC) = 'Orography'
-XWORK6 (1,1,1,:,1,JPROC) = TPSTATION%XZS
-
-JPROC = JPROC + 1
-CTITLE (JPROC) = 'Zmeas'
-CUNIT (JPROC) = 'm'
-CCOMMENT (JPROC) = 'interpolated altitude used for measurements'
-XWORK6 (1,1,1,:,1,JPROC) = TPSTATION%XZMEAS
-
-JPROC = JPROC + 1
-CTITLE (JPROC) = 'K'
-CUNIT (JPROC) = '1'
-CCOMMENT (JPROC) = 'vertical model level used for computations'
-XWORK6 (1,1,1,:,1,JPROC) = REAL( TPSTATION%NK )
+call Add_fixpoint( 'Z', 'altitude', 'm', TPSTATION%XZ_CUR )
+call Add_fixpoint( 'ZS', 'orography', 'm', TPSTATION%XZS )
+call Add_fixpoint( 'Zmeas', 'interpolated altitude used for measurements', 'm', TPSTATION%XZMEAS )
+call Add_fixpoint( 'K', 'vertical model level used for computations', '1', REAL( TPSTATION%NK ) )
+
+jproc = Sensor_current_processes_number_get()
Allocate( tzfields( jproc ) )
@@ -769,41 +259,8 @@ tzfields(:)%ndimlist(6) = NMNHDIM_STATION_PROC
call Write_diachro( tpdiafile, tzbudiachro, tzfields, tstations_time%tpdates, xwork6(:,:,:,:,:,:jproc) )
-
-!Necessary because global variables (private inside module)
-Deallocate( xwork6 )
-Deallocate (ccomment)
-Deallocate (ctitle )
-Deallocate (cunit )
-
-!----------------------------------------------------------------------------
-
-contains
-
-! ######################################################
-subroutine Add_point( htitle, hcomment, hunits, pfield )
-! ######################################################
-
-use mode_msg
-
-character(len=*), intent(in) :: htitle
-character(len=*), intent(in) :: hcomment
-character(len=*), intent(in) :: hunits
-real, dimension(:), intent(in) :: pfield
-
-integer :: jk
-
-jproc = jproc + 1
-
-if ( jproc > iproc ) call Print_msg( NVERB_FATAL, 'IO', 'Add_point', 'more processes than expected' )
-
-ctitle(jproc) = Trim( htitle)
-ccomment(jproc) = Trim( hcomment )
-cunit(jproc) = Trim( hunits )
-
-xwork6(1, 1, 1, :, 1, jproc) = pfield(:)
-
-end subroutine Add_point
+deallocate( tzfields )
+call Sensor_write_workarrays_deallocate( )
END SUBROUTINE STATION_DIACHRO_n
diff --git a/src/MNH/write_statprofn.f90 b/src/MNH/write_statprofn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bf6ada28aef95922c210ab8967ebcea936c9a6a0
--- /dev/null
+++ b/src/MNH/write_statprofn.f90
@@ -0,0 +1,169 @@
+!MNH_LIC Copyright 2002-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Module to initiate the writing for stations and profilers
+! It was initially created to deduplicate code from the WRITE_STATION_n and WRITE_PROFILER_n subroutines.
+! Author:
+! P. Wautelet 12/07/2023
+!
+! Modifications
+! --------------------------------------------------------------------------
+! #####################
+MODULE MODE_WRITE_STATPROF_n
+! #####################
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: WRITE_STATPROF_n
+
+contains
+ !
+ ! ##################################################
+ SUBROUTINE WRITE_STATPROF_n( TPDIAFILE, TPSTATPROF )
+ ! ##################################################
+ !
+ !
+ !**** *WRITE_STATPROF_n* - write the stations or profilers records in the diachronic file
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ USE MODD_IO, ONLY: ISNPROC, ISP, TFILEDATA
+ USE MODD_MPIF
+ USE MODD_PRECISION, ONLY: MNHINT_MPI
+ USE MODD_PROFILER_n, only: NUMBPROFILER_LOC, TPROFILERS, TPROFILERS_TIME
+ USE MODD_STATION_n, ONLY: NUMBSTAT_LOC, TSTATIONS, TSTATIONS_TIME
+ USE MODD_TYPE_STATPROF, ONLY: TSTATIONDATA, TSTATPROFDATA, TPROFILERDATA
+ !
+ USE MODE_MSG
+ USE MODE_WRITE_PROFILER_n, ONLY: PROFILER_DIACHRO_n
+ USE MODE_WRITE_STATION_n, ONLY: STATION_DIACHRO_n
+ !
+ IMPLICIT NONE
+ !
+ !
+ !* 0.1 declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! Diachronic file to write
+ CLASS(TSTATPROFDATA), DIMENSION(:), INTENT(IN) :: TPSTATPROF ! Stations/profilers to write
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IERR
+ INTEGER :: JP, JS
+ INTEGER :: IDX
+ INTEGER :: INUMSTATPROF ! Total number of stations/profilers (for the current model)
+ INTEGER :: INUMSTATPROF_LOC ! Number of local stations/profilers (for the current model)
+ INTEGER :: ISTORE
+ INTEGER, DIMENSION(:), ALLOCATABLE :: INSTATPROFPRC ! Array to store the number of statprof per process (for the current model)
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ISTATPROFIDS ! Intermediate array for MPI communication
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ISTATPROFPRCRANK ! Array to store the ranks of the processes where the statprof are
+ INTEGER, DIMENSION(:), ALLOCATABLE :: IDS ! Array to store the statprof number to send
+ INTEGER, DIMENSION(:), ALLOCATABLE :: IDISP ! Array to store the displacements for MPI communications
+ CLASS(TSTATPROFDATA), ALLOCATABLE :: TZSTATPROF
+ CLASS(TSTATPROFDATA), DIMENSION(:), POINTER :: TZSTATPROFLIST
+ !
+ !----------------------------------------------------------------------------
+
+ SELECT TYPE ( TPSTATPROF )
+ TYPE IS ( TPROFILERDATA )
+ INUMSTATPROF_LOC = NUMBPROFILER_LOC
+ ISTORE = SIZE( TPROFILERS_TIME%TPDATES )
+ ALLOCATE( TPROFILERDATA :: TZSTATPROF )
+ TZSTATPROFLIST => TPROFILERS
+
+ TYPE IS ( TSTATIONDATA )
+ INUMSTATPROF_LOC = NUMBSTAT_LOC
+ ISTORE = SIZE( TSTATIONS_TIME%TPDATES )
+ ALLOCATE( TSTATIONDATA :: TZSTATPROF )
+ TZSTATPROFLIST => TSTATIONS
+
+ CLASS DEFAULT
+ CALL PRINT_MSG( NVERB_ERROR, 'IO', 'WRITE_STATPROF_n', 'unknown type' )
+ END SELECT
+
+ ALLOCATE( INSTATPROFPRC(ISNPROC) )
+ ALLOCATE( IDS(INUMSTATPROF_LOC) )
+
+ !Gather number of stations/profilers present on each process
+ CALL MPI_ALLGATHER( INUMSTATPROF_LOC, 1, MNHINT_MPI, INSTATPROFPRC, 1, MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
+
+ !Store the identification number of local stations (these numbers are globals)
+ DO JS = 1, INUMSTATPROF_LOC
+ IDS(JS) = TPSTATPROF(JS)%NID
+ END DO
+
+ ALLOCATE( IDISP(ISNPROC) )
+ IDISP(1) = 0
+ DO JP = 2, ISNPROC
+ IDISP(JP) = IDISP(JP-1) + INSTATPROFPRC(JP-1)
+ END DO
+
+ INUMSTATPROF = SUM( INSTATPROFPRC(:) )
+ ALLOCATE( ISTATPROFIDS(INUMSTATPROF) )
+ ALLOCATE( ISTATPROFPRCRANK(INUMSTATPROF) )
+
+ !Gather the list of all the stations of all processes
+ CALL MPI_ALLGATHERV( IDS(:), INUMSTATPROF_LOC, MNHINT_MPI, ISTATPROFIDS(:), INSTATPROFPRC(:), &
+ IDISP(:), MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
+
+ !Store the rank of each process corresponding to a given station/profiler
+ IDX = 1
+ ISTATPROFPRCRANK(:) = -1
+ DO JP = 1, ISNPROC
+ DO JS = 1, INSTATPROFPRC(JP)
+ ISTATPROFPRCRANK(ISTATPROFIDS(IDX)) = JP
+ IDX = IDX + 1
+ END DO
+ END DO
+
+ CALL TZSTATPROF%DATA_ARRAYS_ALLOCATE( ISTORE )
+
+ IDX = 1
+
+ STATPROF: DO JS = 1, INUMSTATPROF
+ IF ( ISTATPROFPRCRANK(JS) == TPDIAFILE%NMASTER_RANK ) THEN
+ !No communication necessary, the station data is already on the writer process
+ IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
+ TZSTATPROF = TZSTATPROFLIST(IDX)
+ IDX = IDX + 1
+ END IF
+ ELSE
+ !The station data is not on the writer process
+ IF ( ISP == ISTATPROFPRCRANK(JS) ) THEN
+ ! This process has the data and needs to send it to the writer process
+ CALL TZSTATPROFLIST(IDX)%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .FALSE. )
+
+ IDX = IDX + 1
+ ELSE IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
+ ! This process is the writer and will receive the station data from its owner
+ ! Remark: allocation is already done and will be skipped in RECV_ALLOCATE
+ CALL TZSTATPROF%RECV_ALLOCATE( KFROM = ISTATPROFPRCRANK(JS), KSTORE_CUR = ISTORE, KSTORE_MAX = ISTORE )
+ END IF
+ END IF
+
+ SELECT TYPE ( TZSTATPROF )
+ TYPE IS ( TPROFILERDATA )
+ CALL PROFILER_DIACHRO_n( TPDIAFILE, TZSTATPROF )
+
+ TYPE IS ( TSTATIONDATA )
+ CALL STATION_DIACHRO_n( TPDIAFILE, TZSTATPROF )
+
+ CLASS DEFAULT
+ CALL PRINT_MSG( NVERB_ERROR, 'IO', 'WRITE_STATPROF_n', 'unknown type' )
+ END SELECT
+
+ END DO STATPROF
+
+ ! Deallocate arrays (if still allocated)
+ IF ( TZSTATPROF%NSTORE_MAX >= 0 ) CALL TZSTATPROF%DATA_ARRAYS_DEALLOCATE( )
+
+ END SUBROUTINE WRITE_STATPROF_n
+
+END MODULE MODE_WRITE_STATPROF_N
diff --git a/src/MNH/xy_to_latlon.f90 b/src/MNH/xy_to_latlon.f90
index 4537388a16dd24a541a507d24512bbaca8c2c4b6..865aaab7aee67e92f262dbcd463f444379e9c59f 100644
--- a/src/MNH/xy_to_latlon.f90
+++ b/src/MNH/xy_to_latlon.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -73,6 +73,7 @@ USE MODD_LUNIT
!
USE MODE_FIELD, ONLY: INI_FIELD_LIST
USE MODE_GRIDPROJ
+USE MODE_INIT_ll, only: SET_DIM_ll, SET_JP_ll
USE MODE_IO, only: IO_Config_set, IO_Init
use MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
diff --git a/src/MNH/zoom_pgd.f90 b/src/MNH/zoom_pgd.f90
index 0763fd28301b809b9496f68736e0846dc36fdd8c..5f8630d8d006664932db1826caa9eb52030eb4c6 100644
--- a/src/MNH/zoom_pgd.f90
+++ b/src/MNH/zoom_pgd.f90
@@ -198,7 +198,6 @@ IF ( (LEN_TRIM(YZOOMFILE) == 0) .OR. (ADJUSTL(YZOOMFILE) == ADJUSTL(CPGDFILE)) )
END IF
!
CALL IO_File_add2list(TZZOOMFILE,TRIM(YZOOMFILE),'PGD','WRITE',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=1,KLFIVERB=5)
-!PW: TODO: points to dad file (if existing) ! TZZOOMFILE%TDADFILE =>
!
CALL IO_File_open(TZZOOMFILE)
CALL WRITE_HGRID(1,TZZOOMFILE)
diff --git a/src/MNH/zsmt_pgd.f90 b/src/MNH/zsmt_pgd.f90
index 3aea708e68726cdae989f5b7320123247ef02daa..37b88613be600919f800befce88282d1e07800ed 100644
--- a/src/MNH/zsmt_pgd.f90
+++ b/src/MNH/zsmt_pgd.f90
@@ -155,8 +155,6 @@ ALLOCATE(ZYHAT(IJU))
CALL IO_Field_read(TPFILE,'XHAT',ZXHAT)
CALL IO_Field_read(TPFILE,'YHAT',ZYHAT)
-!PW: bug/TODO: read a field in a file opened in WRITE mode
-!There is a test in IO_Field_read_BYFIELD_X2 to allow this if TPFILE%CMODE='LFICDF4'
CALL IO_Field_read(TPFILE,'ZS',ZZS)
!
DO JI=1,JPHEXT
diff --git a/src/Makefile b/src/Makefile
index 8daef858a9d44a5653aedf07f5bdddb90bef7e7d..b9544933e469b27e86b676f28b9b5a4d788c1694 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -238,13 +238,13 @@ cleanlibmaster :
rm -f $(LIB_MASTER)
cleanmaster :
- test -d $(OBJDIR_MASTER) && rm -fr $(OBJDIR_MASTER)
+ - [ -d $(OBJDIR_MASTER) ] && rm -fr $(OBJDIR_MASTER)
cleanobjmaster :
- test -d $(OBJDIR_MASTER) && find $(OBJDIR_MASTER) -follow -name "*.o" -o -name "*.mod" | xargs rm
+ - [ -d $(OBJDIR_MASTER) ] && find $(OBJDIR_MASTER) -follow -name "*.o" -o -name "*.mod" | xargs rm
cleanprogmaster :
- test -d $(OBJDIR_MASTER) && cd $(OBJDIR_MASTER) && rm -f $(PROG_LIST)
+ - [ -d $(OBJDIR_MASTER) ] && cd $(OBJDIR_MASTER) && rm -f $(PROG_LIST)
##########################################################
# #
@@ -331,9 +331,10 @@ $(ECCODES_MOD) :
-DCMAKE_Fortran_FLAGS=$(ECCODES_FFLAGS) -DCMAKE_C_FLAGS=$(ECCODES_CFLAGS) ${EC_CONF} && \
$(MAKE) && $(MAKE) install && $(MAKE) clean
+cleanmaster : eccodes_lib_clean
eccodes_lib_clean :
- - [ -d ${DIR_ECCODES_BUILD} ] && rm -fr ${DIR_ECCODES_BUILD}
- - [ -d ${DIR_ECCODES_INSTALL} ] && rm -fr ${DIR_ECCODES_INSTALL}
+ - [ -d $(DIR_ECCODES_BUILD) ] && rm -fr $(DIR_ECCODES_BUILD)
+ - [ -d $(DIR_ECCODES_INSTALL) ] && rm -fr $(DIR_ECCODES_INSTALL)
##########################################################
# #
# EXTRA LIB : NETCDF #
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index 465888c1c9072c031e8a7f4331acfc65fa9f4a91..6c9420cecf939b753d843c54d177c914efe03376 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -342,7 +342,7 @@ INC_MPI = -I$(B)$(DIR_MPI)
DIR_MASTER += $(DIR_MPI)
OBJS_LISTE_MASTER += mpivide.o
INC += $(INC_MPI)
-mpivide.o : CPPFLAGS += -DMNH_INT=$(MNH_INT) -DMNH_REAL=$(MNH_REAL) \
+mpivide.o : CPPFLAGS_C += -DMNH_INT=$(MNH_INT) -DMNH_REAL=$(MNH_REAL) \
-I$(DIR_MPI)/include
VPATH += $(DIR_MPI)
endif
@@ -479,11 +479,11 @@ ifneq "$(MNH_GRIBAPI)" "yes"
DIR_ECCODES_SRC?=${SRC_MESONH}/src/LIB/eccodes-${VERSION_ECCODES}-Source
DIR_ECCODES_BUILD?=${OBJDIR_MASTER}/build_eccodes-${VERSION_ECCODES}
DIR_ECCODES_INSTALL?=${OBJDIR_MASTER}/ECCODES-${VERSION_ECCODES}
-ECCODES_MOD?=${DIR_ECCODES_INSTALL}/include/grib_api.mod
+ECCODES_MOD?=$(DIR_ECCODES_INSTALL)/include/grib_api.mod
#
ifdef DIR_ECCODES_SRC
-INC_ECCODES ?= -I${DIR_ECCODES_INSTALL}/include
-LIB_ECCODES ?= -L${DIR_ECCODES_INSTALL}/lib -L${DIR_ECCODES_INSTALL}/lib64 -leccodes_f90 -leccodes
+INC_ECCODES ?= -I$(DIR_ECCODES_INSTALL)/include
+LIB_ECCODES ?= -L$(DIR_ECCODES_INSTALL)/lib -L$(DIR_ECCODES_INSTALL)/lib64 -leccodes_f90 -leccodes
INC += $(INC_ECCODES)
LIBS += $(LIB_ECCODES)
VPATH += $(DIR_ECCODES_INSTALL)/include
diff --git a/src/PHYEX/aux/modd_dimphyexn.f90 b/src/PHYEX/aux/modd_dimphyexn.f90
index a2767fe04d1d746f47a742200d17f1f97522477d..f9b5cf5f0a39d20e5345ececc6006b5dc983e5b0 100644
--- a/src/PHYEX/aux/modd_dimphyexn.f90
+++ b/src/PHYEX/aux/modd_dimphyexn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2022-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -53,7 +53,7 @@ TYPE DIMPHYEX_t
! 1: as for Méso-NH, levels are numbered from ground to space
! -1: as for AROME, levels are numbered from space to ground
INTEGER :: NKT ! Array total dimension
- INTEGER :: NKLES ! Total physical k dimension (for LES diag)
+ INTEGER :: NKLES ! Number of vertical levels for LES diagnostics
INTEGER :: NKA ! Near ground array index (is an unphysical level if JPVEXT!=0)
INTEGER :: NKU ! Uppest atmosphere array index (is an unphysical level if JPVEXT!=0)
INTEGER :: NKB ! Near ground physical array index (e.g. equal to 1+JPVEXT if NKL==1)
@@ -76,6 +76,7 @@ TYPE DIMPHYEX_t
INTEGER :: NIJE ! Last horizontal inner mass point index
!
INTEGER :: NLESMASK ! Number of LES masks
+ INTEGER :: NLES_TIMES ! Number of LES time data storage
!
END TYPE DIMPHYEX_t
!
diff --git a/src/PHYEX/aux/mode_argslist_ll_phy.F90 b/src/PHYEX/aux/mode_argslist_ll_phy.F90
new file mode 100644
index 0000000000000000000000000000000000000000..de0a2f3be638ee37ff57be176a475ad882f2b290
--- /dev/null
+++ b/src/PHYEX/aux/mode_argslist_ll_phy.F90
@@ -0,0 +1,60 @@
+!MNH_LIC Copyright 2023-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+!! #######################
+MODULE MODE_ARGSLIST_ll_PHY
+!
+ USE MODE_ll
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+ CONTAINS
+!
+ SUBROUTINE ADD3DFIELD_ll_PHY(D, TPLIST, PFIELD, HNAME)
+!! ###############################################
+!
+!!**** *ADD3DFIELD_ll_PHY* -
+!
+!! Purpose
+!! -------
+! This routine is used as an interface to ADD3DFIELD_ll for
+! unpacking horizontal dimensions
+!
+!! Reference
+!! ---------
+!
+! see PHYEX documentation
+!
+!! Implicit Arguments
+!! ------------------
+!
+! Module MODD_ARGSLIST :
+! LIST_ll : list of fields
+! DIMPHYEX_t: PHYEX dimensions
+!
+!! Author
+!! ------
+!
+! Q.Rodier
+!
+!! Modifications
+!! -------------
+! Original August, 3, 2023
+!
+!-------------------------------------------------------------------------------
+!
+ IMPLICIT NONE
+!
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(LIST_ll), POINTER :: TPLIST ! list of fields
+ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PFIELD ! field which is unpaked here
+! of fields
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the field to be added
+
+ CALL ADD3DFIELD_ll(TPLIST, PFIELD, HNAME)
+
+ END SUBROUTINE ADD3DFIELD_ll_PHY
+END MODULE MODE_ARGSLIST_ll_PHY
diff --git a/src/PHYEX/aux/mode_fill_dimphyexn.f90 b/src/PHYEX/aux/mode_fill_dimphyexn.f90
index 80679f8e1929dfc71b47905a1d88abf6ebffd437..469ae60851a7750d02d1e5c37a652c0502c7901f 100644
--- a/src/PHYEX/aux/mode_fill_dimphyexn.f90
+++ b/src/PHYEX/aux/mode_fill_dimphyexn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2022-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -6,7 +6,7 @@
MODULE MODE_FILL_DIMPHYEX
IMPLICIT NONE
CONTAINS
-SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT, LTURB)
+SUBROUTINE FILL_DIMPHYEX( YDDIMPHYEX, KIT, KJT, KKT, LTURB, KLES_TIMES, KLES_K )
! #########################
!
!!
@@ -29,6 +29,7 @@ SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT, LTURB)
!! MODIFICATIONS
!! -------------
!! Original January 2022
+! P. Wautelet 04/10/2023: bugfix: set NKLES correctly
!
!-----------------------------------------------------------------
!* 0. DECLARATIONS
@@ -50,6 +51,9 @@ TYPE(DIMPHYEX_t), INTENT(OUT) :: YDDIMPHYEX ! Structure to fill in
INTEGER, INTENT(IN) :: KIT, KJT, KKT ! Array dimensions
LOGICAL, INTENT(IN), OPTIONAL :: LTURB ! Flag to replace array dimensions I/JB and I/JE to the full array size
! needed if computation in HALO points (e.g. in turbulence)
+INTEGER, INTENT(IN), OPTIONAL :: KLES_TIMES ! number of LES computations in time
+INTEGER, INTENT(IN), OPTIONAL :: KLES_K ! number of vertical levels for LES diagnostics
+
LOGICAL :: YTURB
!
!* 0.2 declaration of local variables
@@ -74,7 +78,6 @@ YDDIMPHYEX%NKA=1
YDDIMPHYEX%NKU=KKT
YDDIMPHYEX%NKB=1+JPVEXT
YDDIMPHYEX%NKE=KKT-JPVEXT
-YDDIMPHYEX%NKLES=KKT-2*JPVEXT
YDDIMPHYEX%NKTB=1+JPVEXT
YDDIMPHYEX%NKTE=KKT-JPVEXT
!
@@ -97,7 +100,15 @@ ELSE
END IF
IF (LHOOK) CALL DR_HOOK('FILL_DIMPHYEX', 1, ZHOOK_HANDLE)
!
-YDDIMPHYEX%NLESMASK = 1
+YDDIMPHYEX%NLESMASK=1
+YDDIMPHYEX%NLES_TIMES=0
+IF (PRESENT(KLES_TIMES)) THEN
+ YDDIMPHYEX%NLES_TIMES = KLES_TIMES
+END IF
+YDDIMPHYEX%NKLES=0
+IF (PRESENT(KLES_K)) THEN
+ YDDIMPHYEX%NKLES = KLES_K
+END IF
IF (LLES_MY_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + NLES_MASKS_USER
IF (LLES_NEB_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + 2
IF (LLES_CORE_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + 2
diff --git a/src/PHYEX/micro/rain_ice_warm.f90 b/src/PHYEX/micro/rain_ice_warm.f90
index 133dc888b8a8c74c6ca2708e58baf37b7587fc1a..0a781900c768fdd2cf37a3d36ecc27c238709efe 100644
--- a/src/PHYEX/micro/rain_ice_warm.f90
+++ b/src/PHYEX/micro/rain_ice_warm.f90
@@ -72,7 +72,6 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
-!PW: PUSW could be a purely local variable?
REAL, DIMENSION(:), INTENT(INOUT) :: PUSW ! Undersaturation over water
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
!
diff --git a/src/PHYEX/turb/les_mean_subgrid_phy.f90 b/src/PHYEX/turb/les_mean_subgrid_phy.f90
index 88a7d2c7260c6756fca71fcaabaebfbaa19b0f34..92d0629464e0cff34788b70ae8bcc8cd6d4071b5 100644
--- a/src/PHYEX/turb/les_mean_subgrid_phy.f90
+++ b/src/PHYEX/turb/les_mean_subgrid_phy.f90
@@ -25,7 +25,7 @@ TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(TLES_t), INTENT(IN) :: TLES
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA
!
-REAL, DIMENSION(D%NKLES,TLES%NLES_CURRENT_TCOUNT,D%NLESMASK), INTENT(INOUT) :: PA_MEAN
+REAL, DIMENSION(D%NKLES,D%NLES_TIMES,D%NLESMASK), INTENT(INOUT) :: PA_MEAN
!
LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
!
@@ -41,7 +41,7 @@ TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(TLES_t), INTENT(IN) :: TLES
REAL, DIMENSION(D%NIJT), INTENT(IN) :: PA
!
-REAL, DIMENSION(TLES%NLES_CURRENT_TCOUNT), INTENT(INOUT) :: PA_MEAN
+REAL, DIMENSION(D%NLES_TIMES), INTENT(INOUT) :: PA_MEAN
!
LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
!
@@ -63,7 +63,7 @@ IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(TLES_t), INTENT(IN) :: TLES
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA
-REAL, DIMENSION(D%NKLES,TLES%NLES_CURRENT_TCOUNT,D%NLESMASK), INTENT(INOUT) :: PA_MEAN
+REAL, DIMENSION(D%NKLES,D%NLES_TIMES,D%NLESMASK), INTENT(INOUT) :: PA_MEAN
LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
!
CALL LES_MEAN_SUBGRID_unpack3D(D,TLES, PA, PA_MEAN, OSUM)
@@ -85,7 +85,7 @@ IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(TLES_t), INTENT(IN) :: TLES
REAL, DIMENSION(D%NIJT), INTENT(IN) :: PA
-REAL, DIMENSION(TLES%NLES_CURRENT_TCOUNT), INTENT(INOUT) :: PA_MEAN
+REAL, DIMENSION(D%NLES_TIMES), INTENT(INOUT) :: PA_MEAN
LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
!
CALL LES_MEAN_SUBGRID_unpackSURF(D, TLES, PA, PA_MEAN, OSUM)
@@ -105,7 +105,7 @@ IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(TLES_t), INTENT(IN) :: TLES
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA
-REAL, DIMENSION(D%NKLES,TLES%NLES_CURRENT_TCOUNT,D%NLESMASK), INTENT(INOUT) :: PA_MEAN
+REAL, DIMENSION(D%NKLES,D%NLES_TIMES,D%NLESMASK), INTENT(INOUT) :: PA_MEAN
LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
!
CALL LES_MEAN_SUBGRID_3D(PA, PA_MEAN, OSUM)
@@ -128,7 +128,7 @@ IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(TLES_t), INTENT(IN) :: TLES
REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PA
-REAL, DIMENSION(TLES%NLES_CURRENT_TCOUNT), INTENT(INOUT) :: PA_MEAN
+REAL, DIMENSION(D%NLES_TIMES), INTENT(INOUT) :: PA_MEAN
LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
!
CALL LES_MEAN_SUBGRID_SURF(PA, PA_MEAN, OSUM)
diff --git a/src/PHYEX/turb/mode_tke_eps_sources.f90 b/src/PHYEX/turb/mode_tke_eps_sources.f90
index 7e1adeafbf71d858fe19dc8b108d88e26239d9df..ef2af6385bb73cc3853bb6998a045dea8c4e445f 100644
--- a/src/PHYEX/turb/mode_tke_eps_sources.f90
+++ b/src/PHYEX/turb/mode_tke_eps_sources.f90
@@ -145,6 +145,7 @@ USE MODD_TURB_n, ONLY: TURB_t
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_END_PHY, BUDGET_STORE_INIT_PHY
USE MODE_IO_FIELD_WRITE_PHY, ONLY: IO_FIELD_WRITE_PHY
USE MODE_ll
+USE MODE_ARGSLIST_ll_PHY, ONLY: ADD3DFIELD_ll_PHY
!
USE MODI_GET_HALO
USE MODI_LES_MEAN_SUBGRID_PHY
@@ -320,7 +321,7 @@ IF (ODIAG_IN_RUN) THEN
*(PEXPL*PTKEM(:,:) + TURBN%XIMPL*ZRES(:,:))
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
- CALL ADD2DFIELD_ll(TZFIELDDISS_ll, PCURRENT_TKE_DISS, 'TKE_EPS_SOURCES::PCURRENT_TKE_DISS' )
+ CALL ADD3DFIELD_ll_PHY(D, TZFIELDDISS_ll, PCURRENT_TKE_DISS, 'TKE_EPS_SOURCES::PCURRENT_TKE_DISS' )
CALL UPDATE_HALO_ll(TZFIELDDISS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDDISS_ll)
ENDIF
diff --git a/src/PHYEX/turb/mode_turb_ver_sv_flux.f90 b/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
index 1817fbb86c949a49ce427384ef054b4b04357786..21443271df8bc1968d471c2e683e20003032c6b9 100644
--- a/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -204,6 +204,7 @@ SUBROUTINE TURB_VER_SV_FLUX(D,CST,CSTURB,TURBN,TLES,ONOMIXLG, &
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! Wim de Rooy 06/2019: with energycascade, 50MF nog longer necessary
! P. Wautelet 30/11/2022: compute PWSV only when needed
+! P. Wautelet 01/06/2023: fix for PWSV
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -396,7 +397,7 @@ DO JSV=1,KSV
PRHODJ(:,:)*(ZRES(:,:)-PSVM(:,:,JSV))/PTSTEP
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
- IF ( (TURBN%LTURB_FLX .AND. TPFILE%LOPENED) .OR. TLES%LLES_CALL ) THEN
+ IF ( (TURBN%LTURB_FLX .AND. TPFILE%LOPENED) .OR. TLES%LLES_CALL .OR. OFLYER ) THEN
! Diagnostic of the cartesian vertical flux
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -444,7 +445,7 @@ DO JSV=1,KSV
PWSV(:,IKE,JSV)=PWSV(:,IKE-IKL,JSV)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
- END IF
+ END IF
!
IF (TURBN%LTURB_FLX .AND. TPFILE%LOPENED) THEN
! stores the JSVth vertical flux
@@ -453,7 +454,6 @@ DO JSV=1,KSV
CMNHNAME = TRIM( YMNHNAME ), &
CSTDNAME = '', &
CLONGNAME = TRIM( YMNHNAME ), &
- !PW: TODO: use the correct units of the JSV variable (and multiply it by m s-1)
CUNITS = 'SVUNIT m s-1', &
CDIR = 'XY', &
CCOMMENT = 'X_Y_Z_' // TRIM( YMNHNAME ), &
diff --git a/src/Rules.LXcray.mk b/src/Rules.LXcray.mk
index 861de4c1319fc584b227f9d2c428c80f95fffd6f..b1579f030f00360fb1d80bba93a12b5bbcbc5208 100644
--- a/src/Rules.LXcray.mk
+++ b/src/Rules.LXcray.mk
@@ -185,7 +185,7 @@ ifeq ($(shell test $(CFV) -ge 1402 ; echo $$?),0)
CPPFLAGS_MNH += -DMNH_COMPILER_CCE_1403
endif
CPPFLAGS_MNH += -DMNH_EXPAND -DMNH_EXPAND_LOOP -DMNH_EXPAND_OPENACC
-CPPFLAGS_MNH += -imacros MNH_OPENACC_NV_CR.CPP
+#CPPFLAGS_MNH += -imacros MNH_OPENACC_NV_CR.CPP
ifdef VER_GA
CPPFLAGS_SURCOUCHE += -DMNH_GA
INC += -I${GA_ROOT}/include
diff --git a/src/MNH/coupling_dmsn.F90 b/src/SURFEX/coupling_dmsn.F90
similarity index 100%
rename from src/MNH/coupling_dmsn.F90
rename to src/SURFEX/coupling_dmsn.F90
diff --git a/src/SURFEX/coupling_sltn.F90 b/src/SURFEX/coupling_sltn.F90
index 3db0c7b1a987464590ce42376196f115d2188399..cdb6c10ee14606387b1c2ef4ade7427feb3e2155 100644
--- a/src/SURFEX/coupling_sltn.F90
+++ b/src/SURFEX/coupling_sltn.F90
@@ -192,7 +192,7 @@ IF ((CEMISPARAM_SLT .eq. "Ova14").OR.(CEMISPARAM_SLT .eq. "OvB21a").OR.(CEMISPAR
! Tableau d'interpolation pour calculer ZNUWATER en fonction de la SST
! Cas ou 0 < SST < 10 C
- WHERE ((PSST(:) >= 273.15).AND.(PSST(:) < 283.15))
+ WHERE (PSST(:) < 283.15)
ZVISCO(:) = ZNUWATER(1) + (PSST(:) - ZWT(1)) * (ZNUWATER(2)-ZNUWATER(1)) / &
(ZWT(2) - ZWT(1))
ENDWHERE
@@ -210,7 +210,7 @@ IF ((CEMISPARAM_SLT .eq. "Ova14").OR.(CEMISPARAM_SLT .eq. "OvB21a").OR.(CEMISPAR
ENDWHERE
! Cas ou 30 < SST < 40 C
- WHERE ((PSST(:) >= 303.15).AND.(PSST(:) < 313.15))
+ WHERE (PSST(:) >= 303.15)
ZVISCO(:) = ZNUWATER(4) + (PSST(:) - ZWT(4)) * (ZNUWATER(5)-ZNUWATER(4)) / &
(ZWT(5) - ZWT(4))
ENDWHERE
diff --git a/src/SURFEX/default_slt.F90 b/src/SURFEX/default_slt.F90
index ca96f03f98d0b5c56c5cbd4b31838ac4d8c27045..1ac9363d66c36f06f83a25449d1b2d1467410d60 100644
--- a/src/SURFEX/default_slt.F90
+++ b/src/SURFEX/default_slt.F90
@@ -53,10 +53,8 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DEFAULT_SLT',0,ZHOOK_HANDLE)
-! ++ PIERRE / MARINE SSA - MODIF ++
-CEMISPARAM_SLT = 'Ova14'
-JPMODE_SLT = 5
-! -- PIERRE / MARINE SSA - MODIF --
+CEMISPARAM_SLT = 'OvB21b'
+JPMODE_SLT = 8
LVARSIG_SLT = .FALSE.
LRGFIX_SLT = .TRUE.
IF (LHOOK) CALL DR_HOOK('DEFAULT_SLT',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/init_slt.F90 b/src/SURFEX/init_slt.F90
index 2182cbeb851c052aa64199836e92cc7eba49711f..51f0eeb3f1b6c55b71106f7c8a7bcd2302a84cf9 100644
--- a/src/SURFEX/init_slt.F90
+++ b/src/SURFEX/init_slt.F90
@@ -37,12 +37,11 @@ IF (LHOOK) CALL DR_HOOK('INIT_SLT',0,ZHOOK_HANDLE)
!Get initial size distributions. This is cut and pasted
!from dead routine dstpsd.F90
!Check for different source parameterizations
-! Default : CEMISPARAM_SLT.eq."Ova14"
-
- NSLTMDE = 5
+! Default : CEMISPARAM_SLT.eq."OvB21b"
+ NSLTMDE = 8
CRGUNITS = 'NUMB'
- XEMISRADIUS_INI_SLT = (/0.009, 0.021, 0.045, 0.115, 0.415, 0.0, 0.0, 0.0/)
- XEMISSIG_INI_SLT = (/1.37, 1.5, 1.42, 1.53, 1.85,0.,0.,0./)
+ XEMISRADIUS_INI_SLT = (/0.009, 0.021, 0.045, 0.115, 0.415, 2.5, 7.0, 25.0/)
+ XEMISSIG_INI_SLT = (/1.37, 1.5, 1.42, 1.53,1.70,1.80, 1.85, 2.1/)
IF ((CEMISPARAM_SLT.eq."OvB21a").OR.(CEMISPARAM_SLT.eq."OvB21b")) THEN
NSLTMDE = 8
@@ -50,6 +49,11 @@ IF ((CEMISPARAM_SLT.eq."OvB21a").OR.(CEMISPARAM_SLT.eq."OvB21b")) THEN
XEMISRADIUS_INI_SLT = (/0.009, 0.021, 0.045, 0.115, 0.415, 2.5, 7.0, 25.0/)
XEMISSIG_INI_SLT = (/1.37, 1.5, 1.42, 1.53,1.70,1.80, 1.85, 2.1/)
+ELSE IF (CEMISPARAM_SLT.eq."Ova14") THEN
+ NSLTMDE = 5
+ CRGUNITS = 'NUMB'
+ XEMISRADIUS_INI_SLT = (/0.009, 0.021, 0.045, 0.115, 0.415, 0.0, 0.0, 0.0/)
+ XEMISSIG_INI_SLT = (/1.37, 1.5, 1.42, 1.53, 1.85,0.,0.,0./)
ELSE IF (CEMISPARAM_SLT.eq."Vig01") THEN
NSLTMDE = 5
diff --git a/src/SURFEX/modd_ch_isban.F90 b/src/SURFEX/modd_ch_isban.F90
index 6f97ac6cb325b72e30ec9459622f0a8365fb8786..b817f5810da674a597ab9be8eb737ff68bd2e07d 100644
--- a/src/SURFEX/modd_ch_isban.F90
+++ b/src/SURFEX/modd_ch_isban.F90
@@ -83,7 +83,7 @@ NULLIFY(YCH_ISBA%CAER_NAMES)
NULLIFY(YCH_ISBA%CDSTNAMES)
NULLIFY(YCH_ISBA%CSLTNAMES)
NULLIFY(YCH_ISBA%CSNWNAMES)
-YCH_ISBA%CCHEM_SURF_FILE=' '
+YCH_ISBA%CCHEM_SURF_FILE='MNHC.input'
YCH_ISBA%CCH_DRY_DEP=' '
YCH_ISBA%CPARAMBVOC=' '
YCH_ISBA%LCH_BIO_FLUX=.FALSE.
diff --git a/src/SURFEX/modd_ch_surfn.F90 b/src/SURFEX/modd_ch_surfn.F90
index 6114c9132946c60dc2147da017b12579bbafe55b..3108882b02d72437eaa285a5ebbe5cfa6e76d8fa 100644
--- a/src/SURFEX/modd_ch_surfn.F90
+++ b/src/SURFEX/modd_ch_surfn.F90
@@ -85,7 +85,7 @@ IF (LHOOK) CALL DR_HOOK("MODD_CH_SURF_N:CH_SURF_INIT",0,ZHOOK_HANDLE)
YCH_SURF%CCH_EMIS='NONE'
YCH_SURF%CCH_BIOEMIS='NONE'
YCH_SURF%CCH_DMSEMIS='NONE'
-YCH_SURF%CCHEM_SURF_FILE='EXSEG1.nam'
+YCH_SURF%CCHEM_SURF_FILE='MNHC.input'
YCH_SURF%LCH_SURF_EMIS=.FALSE.
YCH_SURF%LCH_EMIS=.FALSE.
YCH_SURF%LCH_BIOEMIS=.FALSE.
diff --git a/src/SURFEX/modd_ch_tebn.F90 b/src/SURFEX/modd_ch_tebn.F90
index 511d142c50b1756d0d906b28650751676e6662fb..3e43a15ad3d37f04480de0c9ee6a12a8edaafe9f 100644
--- a/src/SURFEX/modd_ch_tebn.F90
+++ b/src/SURFEX/modd_ch_tebn.F90
@@ -81,7 +81,7 @@ NULLIFY(YCH_TEB%CCH_NAMES)
NULLIFY(YCH_TEB%CAER_NAMES)
NULLIFY(YCH_TEB%CDSTNAMES)
NULLIFY(YCH_TEB%CSLTNAMES)
-YCH_TEB%CCHEM_SURF_FILE=' '
+YCH_TEB%CCHEM_SURF_FILE='MNHC.input'
YCH_TEB%CCH_DRY_DEP=' '
YCH_TEB%CPARAMBVOC=' '
YCH_TEB%LCH_BIO_FLUX=.FALSE.
diff --git a/src/MNH/modd_dms_surf_fieldsn.F90 b/src/SURFEX/modd_dms_surf_fieldsn.F90
similarity index 100%
rename from src/MNH/modd_dms_surf_fieldsn.F90
rename to src/SURFEX/modd_dms_surf_fieldsn.F90
diff --git a/src/MNH/modd_dmsn.F90 b/src/SURFEX/modd_dmsn.F90
similarity index 100%
rename from src/MNH/modd_dmsn.F90
rename to src/SURFEX/modd_dmsn.F90
diff --git a/src/MNH/read_dmsn.F90 b/src/SURFEX/read_dmsn.F90
similarity index 100%
rename from src/MNH/read_dmsn.F90
rename to src/SURFEX/read_dmsn.F90
diff --git a/src/MNH/writesurf_dmsn.F90 b/src/SURFEX/writesurf_dmsn.F90
similarity index 100%
rename from src/MNH/writesurf_dmsn.F90
rename to src/SURFEX/writesurf_dmsn.F90
diff --git a/src/configure b/src/configure
index 7796f2ea9fed0291a6c509ac7ce8ea981872209f..0d97821268878124bb597a64d84bb8318cbc9aa0 100755
--- a/src/configure
+++ b/src/configure
@@ -9,9 +9,9 @@ if [ "x$XYZ" = "x" ]
then
#
export VERSION_MASTER=${VERSION_MASTER:-MNH-V5-6}
-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:-"08/03/2023"}
+export VERSION_DATE=${VERSION_DATE:-"05/09/2023"}
export VERSION_LIBAEC=${VERSION_LIBAEC:-"v1.0.6"}
export VERSION_HDF=${VERSION_HDF:-"1.14.0"}
export VERSION_CDFC=${VERSION_CDFC:-"4.9.0"}
@@ -54,22 +54,24 @@ case "$TARG" in
'Linux login'*)
export ARCH=${ARCH:-LXcray}
export VER_MPI=${VER_MPI:-MPICRAY}
- export OPTLEVEL=${OPTLEVEL:-OPENACC}
+# export OPTLEVEL=${OPTLEVEL:-OPENACC}
+ export OPTLEVEL=${OPTLEVEL:-O2}
export MVWORK=${MVWORK:-NO}
export VER_CDF=${VER_CDF:-CDFAUTO}
if [ "${VER_MPI}" == "MPICRAY" ]
then
export MNHENV=${MNHENV:-"
module purge
-module load craype-x86-trento
+#module load craype-x86-trento
+module load craype-x86-genoa
module load craype-network-ofi
module load PrgEnv-cray/8.3.3
-module load cce/15.0.0
+module load cce/15.0.1
module load craype/2.7.19
-module load cray-mpich/8.1.21
+module load cray-mpich/8.1.24
module load libfabric/1.15.2.0
-module load craype-accel-amd-gfx90a
-module load rocm/5.2.3
+#module load craype-accel-amd-gfx90a
+module load rocm/5.3.0
export CCE_ALIAS_NONE=:on
export CCE_NO_PTR_TO_PTR_ALIAS=:on
@@ -216,10 +218,13 @@ export MPI_DSM_CPULIST=0-7:allhosts
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
-module load cmake/3.18.1
-module load inteloneapi/21.4.0
+module load cmake/3.26.4
+module load inteloneapi/23.1.0
module load mpi/openmpi/4.1.4
export SLURM_CPU_BIND=none
+
+export DIR_ECCODES_INSTALL=\${CCCWORKDIR}/ECCODES-2.18.0\${XYZM}
+
"}
;;
*AMD*) # Irene AMD core
@@ -232,10 +237,13 @@ export SLURM_CPU_BIND=none
export VERSION_XYZ="${VERSION_XYZ}-AMD"
export MNHENV=${MNHENV:-"
module purge
-module load cmake/3.18.1
-module load inteloneapi/21.4.0
+module load cmake/3.26.4
+module load inteloneapi/23.1.0
module load mpi/openmpi/4.1.4
export SLURM_CPU_BIND=none
+
+export DIR_ECCODES_INSTALL=\${CCCWORKDIR}/ECCODES-2.18.0\${XYZM}
+
# Set some openmpi variable for pb with nb of cores >> 1024
export OMPI_MCA_coll_hcoll_enable=0
export HCOLL_ENABLE_MCAST_ALL=0
@@ -372,8 +380,8 @@ export LIB_GRIBAPI='${GRIB_API_LIB}'
export MNHENV=${MNHENV:-"
module purge
module load prgenv/intel
-module switch intel/2021.4.0
-module load openmpi/4.1.1.1
+module switch intel/2023.2.0
+module load openmpi/4.1.4.1
unset CC CXX
"}
;;
diff --git a/src/job_make_examples_Atos_HPCF b/src/job_make_examples_Atos_HPCF
index 29185f52a5525a33c6a169414d5f0f38edbbc268..65ba970c370e156ff7f5909a600ac158ca392502 100755
--- a/src/job_make_examples_Atos_HPCF
+++ b/src/job_make_examples_Atos_HPCF
@@ -19,7 +19,9 @@ set -e
hostname
# Echo des commandes
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIAUTO-O2
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIAUTO-O2
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
export POSTRUN="echo "
diff --git a/src/job_make_examples_BG b/src/job_make_examples_BG
index e146e90c3e83fb6caff43baba330270c8debbb18..e8f6132974c132d298ca4a76436445931fa9c8b3 100755
--- a/src/job_make_examples_BG
+++ b/src/job_make_examples_BG
@@ -18,7 +18,9 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BG-R8I4-MNH-V5-6-0-MPIAUTO-O2
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-BG-R8I4-MNH-V5-6-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 a69dbeaac244de387f435a06c7cf9d6b7ce5a613..c03278a8d207cab00f3f9e155d2649b6e232702f 100755
--- a/src/job_make_examples_BGQ
+++ b/src/job_make_examples_BGQ
@@ -18,7 +18,9 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-6-0-MPIAUTO-O2NAN
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-6-1-MPIAUTO-O2NAN
set -x
diff --git a/src/job_make_examples_BullX b/src/job_make_examples_BullX
index 80bbd1f7243c19dd2e2f34959bdf5b751ec41143..0b587f09176955c3d9aaaa944ee6865e58ee65ca 100755
--- a/src/job_make_examples_BullX
+++ b/src/job_make_examples_BullX
@@ -19,7 +19,9 @@ set -e
hostname
# Echo des commandes
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIINTEL-O3
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIINTEL-O3
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
export POSTRUN="time "
diff --git a/src/job_make_examples_BullX_belenos b/src/job_make_examples_BullX_belenos
index ca4ec4a0a30d11a43fad85628bdc469aaf2ebec2..857cbb403e54b879d95640bb31ec6d07335a036e 100755
--- a/src/job_make_examples_BullX_belenos
+++ b/src/job_make_examples_BullX_belenos
@@ -18,7 +18,9 @@ set -e
hostname
# Echo des commandes
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIAUTO-O3
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIAUTO-O3
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
export POSTRUN="echo "
diff --git a/src/job_make_examples_BullX_irene b/src/job_make_examples_BullX_irene
index 86a6ae4652ace170eef85a03e195aabbbfac2b25..06ae65615c65f1c48d3b572b75c0aa7bb6d5400c 100755
--- a/src/job_make_examples_BullX_irene
+++ b/src/job_make_examples_BullX_irene
@@ -21,7 +21,9 @@ set +x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIAUTO-O2
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIAUTO-O2
set -x
diff --git a/src/job_make_examples_BullX_irene_AMD b/src/job_make_examples_BullX_irene_AMD
index 004a7fe2bb733b6893a923281ebf3f2d43b632be..be925880cc4f00619b193c534d429017c75bcb09 100755
--- a/src/job_make_examples_BullX_irene_AMD
+++ b/src/job_make_examples_BullX_irene_AMD
@@ -20,7 +20,9 @@ set +x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-AMD-MPIAUTO-O2
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-AMD-MPIAUTO-O2
set -x
diff --git a/src/job_make_examples_BullX_occigen b/src/job_make_examples_BullX_occigen
index 2e480800fd0c3c73a3685d9b0504d5fd296cfc2d..6542f508bd854b85a1ed6d42a2cd5fa7ac6a6fa9 100755
--- a/src/job_make_examples_BullX_occigen
+++ b/src/job_make_examples_BullX_occigen
@@ -18,7 +18,9 @@ set -x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIINTEL-O2
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIINTEL-O2
export MONORUN="Mpirun -prepend-rank -np 1 "
export MPIRUN="Mpirun -prepend-rank -np 4 "
export POSTRUN="echo "
diff --git a/src/job_make_examples_BullX_olympe b/src/job_make_examples_BullX_olympe
index c11b5a4593bba76312d85058fcada1f604c25c53..69b879082fb2b47a19789d9757fe0b0b39fb3509 100755
--- a/src/job_make_examples_BullX_olympe
+++ b/src/job_make_examples_BullX_olympe
@@ -17,7 +17,9 @@ set -x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIINTEL-O2
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIINTEL-O2
export MONORUN="mpirun -prepend-rank -np 1 "
export MPIRUN="mpirun -prepend-rank -np 4 "
export POSTRUN="echo "
diff --git a/src/job_make_examples_CRAY_cca b/src/job_make_examples_CRAY_cca
index 1bec1a26b5b294618cc74f93d3ded1719b73c6be..377799f8126694bab83565fb81b2263b5e2c4c49 100755
--- a/src/job_make_examples_CRAY_cca
+++ b/src/job_make_examples_CRAY_cca
@@ -24,11 +24,13 @@ set -x
# Nom de la machine
hostname
+unset MAKEFLAGS
+
cd ${PBS_O_WORKDIR}
ARCH=LXifort
#ARCH=LXcray
-. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-6-0-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-6-1-MPICRAY-O2
export MONORUN="aprun -n 1 "
diff --git a/src/job_make_examples_HPE_adastra_genoa b/src/job_make_examples_HPE_adastra_genoa
new file mode 100755
index 0000000000000000000000000000000000000000..748fac3e0def27fc0474208dd6853444cb3e316c
--- /dev/null
+++ b/src/job_make_examples_HPE_adastra_genoa
@@ -0,0 +1,68 @@
+#!/bin/bash
+#SBATCH -J Examples
+#SBATCH -N 1 # nodes number
+#SBATCH -n 4 # CPUs number (on all nodes)
+#SBATCH -C GENOA
+##SBATCH --exclusive
+#SBATCH -o Examples.eo%j #
+#SBATCH -e Examples.eo%j #
+#SBATCH -t 01:00:00 # time limit
+#SBATCH --export=NONE
+#SBATCH -A mnh # put here you account/projet name
+
+# Echo of commands
+ulimit -c 0
+ulimit -s unlimited
+# Stop job at first error
+#set -e
+set -x
+# Machine name
+hostname
+
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-LXcray-R8I4-MNH-V5-6-1-MPICRAY-O2
+export MONORUN="Exec srun -l -n 1 --export=ALL"
+export MPIRUN="Exec srun -l -n 4 --export=ALL"
+export POSTRUN="echo "
+
+cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
+make -k
+#
+echo "#################################################################################"
+echo "##NEXT CASE######################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/001_2Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##NEXT CASE######################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/002_3Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##NEXT CASE######################################################################"
+echo "#################################################################################"
+
+cd $SRC_MESONH/MY_RUN/KTEST/004_Reunion
+make -k << EOF
+
+
+EOF
+#
+echo "#################################################################################"
+echo "##NEXT CASE######################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/007_16janvier
+make -k << EOF
+
+
+EOF
+#
+echo "#################################################################################"
+echo "##NEXT CASE######################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/014_LIMA
+make -k
+
diff --git a/src/job_make_examples_HPE_jeanzay b/src/job_make_examples_HPE_jeanzay
index 29b676401d6c260ffedeb655287586055d3b9cbb..69cf4ed54a4edb480afe5733ca0b30cc4cd603c7 100755
--- a/src/job_make_examples_HPE_jeanzay
+++ b/src/job_make_examples_HPE_jeanzay
@@ -19,7 +19,9 @@ set -x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIINTEL-O2
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIINTEL-O2
export MONORUN="Exec srun -l -n 1 --export=ALL numabind_core_slurm"
export MPIRUN="Exec srun -l -n 4 --export=ALL numabind_core_slurm"
export POSTRUN="echo "
diff --git a/src/job_make_examples_IBM_ada b/src/job_make_examples_IBM_ada
index 08f4d0775f19858e16bd0849db5166639427773f..fab87c7c9b0e0d83b75a738f19b130dd585a21bc 100755
--- a/src/job_make_examples_IBM_ada
+++ b/src/job_make_examples_IBM_ada
@@ -19,7 +19,9 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIINTEL-O2
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-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 ad1058d3af3bd63c509b2a1bdd8db24271689ecf..a9b0f45279275b91ee4cc24bd6d1c85bf6d26f31 100755
--- a/src/job_make_examples_IBM_sp6_vargas
+++ b/src/job_make_examples_IBM_sp6_vargas
@@ -24,7 +24,9 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-0-MPIAUTO-O2
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-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 54502104ac948ddbfcb7c4636fe406156f75148d..c3a8d5b4eed43e25551d63f03e1ae691f5a24334 100755
--- a/src/job_make_examples_NEC_SX8
+++ b/src/job_make_examples_NEC_SX8
@@ -16,9 +16,11 @@ set -x
# Nom de la machine
hostname
+unset MAKEFLAGS
+
[ -d $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
#
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-0-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-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 8d450e8cd86498eed68fc21b72fc3fed0f197760..8b64eb53b84448310688fca97cb9b72cda39c5d5 100755
--- a/src/job_make_examples_SX8
+++ b/src/job_make_examples_SX8
@@ -16,10 +16,12 @@ set -x
# Nom de la machine
hostname
+unset MAKEFLAGS
+
[ -d $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
#
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-0-MPIAUTO-O2
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-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 5a5139286b40e856bcdd6855da152ce0459a2f8e..e47b714dbc480a2ca76068d9f63febf48e8c7278 100755
--- a/src/job_make_examples_cxa
+++ b/src/job_make_examples_cxa
@@ -34,7 +34,9 @@ echo SHELL=$SHELL
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-0-MPIAUTO-O2
+unset MAKEFLAGS
+
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-1-MPIAUTO-O2
ulimit -c 0 # pas de core
diff --git a/src/job_make_mesonh_BG b/src/job_make_mesonh_BG
index 8c324f72f15d2e9428e5525c24fdea54111f8644..b1d7561bf18c046e886d5d4d6ed81f96b3beb2b4 100755
--- a/src/job_make_mesonh_BG
+++ b/src/job_make_mesonh_BG
@@ -18,7 +18,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BG-R8I4-MNH-V5-6-0-MPIAUTO-O2
+. ../conf/profile_mesonh-BG-R8I4-MNH-V5-6-1-MPIAUTO-O2
#time gmake
time gmake -r -j8
diff --git a/src/job_make_mesonh_BGQ b/src/job_make_mesonh_BGQ
index 3ce435015a33188483647d301e261be53bc86d5d..cf6051a1f8b4d2f3b474cff9ea9fead3df1a949c 100755
--- a/src/job_make_mesonh_BGQ
+++ b/src/job_make_mesonh_BGQ
@@ -20,7 +20,7 @@ set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-6-0-MPIAUTO-O2NAN
+. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-6-1-MPIAUTO-O2NAN
time gmake -j8
time gmake -j8
diff --git a/src/job_make_mesonh_BullX b/src/job_make_mesonh_BullX
index 6eda7dd72932d6e476ff0d8278bcee751d08421d..d25fe2a8fb563a1efa57d89657cecfb58f8231e2 100755
--- a/src/job_make_mesonh_BullX
+++ b/src/job_make_mesonh_BullX
@@ -19,7 +19,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
pwd
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIINTEL-O3
time gmake -j 4
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_BullX_belenos b/src/job_make_mesonh_BullX_belenos
index b10427e6bba0adce902fa78b54644028fc7a0a11..ce33a2d8067d13d0235d18e6663c2105bcdda331 100755
--- a/src/job_make_mesonh_BullX_belenos
+++ b/src/job_make_mesonh_BullX_belenos
@@ -16,7 +16,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
pwd
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIAUTO-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIAUTO-O3
time make -j 16
time make -j 1 installmaster
diff --git a/src/job_make_mesonh_CRAY_cca b/src/job_make_mesonh_CRAY_cca
index 414410ada6b5675f3f221c7acfcd1a62da3c417c..4c6d3a42ba60c585bebf90e86bd9172eacc58d1f 100755
--- a/src/job_make_mesonh_CRAY_cca
+++ b/src/job_make_mesonh_CRAY_cca
@@ -21,7 +21,7 @@ pwd
ARCH=LXifort
#ARCH=LXcray
-. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-6-0-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-6-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_HPE_adastra_genoa b/src/job_make_mesonh_HPE_adastra_genoa
new file mode 100755
index 0000000000000000000000000000000000000000..c7816c7764735623a0c0ba94cea0fcaef41a39d4
--- /dev/null
+++ b/src/job_make_mesonh_HPE_adastra_genoa
@@ -0,0 +1,22 @@
+#!/bin/bash
+#MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC for details. version 1.
+#SBATCH --job-name=compile_MNH
+#SBATCH -N 1 -n 1 -c 32
+#SBATCH -o Sortie_compile_MasterI.eo%j
+#SBATCH --export=NONE
+#SBATCH -C GENOA
+#SBATCH --time 01:00:00
+#SBATCH -A mnh # put here your account/projet name
+
+set -x
+# On va lancer la compilation dans le répertoire de lancement du job
+pwd
+
+. ../conf/profile_mesonh-LXcray-R8I4-MNH-V5-6-1-MPICRAY-O2
+
+time make -j 32
+time make -j 1 installmaster
+
diff --git a/src/job_make_mesonh_HPE_jeanzay b/src/job_make_mesonh_HPE_jeanzay
index 1cd771cee0c6d77d1f32e0fb510bbbc3b8f525cc..76fe333e1e8581204ab1a7b38595bd24919a1f17 100755
--- a/src/job_make_mesonh_HPE_jeanzay
+++ b/src/job_make_mesonh_HPE_jeanzay
@@ -14,7 +14,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
pwd
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-MPIINTEL-O2
time gmake -j 16
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_IBM_ada b/src/job_make_mesonh_IBM_ada
index 144f618b3d5f79e850888e472afee3cddab0505e..a5cdc87fb08b5715ddf1781a3c7f2278a0c14737 100755
--- a/src/job_make_mesonh_IBM_ada
+++ b/src/job_make_mesonh_IBM_ada
@@ -16,7 +16,7 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-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 2bd3854831e73b8ff722d3dffe559dd00ac734c1..a2aa69838080a721aaf6254af7eaed8ad3744245 100755
--- a/src/job_make_mesonh_IBM_sp6_vargas
+++ b/src/job_make_mesonh_IBM_sp6_vargas
@@ -24,7 +24,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-0-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-1-MPIAUTO-O2
time gmake -r -j8
time gmake installmaster
diff --git a/src/job_make_mesonh_MFSX8 b/src/job_make_mesonh_MFSX8
index 85eab09b190a12d377b795751240cae0ed0f7efc..75c2ab68eac63f863b30976f33bcd158f625a1b7 100644
--- a/src/job_make_mesonh_MFSX8
+++ b/src/job_make_mesonh_MFSX8
@@ -12,7 +12,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
[ ${PBS_O_WORKDIR} ] && cd ${PBS_O_WORKDIR}
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-0-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-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 87f2c7c9c22a8f35272149f6d8b66f43545cb711..9d67f48fb08d41071ed409fd1e459dc2e4449ee4 100755
--- a/src/job_make_mesonh_NEC_SX8
+++ b/src/job_make_mesonh_NEC_SX8
@@ -11,7 +11,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
[ $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-0-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-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 c91a6b14a9db88a668626406dc38c8a2fd32952b..3ef0e1c19413717964d748be693108ccd371385d 100755
--- a/src/job_make_mesonh_cxa
+++ b/src/job_make_mesonh_cxa
@@ -27,7 +27,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-0-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-6-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 6aa79f5ab723643878f1ef8207c2c201a8630cba..39186a408ef7b18f51ecfbb3b64dafda0f58f5fb 100755
--- a/src/job_make_mesonh_user_BullX
+++ b/src/job_make_mesonh_user_BullX
@@ -19,7 +19,7 @@ export VER_USER= ########## Your own USER Directory
set -x
# On va lancer la compilation dans le répertoire de lancement du job
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-${VER_USER}-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-${VER_USER}-MPIINTEL-O3
time gmake user
time gmake -j 1 installuser
diff --git a/src/job_make_mesonh_user_BullX_belenos b/src/job_make_mesonh_user_BullX_belenos
index 84111f57fc88f83d8d4c969d3918c74945dd8652..5f0622b2d6f640c3594e4e6d86cbacf9680b8095 100755
--- a/src/job_make_mesonh_user_BullX_belenos
+++ b/src/job_make_mesonh_user_BullX_belenos
@@ -18,7 +18,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
pwd
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-0-${VER_USER}-MPIAUTO-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-1-${VER_USER}-MPIAUTO-O3
time make user -j 2
time make -j 1 installuser
diff --git a/src/job_make_mesonh_user_MFSX8 b/src/job_make_mesonh_user_MFSX8
index b0eb8894b0ec3b3a910c5a6d4a364e53c9fed395..1caf983e77cadfaa64e45f0119d8b89a94edd0df 100644
--- a/src/job_make_mesonh_user_MFSX8
+++ b/src/job_make_mesonh_user_MFSX8
@@ -14,7 +14,7 @@ set -x
[ ${PBS_O_WORKDIR} ] && cd ${PBS_O_WORKDIR}
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-0-${VER_USER}-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-6-1-${VER_USER}-MPIAUTO-O4
time gmake user
time gmake -j 1 installuser