write_diachro.f90

!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
module mode_write_diachro

implicit none

private

public :: Write_diachro

contains

! #########################################################################
subroutine Write_diachro( tpdiafile, tpfields, hgroup, htype,             &
                          tpdates, pvar,                                  &
                          oicp, ojcp, okcp, kil, kih, kjl, kjh, kkl, kkh, &
                          ptrajx, ptrajy, ptrajz, osplit )
! #########################################################################
!
!!****  *WRITE_DIACHRO* - Ecriture d'un enregistrement dans un fichier
!!                        diachronique (de nom de base HGROUP)
!!
!!    PURPOSE
!!    -------
!
!
!!**  METHOD
!!    ------
!!      En fait pour un groupe donne HGROUP, on ecrit systematiquement
!       plusieurs enregistrements :
!       - 1: HGROUP.TYPE          (type d'informations a enregistrer)
!       - 2: HGROUP.DIM           (dimensions de toutes les matrices a
!                                  enregistrer)
!       - 3: HGROUP.TITRE         (Nom des processus)
!       - 4: HGROUP.UNITE         (Unites pour chaque processus)
!       - 5: HGROUP.COMMENT       (Champ commentaire pour chaque processus)
!       - 6: HGROUP.TRAJT         (Temps)
!       - 7: HGROUP.PROCx         (Champ traite . 1 enr./ 1 processus)
!       - 8: HGROUP.DATIM         (Les differentes dates du modele)
!       et pour certains types d'informations on enregistre egalement
!       des coordonnees (HGROUP.TRAJX, HGROUP.TRAJY, HGROUP.TRAJZ)
!!
!!    EXTERNAL
!!    --------
!!      None
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      J. Duron    * Laboratoire d'Aerologie *
!!
!!
!!    MODIFICATIONS
!!    -------------
!!      Original       08/01/96
!!      Updated   PM
!!      Modification (N. Asencio) 18/06/99  : the two first dimensions of PMASK
!!                   are linked to the horizontal grid, FMWRIT is called with 'XY' argument.
!!                   In standard configuration of the budgets, the mask is written once
!!                   outside this routine with FMWRIT call. Its record name is 'MASK_nnnn.MASK'
!!                   So optional PMASK is not used .
!!      Modification (J. Duron)   24/06/99  : add logical GPACK to disable the pack option,
!!                                            add the initialization of the dimensions of
!!                                          MASK array in MASK case with write outside the
!!                                          routine.
!!      J.Escobar       02/10/2015 modif for JPHEXT(JPVEXT) variable
!!      D.Gazen+ G.Delautier 06/2016 modif for ncl files
!!      P. Wautelet     09/06/2017: name of the variable added to the name of the written field
!!                                  and better comment (true comment + units)
!!  Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!  P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
!  P. Wautelet 13/09/2019: remove never used PMASK optional dummy-argument
!  P. Wautelet 28/08/2020: remove TPLUOUTDIA dummy argument
!  P. Wautelet 09/10/2020: use new data type tpfields
!  P. Wautelet 08/12/2020: budgets: merge budgets terms with different nbutshift in same group variables
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
use modd_conf,           only: lpack
use modd_field,          only: tfield_metadata_base
use modd_io,             only: tfiledata
use modd_type_date,      only: date_time
!
use mode_msg
!
IMPLICIT NONE
!
!*       0.1   Dummy arguments
!              ---------------
TYPE(TFILEDATA),                                     INTENT(IN)           :: TPDIAFILE    ! file to write
class(tfield_metadata_base), dimension(:),           intent(in)           :: tpfields
CHARACTER(LEN=*),                                    INTENT(IN)           :: HGROUP, HTYPE
type(date_time),             dimension(:),           intent(in)           :: tpdates
REAL,                        DIMENSION(:,:,:,:,:,:), INTENT(IN)           :: PVAR
LOGICAL,                                             INTENT(IN), OPTIONAL :: OICP, OJCP, OKCP
INTEGER,                                             INTENT(IN), OPTIONAL :: KIL, KIH
INTEGER,                                             INTENT(IN), OPTIONAL :: KJL, KJH
INTEGER,                                             INTENT(IN), OPTIONAL :: KKL, KKH
REAL,DIMENSION(:,:,:),                               INTENT(IN), OPTIONAL :: PTRAJX
REAL,DIMENSION(:,:,:),                               INTENT(IN), OPTIONAL :: PTRAJY
REAL,DIMENSION(:,:,:),                               INTENT(IN), OPTIONAL :: PTRAJZ
logical,                                             intent(in), optional :: osplit
!
!*       0.1   Local variables
!              ---------------
logical :: gicp, gjcp, gkcp
logical :: gpack
!------------------------------------------------------------------------------

call Print_msg( NVERB_DEBUG, 'BUD', 'Write_diachro', 'called' )

if ( present( oicp ) ) then
  gicp = oicp
else
  gicp = .false.
end if

if ( present( ojcp ) ) then
  gjcp = ojcp
else
  gjcp = .false.
end if

if ( present( okcp ) ) then
  gkcp = okcp
else
  gkcp = .false.
end if

gpack = lpack
lpack = .false.

if ( tpdiafile%cformat == 'LFI' .or. tpdiafile%cformat == 'LFICDF4' ) &
  call Write_diachro_lfi( tpdiafile, tpfields, hgroup, htype, tpdates, pvar, gicp, gjcp, gkcp, kil, kih, kjl, kjh, kkl, kkh, &
                          ptrajx, ptrajy, ptrajz )

#ifdef MNH_IOCDF4
if ( tpdiafile%cformat == 'NETCDF4' .or. tpdiafile%cformat == 'LFICDF4' ) &
  call Write_diachro_nc4( tpdiafile, tpfields, hgroup, htype, tpdates, pvar, gicp, gjcp, gkcp, kil, kih, kjl, kjh, kkl, kkh, &
                          osplit )
#endif

lpack = gpack

end subroutine Write_diachro

!-----------------------------------------------------------------------------
subroutine Write_diachro_lfi( tpdiafile, tpfields, hgroup, htype, tpdates, pvar, oicp, ojcp, okcp, kil, kih, kjl, kjh, kkl, kkh, &
                              ptrajx, ptrajy, ptrajz )

use modd_budget,         only: nbumask, nbutshift, nbuwrnb
use modd_field,          only: NMNHDIM_ONE, NMNHDIM_UNKNOWN, NMNHDIM_FLYER_TIME, NMNHDIM_NOTLISTED, NMNHDIM_UNUSED, &
                               TYPECHAR, TYPEINT, TYPEREAL,                                                         &
                               tfield_metadata_base, tfielddata
use modd_io,             only: tfiledata
use modd_parameters,     only: jphext
use modd_time,           only: tdtexp, tdtseg
use modd_time_n,         only: tdtmod
use modd_type_date,      only: date_time

use mode_datetime,       only: Datetime_distance
use mode_io_field_write, only: IO_Field_write, IO_Field_write_box
use mode_menu_diachro,   only: Menu_diachro
use mode_msg
use mode_tools_ll,       only: Get_globaldims_ll


type(tfiledata),                                     intent(in)           :: tpdiafile        ! File to write
class(tfield_metadata_base), dimension(:),           intent(in)           :: tpfields
character(len=*),                                    intent(in)           :: hgroup, htype
type(date_time),             dimension(:),           intent(in)           :: tpdates
real,                        dimension(:,:,:,:,:,:), intent(in)           :: pvar
logical,                                             intent(in)           :: oicp, ojcp, okcp
integer,                                             intent(in), optional :: kil, kih
integer,                                             intent(in), optional :: kjl, kjh
integer,                                             intent(in), optional :: kkl, kkh
REAL,DIMENSION(:,:,:),                               INTENT(IN), OPTIONAL :: PTRAJX
REAL,DIMENSION(:,:,:),                               INTENT(IN), OPTIONAL :: PTRAJY
REAL,DIMENSION(:,:,:),                               INTENT(IN), OPTIONAL :: PTRAJZ

integer, parameter :: LFITITLELGT = 100
integer, parameter :: LFIUNITLGT = 100
integer, parameter :: LFICOMMENTLGT = 100

CHARACTER(LEN=20) :: YCOMMENT
CHARACTER(LEN=3)  :: YJ
character(len=:),                           allocatable :: ygroup
character(len=LFITITLELGT),   dimension(:), allocatable :: ytitles   !Used to respect LFI fileformat