write_lfifm1_for_diag_supp.f90

!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.
!-----------------------------------------------------------------
!     ######################################
      MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!     ######################################
INTERFACE
!
   SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP(TPFILE)
!
USE MODD_IO, ONLY: TFILEDATA
!
!*       0.1   Declarations of arguments
!
TYPE(TFILEDATA),   INTENT(IN) :: TPFILE ! Output file
!
END SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP
!
END INTERFACE
!
END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!
!     ##############################################
      SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP(TPFILE)
!     ##############################################
!
!!****  *WRITE_LFIFM1_FOR_DIAG_SUPP* - write records in the diag file
!!
!!    PURPOSE
!!    -------
!        The purpose of this routine is to write in the file
!     of name YFMFILE//'.lfi' with the FM routines.  
!
!!**  METHOD
!!    ------
!!      The data are written in the LFIFM file :
!!        - diagnostics from the convection
!!        - diagnostics from the radiatif transfer code
!!
!!      The localization on the model grid is also indicated :
!!        IGRID = 1 for mass grid point
!!        IGRID = 2 for U grid point
!!        IGRID = 3 for V grid point
!!        IGRID = 4 for w grid point
!!        IGRID = 0 for meaningless case
!!
!!    EXTERNAL
!!    --------
!!      FMWRIT : FM-routine to write a record
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!  	J. Stein   *Meteo France* 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    13/09/00
!!      N. Asencio  15/09/00 computation of temperature and height of clouds is moved
!!                           here and deleted in WRITE_LFIFM1_FOR_DIAG routine
!!      I. Mallet   02/11/00 add the call to RADTR_SATEL
!!      J.-P. Chaboureau 11/12/03 add call the CALL_RTTOV (table NRTTOVINFO to
!!              choose the platform, the satellite, the sensor for all channels 
!!              (see the table in rttov science and validation report) and the
!!              type of calculations in the namelist: 0 = tb, 1 = tb + jacobian,
!!              2 = tb + adjoint, 3 = tb + jacobian + adjoint) --- !!! removed !!!
!!      V. Masson   01/2004  removes surface (externalization)
!!      October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!!                                              change of YCOMMENT
!!      October 2011 (C.Lac) FF10MAX  : interpolation of 10m wind
!!        between 2 Meso-NH levels if 10m is above the first atmospheric level
!!      2015 : D.Ricard add UM10/VM10 for LCARTESIAN=T cases
!!      J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 
!!      P.Tulet : Diag for salt and orilam
!!      J.-P. Chaboureau 07/03/2016 fix the dimensions of local arrays
!!      P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
!!      J.-P. Chaboureau 31/10/2016 add the call to RTTOV11 --- !!! removed !!!
!!      F. Brosse 10/2016 add chemical production destruction terms outputs
!!      M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
!!      J.-P. Chaboureau 01/2018 add altitude interpolation
!!      J.-P. Chaboureau 01/2018 add coarse graining
!!  Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!!      J.-P. Chaboureau 07/2018 bug fix on XEMIS when calling CALL_RTTOVxx
!!      J.-P. Chaboureau 09/04/2021 add the call to RTTOV13
!  P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
!!      D. Ricard & Q.Rodier 08/2023 add some diagnostics on pressure levels 
!!     (temperature, relative and specific humidity, vertical velocity, TKE)
!!      D. Ricard 08/2023 add a diagnostic: maximum of cloud fraction on vertical levels
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CH_AEROSOL,        ONLY: LORILAM
USE MODD_CH_BUDGET_n,       ONLY: CNAMES_BUDGET, NEQ_BUDGET, XTCHEM
USE MODD_CH_FLX_n,          ONLY: XCHFLX
USE MODD_CH_PRODLOSSTOT_n,  ONLY: CNAMES_PRODLOSST, NEQ_PLT, XLOSS, XPROD
USE MODD_CST,               ONLY: XCPD, XP00, XRD, XTT, XMV, XMD, XALPI, XGAMI, XBETAI
USE MODD_CURVCOR_n,         ONLY: XCORIOZ
USE MODD_DIAG_IN_RUN,       ONLY: XCURRENT_ZON10M, XCURRENT_MER10M,           &
                                  XCURRENT_SFCO2, XCURRENT_SWD, XCURRENT_LWD, &
                                  XCURRENT_SWU, XCURRENT_LWU
USE MODD_DUST,              ONLY: LDUST
use modd_field,             only: NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED, NMNHDIM_UNUSED, &
                                  tfieldmetadata, tfieldlist, TYPEINT, TYPEREAL
