diff --git a/A-INSTALL b/A-INSTALL
index 5d1cae4c7e1a0c2ee01ac98bb5fe92a7b1f3c428..62da66fa012facf7878a9b12ba8555ef44dcd6e8 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 : 05/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
@@ -612,12 +612,12 @@ sbatch job_make_examples_BullX_occigen
# - ssh irene-fr : for Intel SkyLake/KNL processors
# On Intel processors the MPI use is OPENMPI/2.0.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
# 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 )
@@ -657,14 +657,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 +763,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 +785,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 +859,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 +882,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 +894,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/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..3f5860da56c6be4bf8b67fbd5b0dd7409779490c 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 )
@@ -2315,16 +2318,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'
diff --git a/src/LIB/SURCOUCHE/src/mode_msg.f90 b/src/LIB/SURCOUCHE/src/mode_msg.f90
index ac78920fae6da2b112c7c296f9a9d30829c4b6e6..5dfbdc2ef71b07d9d8c8c501566c1ddace78c0fc 100644
--- a/src/LIB/SURCOUCHE/src/mode_msg.f90
+++ b/src/LIB/SURCOUCHE/src/mode_msg.f90
@@ -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/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..e0d7e555bd4a4de76e3736cee452d6ccfc04e189 100644
--- a/src/MNH/aircraft_balloon_evol.f90
+++ b/src/MNH/aircraft_balloon_evol.f90
@@ -25,6 +25,7 @@
! -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
@@ -154,6 +155,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 +163,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 +170,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
@@ -237,10 +207,13 @@ SELECT TYPE ( TPFLYER )
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
@@ -316,7 +289,8 @@ SELECT TYPE ( TPFLYER )
IF ( TPFLYER%NMODEL == IMI .AND. &
( .NOT. TPFLYER%LFLY .OR. TPFLYER%LCRASH .OR. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < 1.e-8 ) ) THEN
!Do we have to store balloon data?
- CALL FLYER_CHECK_STORESTEP( TPFLYER )
+ TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
END IF
! In flight
@@ -344,7 +318,7 @@ SELECT TYPE ( TPFLYER )
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
+ TRIM( TPFLYER%CNAME ), 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 +360,22 @@ IMPLICIT NONE
CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
+LOGICAL :: GLOW, GHIGH
+
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 +389,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
@@ -516,10 +483,10 @@ REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
ZTSTEP = PTSTEP
-ZU_BAL = FLYER_INTERP_U(PU)
-ZV_BAL = FLYER_INTERP_V(PV)
+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
@@ -541,7 +508,7 @@ 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
+ TRIM( TPBALLOON%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
@@ -581,8 +548,8 @@ IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
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, &
+ 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. )
@@ -600,13 +567,13 @@ IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
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
+ TRIM( TPBALLOON%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
END IF
ELSE
! Special case not-managed (different dads, change of several models in 1 step (going to grand parent/grand children)...)
! This situation should be very infrequent => reasonable risk, error on the trajectory should be relatively small in most cases
- CMNHMSG(1) = 'unmanaged change of model for ballon ' // TPBALLOON%CTITLE
+ CMNHMSG(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 +596,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 +647,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 +737,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 +763,46 @@ 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)
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)
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
-
-! 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 +816,39 @@ 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 +856,69 @@ 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) )
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(:,:,:) )
+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 +1028,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_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/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 6582c3e5bd70feb92e27dea8652f5cbe27166727..15812b1dba506a55bf7e5bdd9831cd338034df4b 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -621,7 +621,7 @@ XLAT_PROF(:) = XUNDEF
XLON_PROF(:) = XUNDEF
CNAME_PROF(:) = ''
CFILE_PROF = 'NO_INPUT_CSV'
-! LDIAG_SURFRAD = .TRUE.
+LDIAG_SURFRAD_PROF = .TRUE.
!------------------------------------------------------------------------------
!* 10.f SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
! ----------------------------------
@@ -635,7 +635,7 @@ XLAT_STAT(:) = XUNDEF
XLON_STAT(:) = XUNDEF
CNAME_STAT(:) = ''
CFILE_STAT = 'NO_INPUT_CSV'
-LDIAG_SURFRAD = .TRUE.
+LDIAG_SURFRAD_STAT = .TRUE.
!
!-------------------------------------------------------------------------------
!
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..90beb1354dca150ada71e2b156dfdd2a2907ef1d 100644
--- a/src/MNH/ini_aircraft.f90
+++ b/src/MNH/ini_aircraft.f90
@@ -45,7 +45,7 @@ CONTAINS
!!
!! 3) the type of aircraft
!!
-!! 'AIRCRA' for aircraft
+!! 'AIRCRAFT' for aircraft
!!
!! 4) the takeoff date and time
!!
@@ -129,7 +129,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 +202,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..fb6aba612e8967dd2daf11d5ecdff81004720d73 100644
--- a/src/MNH/ini_aircraft_balloon.f90
+++ b/src/MNH/ini_aircraft_balloon.f90
@@ -19,8 +19,6 @@ IMPLICIT NONE
PRIVATE
-PUBLIC :: ALLOCATE_FLYER, DEALLOCATE_FLYER
-
PUBLIC :: INI_AIRCRAFT_BALLOON
CONTAINS
@@ -166,11 +164,11 @@ END IF
!
IF ( IMI == 1 .AND. ISP == NFLYER_DEFAULT_RANK ) THEN
DO JI = 1, NBALLOONS
- CALL ALLOCATE_FLYER( TBALLOONS(JI)%TBALLOON )
+ CALL TBALLOONS(JI)%TBALLOON%DATA_ARRAYS_ALLOCATE()
END DO
DO JI = 1, NAIRCRAFTS
- CALL ALLOCATE_FLYER( TAIRCRAFTS(JI)%TAIRCRAFT )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%DATA_ARRAYS_ALLOCATE()
END DO
END IF
!
@@ -232,9 +230,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 +246,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 +259,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 +272,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 +285,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 +302,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 +384,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 +395,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
@@ -426,7 +424,7 @@ ELSE IF ( CPROGRAM == 'DIAG ' ) THEN
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 )
+ CMNHMSG(1) = 'current location read from MODD_DIAG_FLAG for ' // TRIM( TPFLYER%CNAME )
WRITE( CMNHMSG(2), * ) " Lat=", ZLAT, " Lon=", ZLON," Alt=",TPFLYER%XZ_CUR
CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_LAUNCH' )
END IF
@@ -491,7 +489,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 +499,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..3b60fd7e5509ca79ac61429a68a738c1f1fb99a1 100644
--- a/src/MNH/ini_balloon.f90
+++ b/src/MNH/ini_balloon.f90
@@ -133,7 +133,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_posprofilern.f90 b/src/MNH/ini_posprofilern.f90
index 674dab0d8b87fa1096fce764af6ff069161da646..4ce19c1558c9b1b90c8c30c16ab0631bd4037214 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,7 @@ END IF
LPROFILER = ( INUMBPROF > 0 )
DO JI = 1, NUMBPROFILER_LOC
- CALL PROFILER_ALLOCATE( TPROFILERS(JI), ISTORE )
+ CALL TPROFILERS(JI)%DATA_ARRAYS_ALLOCATE( ISTORE )
END DO
!----------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_surfstationn.f90 b/src/MNH/ini_surfstationn.f90
index c312cf819c8b45e50ab9d98bc5f955d4ab07c064..c1eb1a20dab4975e5cb9021e1154403505ed7996 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,7 @@ END IF
LSTATION = ( INUMBSTAT > 0 )
DO JI = 1, NUMBSTAT_LOC
- CALL STATION_ALLOCATE( TSTATIONS(JI), ISTORE )
+ CALL TSTATIONS(JI)%DATA_ARRAYS_ALLOCATE( ISTORE )
END DO
!----------------------------------------------------------------------------
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..4f71f50fcc3b61fd1118e120068a9e519641605a 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,635 @@ 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, 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
+ 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
+ IF ( CPROGRAM == 'DIAG ' ) THEN
+ ISTORE = INT ( NTIME_AIRCRAFT_BALLOON / TPSENSOR%TFLYER_TIME%XTSTEP ) + 1
+ ELSE
+ ISTORE = NINT ( ( XSEGLEN - DYN_MODEL(1)%XTSTEP ) / TPSENSOR%TFLYER_TIME%XTSTEP ) + 1
+ ENDIF
+ 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_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_sensor.f90 b/src/MNH/modd_sensor.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8d951d4a6aff09b228ebbfdbdac34332fd9ea89e
--- /dev/null
+++ b/src/MNH/modd_sensor.f90
@@ -0,0 +1,1392 @@
+!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
+ 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 :: 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
+
+ IF ( OVERTPROF ) THEN
+ 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%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%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%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 :: GCHANGE ! set to true if at least an index has been forced to change
+ LOGICAL :: GDONE ! set to true if coefficient computation has been done
+ LOGICAL :: GDONOLOWCRASH
+ REAL :: ZZCOEF00, ZZCOEF01, ZZCOEF10, ZZCOEF11
+
+ OLOW = .FALSE.
+ OHIGH = .FALSE.
+
+ GCHANGE = .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
+ GCHANGE = .TRUE.
+ !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
+ IF ( IK00 > IKU-1) THEN
+ IK00 = IKU-1
+ GCHANGE = .TRUE.
+ END IF
+ IF ( IK01 > IKU-1) THEN
+ IK01 = IKU-1
+ GCHANGE = .TRUE.
+ END IF
+ IF ( IK10 > IKU-1) THEN
+ IK10 = IKU-1
+ GCHANGE = .TRUE.
+ END IF
+ IF ( IK11 > IKU-1) THEN
+ IK11 = IKU-1
+ GCHANGE = .TRUE.
+ END IF
+
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'Compute_vertical_interp_coeff', &
+ 'sensor ' // TRIM( TPSENSOR%CNAME ) // ' is too high', OLOCAL = .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
+
+ IF ( SIZE( TPSENSOR%XIWCZ ) > 0 ) THEN
+ 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
+
+ IF ( SIZE( TPSENSOR%XIWCZ ) > 0 ) THEN
+ 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 )
+ ! ##################################################################
+
+ 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
+
+ CHARACTER(LEN=10) :: YFROM, YTO
+ INTEGER :: IPACKSIZE
+ INTEGER :: IPOS
+ 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( OSEND_SIZE_TO_RECEIVER ) ) THEN
+ GSEND_SIZE_TO_RECEIVER = OSEND_SIZE_TO_RECEIVER
+ ELSE
+ GSEND_SIZE_TO_RECEIVER = .FALSE.
+ END IF
+
+ IPACKSIZE = TPSENSOR%BUFFER_SIZE_COMPUTE( TPSENSOR%NSTORE_CUR )
+
+ IF ( GSEND_SIZE_TO_RECEIVER ) CALL TPSENSOR%BUFFER_SIZE_SEND( TPSENSOR%NSTORE_CUR, IPACKSIZE, KTO )
+
+ 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 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 )
+ ! ####################################################################################################
+
+ 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
+
+ CHARACTER(LEN=10) :: YFROM, YTO
+ INTEGER :: IPACKSIZE
+ INTEGER :: IPOS
+ INTEGER :: ISTORE_CUR
+ INTEGER :: ISTORE_MAX
+ 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. )
+
+ 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
+
+ ! 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 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..933235718d0480315b9ac08e85536388238b0e45 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,28 @@ 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 +119,568 @@ 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%XRHOD (IKU, KSTORE) ) ; IVARSIZE = IVARSIZE + IKU
+ 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%XRHOD (:,:) = 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%XRHOD )
+ 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-1) = RESHAPE( TPSENSOR%XRHOD(:,1:ISTORES), [IKU*ISTORES] ) ; KPOS = KPOS + IKU * ISTORES
+ 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%XRHOD(:,1:KSTORE) = RESHAPE( PBUFFER(KPOS:KPOS+IKU*KSTORE-1), [ IKU, KSTORE ] ) ; KPOS = KPOS + IKU * KSTORE
+ 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_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..bd6c86b3b6ee45c674bba2638188b766f3cd947b
--- /dev/null
+++ b/src/MNH/mode_sensor.f90
@@ -0,0 +1,836 @@
+!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.
+
+ 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.
+
+ 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_CH_AEROSOL, ONLY: NCARB, NSOA, NSP
+ 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 b5ab334898edb2435108ee39274f9f58f0bd6ee0..387f6c4ecdd9bfcdf09b4479ca4a56663786628d 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -321,6 +321,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
@@ -397,8 +398,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
@@ -466,7 +466,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
@@ -2271,8 +2270,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/profilern.f90 b/src/MNH/profilern.f90
index 25c907e90e8dd9822a8fd9070b041ad4c6124ccb..f36998381ae2833a9ae0d0969b8245b96dcb324f 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,13 @@ 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,...)
ZTEMP(:,:,:)=PTH(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
! Theta_v
ZTHV(:,:,:) = PTH(:,:,:) / (1.+WATER_SUM(PR(:,:,:,:)))*(1.+PR(:,:,:,1)/ZRDSRV)
@@ -288,12 +236,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 +258,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 +323,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 +363,13 @@ 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 )
+ 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_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/stationn.f90 b/src/MNH/stationn.f90
index a9a08e66a8a54e80fd3ec5f53b7b7f90aee738c3..793d92093ce1ba2c441e4afb34b6223b400c5a1d 100644
--- a/src/MNH/stationn.f90
+++ b/src/MNH/stationn.f90
@@ -85,13 +85,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
@@ -131,66 +131,45 @@ 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))
+ 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 ) 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 ( 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..0678daffcf2abf43cc85ecc6f40e7d99bf116203 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
! ##########################################
@@ -85,8 +79,6 @@ 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
-!
IMPLICIT NONE
!
!
@@ -107,7 +99,7 @@ DO JI = 1, NBALLOONS
! 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 )
+ CALL TBALLOONS(JI)%TBALLOON%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE. )
END IF
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
@@ -116,7 +108,7 @@ 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. )
END IF
! Write data
@@ -133,7 +125,7 @@ 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 )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE. )
END IF
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
@@ -142,7 +134,7 @@ 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. )
END IF
! Write data
@@ -164,8 +156,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 +168,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 )
+ CALL TBALLOONS(JI)%TBALLOON%DATA_ARRAYS_DEALLOCATE()
DEALLOCATE( TBALLOONS(JI)%TBALLOON )
END IF
END DO
@@ -186,7 +176,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 )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%DATA_ARRAYS_DEALLOCATE()
DEALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
END IF
END DO
@@ -202,38 +192,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_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_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 +228,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 +237,36 @@ 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
!
-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 = 9 + 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 +279,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
@@ -342,7 +319,7 @@ IF ( IRR > 1 ) THEN !cloud water is present
DEALLOCATE( ZLWC, ZRHO )
END IF
!
-IF (SIZE(TPFLYER%XTKE)>0) call Add_point( 'Tke', 'Turbulent kinetic energy', 'm2 s-2', tpflyer%xtke(:) )
+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 +330,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 +375,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 +415,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 = 8 + 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(:,:) )
@@ -630,15 +446,19 @@ IF ( CCLOUD == 'LIMA' ) THEN
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 +472,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 +486,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 +531,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..4c0e7d02b4acb61d35441843c96319153e74a333 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
@@ -89,14 +87,14 @@ 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 )
+ CALL TBALLOONS(JI)%TBALLOON%SEND( KTO = TPFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE. )
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. )
END IF
! Write data (only if flyer is on the current model)
@@ -105,7 +103,7 @@ DO JI = 1, NBALLOONS
! 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 )
+ CALL TBALLOONS(JI)%TBALLOON%DATA_ARRAYS_DEALLOCATE()
DEALLOCATE( TBALLOONS(JI)%TBALLOON )
END IF
END IF
@@ -159,7 +157,7 @@ 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 +176,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 +189,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 +202,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 +215,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 +228,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 +250,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 01c1c560e957fed8f28c7445895ae399ea2487da..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
@@ -1886,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 33e3d1c32c52c3d6c1d4cc78880ac2fb18e05be6..d55684efa88ed69971bfd94e404eefa170f95806 100644
--- a/src/MNH/write_lfifm1_for_diag_supp.f90
+++ b/src/MNH/write_lfifm1_for_diag_supp.f90
@@ -441,16 +441,17 @@ IF (LCLD_COV .AND. LUSERC) THEN
ZWORK21(:,:)=0.0
ZWORK21(IIB:IIE,IJB:IJE)=MAXVAL(XCLDFR(IIB:IIE,IJB:IJE,JPVEXT+1:IKE),DIM=3)
- TZFIELD%CMNHNAME = 'CLDFRMAX'
- TZFIELD%CSTDNAME = 'max_cloud_fraction'
- TZFIELD%CLONGNAME = 'CLDFRMAX'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_MAx of CLoud fraction'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 2
- TZFIELD%LTIMEDEP = .TRUE.
+ 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
diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90
index 98e73e04c80ffa866f208ccd3299bf70d8ab2845..3449ccdec4026d66313470a64b71b0550a5e9b10 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) )
@@ -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,31 @@ 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 )
+
+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 +342,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 +382,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..cd1cafb7bfed5b43972d08c7b557bc662cc6b17a 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 = 5 + SIZE(TPSTATION%XR,3) + SIZE(TPSTATION%XSV,3)
IF ( CTURB == 'TKEL' ) IPROC = IPROC + 1
IF (LDIAG_SURFRAD_STAT) THEN
@@ -334,300 +78,76 @@ 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(:) )
+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 +214,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 +257,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/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/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/configure b/src/configure
index d4f5e1d3d93c2d27ac95f29e964c92b0449e773a..ece7ee154d2c13a57d2c68023691d60964540730 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"}
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_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_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