use modd_field
USE MODD_IO,                ONLY: TFILEDATA
USE MODD_CONF,              ONLY: LCARTESIAN
USE MODD_CONF_n,            ONLY: LUSERC, LUSERI, LUSERV, NRR
USE MODD_DEEP_CONVECTION_n, ONLY: NCLBASCONV, NCLTOPCONV, XCAPE, XDMFCONV, XDRCCONV, XDRICONV, XDRVCONV, &
                                  XDTHCONV, XDSVCONV, XMFCONV, XPRLFLXCONV, XPRSFLXCONV, XUMFCONV
USE MODD_DIAG_FLAG,         ONLY: LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL, LISOPR, LISOTH, LRAD_SUBG_COND, &
                                  NCONV_KF, NDXCOARSE, NRAD_3D, NRTTOVINFO, XISOAL, XISOPR, XISOTH
USE MODD_FIELD_n,           ONLY: XCLDFR, XICEFR, XPABST, XSIGS, XTHT, XTKET, XRT, XUT, XVT, XWT
USE MODD_GRID_n,            ONLY: XZHAT, XZZ
USE MODD_METRICS_n,         ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
USE MODD_NEB_n,             ONLY: LSIGMAS, LSUBG_COND, VSIGQSAT
USE MODD_NSV,               ONLY: NSV, NSV_CHEMBEG, NSV_CHEMEND, TSVLIST
USE MODD_PARAMETERS,        ONLY: JPVEXT, NUNDEF, XUNDEF
USE MODD_PARAM_KAFR_n,      ONLY: LCHTRANS
USE MODD_PARAM_n,           ONLY: CRAD, CSURF, CCLOUD
USE MODD_PARAM_RAD_n,       only: NRAD_COLNBR
USE MODD_RADIATIONS_N,      ONLY: NCLEARCOL_TM1, NDLON, NFLEV, NSTATM,                                  &
                                  XAER, XAZIM, XCCO2, XDIR_ALB, XDIRFLASWD, XDIRSRFSWD, XDTHRAD, XEMIS, &
                                  XFLALWD, XSCA_ALB, XSCAFLASWD, XSTATM, XTSRAD, XZENITH
USE MODD_RAD_TRANSF,        ONLY: JPGEOST
USE MODD_REF_n,             ONLY: XRHODREF
USE MODD_SALT,              ONLY: LSALT
USE MODD_TIME_n,            ONLY: TDTCUR

use mode_field,             only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_WRITE,    only: IO_Field_write
USE MODE_MSG
USE MODE_NEIGHBORAVG,       ONLY: BLOCKAVG, MOVINGAVG
USE MODE_THERMO,            ONLY: SM_FOES
USE MODE_TOOLS_LL,          ONLY: GET_INDICE_ll

#ifdef MNH_RTTOV_13
USE MODI_CALL_RTTOV13
#endif
USE MODI_GET_SURF_UNDEF
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_UV
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_PINTER
USE MODI_SHUMAN
USE MODI_UV_TO_ZONAL_AND_MERID
USE MODI_ZINTER

IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!
TYPE(TFILEDATA),   INTENT(IN) :: TPFILE ! Output file
!
!*       0.2   Declarations of local variables
!
INTEGER           :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
INTEGER           :: IKRAD  
! 
INTEGER           :: JI,JJ,JK,JSV,JRR   ! loop index
! 
! variables for Diagnostic variables related to deep convection
REAL,DIMENSION(:,:), ALLOCATABLE              :: ZWORK21,ZWORK22
!
! variables for computation of temperature and height of clouds
REAL :: ZCLMR ! value of mixing ratio tendency  for detection of cloud top
LOGICAL, DIMENSION(:,:), ALLOCATABLE          :: GMASK2 
INTEGER, DIMENSION(:,:), ALLOCATABLE          :: IWORK1, IWORK2
INTEGER, DIMENSION(:,:), ALLOCATABLE          :: ICL_HE_ST
REAL,    DIMENSION(:,:,:), ALLOCATABLE        :: ZWORK31,ZTEMP
!
! variables needed for the transfer radiatif diagnostic code
INTEGER :: ITOTGEO
INTEGER, DIMENSION (JPGEOST) :: INDGEO
CHARACTER(LEN=8), DIMENSION (JPGEOST) :: YNAM_SAT
REAL, DIMENSION(:,:), ALLOCATABLE :: ZIRBT, ZWVBT
REAL  :: ZUNDEF ! undefined value in SURFEX
!
! variables needed for 10m wind                                 
INTEGER :: ILEVEL
!
INTEGER :: IPRES, ITH
CHARACTER(LEN=4) :: YCAR4
CHARACTER(LEN=4), DIMENSION(SIZE(XISOPR)) :: YPRES
CHARACTER(LEN=4), DIMENSION(SIZE(XISOTH)) :: YTH
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK32,ZWORK33,ZWORK34,ZWRES,ZPRES,ZWTH, &
                                       ZRT,ZQV,ZMRVP,ZWRES1,ZTEMPP
REAL, DIMENSION(:), ALLOCATABLE :: ZTH
REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))  :: ZPOVO