write_surf_mnh.f90

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

IMPLICIT NONE

CONTAINS

SUBROUTINE PREPARE_METADATA_WRITE_SURF(HREC,HDIR,HCOMMENT,KGRID,KTYPE,KDIMS,HSUBR,TPFIELD)
!
use modd_field,      only: tfieldmetadata, tfieldlist, NMNHDIM_UNUSED
use modd_parameters, only: NMNHNAMELGTMAX

use mode_field,      only: Find_field_id_from_mnhname
USE MODE_MSG
!
CHARACTER(LEN=MNH_LEN_HREC),INTENT(IN)  :: HREC     ! name of the article to write
CHARACTER(LEN=2),       INTENT(IN)  :: HDIR     ! Expected type of the data field (XX,XY,--...)
CHARACTER(LEN=100),     INTENT(IN)  :: HCOMMENT ! Comment string
INTEGER,                INTENT(IN)  :: KGRID    ! Localization on the model grid
INTEGER,                INTENT(IN)  :: KTYPE    ! Datatype
INTEGER,                INTENT(IN)  :: KDIMS    ! Number of dimensions
CHARACTER(LEN=*),       INTENT(IN)  :: HSUBR    ! name of the subroutine calling
TYPE(TFIELDMETADATA),   INTENT(OUT) :: TPFIELD  ! metadata of field
!
CHARACTER(LEN=32) :: YTXT
INTEGER           :: IDX,IID, IRESP
LOGICAL           :: GWARN
!
IF ( LEN_TRIM( HREC ) > NMNHNAMELGTMAX ) &
  CALL PRINT_MSG( NVERB_WARNING, 'IO', TRIM(HSUBR), 'HREC is too long (' // TRIM(HREC) // ')' )

CALL FIND_FIELD_ID_FROM_MNHNAME(TRIM(HREC),IID,IRESP,ONOWARNING=.TRUE.)
IF (IRESP==0) THEN
  TPFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
  !Modify and check CLONGNAME
  IF (TRIM(TPFIELD%CLONGNAME)/=TRIM(HREC)) THEN
    CALL PRINT_MSG(NVERB_WARNING,'IO',TRIM(HSUBR),'CLONGNAME different ('//TRIM(TPFIELD%CLONGNAME) &
                   //'/'//TRIM(HREC)//') than expected for article '//TRIM(HREC))
    TPFIELD%CLONGNAME = TRIM(HREC)
  END IF
  !Modify and check CDIR
  IF (TPFIELD%CDIR/=HDIR) THEN
    CALL PRINT_MSG(NVERB_WARNING,'IO',TRIM(HSUBR),'CDIR different ('//TRIM(TPFIELD%CDIR) &
                   //'/'//TRIM(HDIR)//') than expected for article '//TRIM(HREC))
    TPFIELD%CDIR = HDIR
  END IF
  !Modify and check CCOMMENT
  IF (LEN_TRIM(HCOMMENT)/=0) THEN
    IF (TRIM(TPFIELD%CCOMMENT)/=TRIM(HCOMMENT)) THEN
      !Usually in SURFEX fields, units are given at the end of the comment and between parenthesis
      !Neglect that part of the comment for comparison
      IDX = INDEX(HCOMMENT,'(',BACK=.TRUE.)
      IF (IDX/=0) THEN
        IF (TRIM(TPFIELD%CCOMMENT)/=TRIM(HCOMMENT(1:IDX-1))) THEN
          GWARN = .TRUE.
        ELSE
          GWARN = .FALSE.
        END IF
      ELSE
        GWARN = .TRUE.
      END IF
      IF (GWARN) THEN
        CALL PRINT_MSG(NVERB_INFO,'IO',TRIM(HSUBR),'CCOMMENT different ('//TRIM(TPFIELD%CCOMMENT) &
                       //'/'//TRIM(HCOMMENT)//') than expected for article '//TRIM(HREC))
        TPFIELD%CCOMMENT = TRIM(HCOMMENT)
      END IF
    END IF
  ELSE
    CALL PRINT_MSG(NVERB_DEBUG,'IO',TRIM(HSUBR),'CCOMMENT was empty -> replaced by TPFIELD%CCOMMENT for article ' &
                   //TRIM(HREC))
  END IF
  !Modify and check NGRID
  IF (TPFIELD%NGRID/=KGRID) THEN
    WRITE(YTXT,'( I0,"/",I0 )') TPFIELD%NGRID,KGRID
    CALL PRINT_MSG(NVERB_WARNING,'IO',TRIM(HSUBR),'NGRID different ('//TRIM(YTXT) &
                    //') than expected for article '//TRIM(HREC))
    TPFIELD%NGRID = KGRID
  END IF
  !Modify and check NTYPE
  IF (TPFIELD%NTYPE/=KTYPE) THEN
    WRITE(YTXT,'( I0,"/",I0 )') TPFIELD%NTYPE,KTYPE
    CALL PRINT_MSG(NVERB_WARNING,'IO',TRIM(HSUBR),'NTYPE different ('//TRIM(YTXT) &
                    //') than expected for article '//TRIM(HREC))
    TPFIELD%NTYPE = KTYPE
  END IF
  !Modify and check NDIMS
  !
  IF(TPFIELD%CMNHNAME=='EMIS' .AND. TPFIELD%NDIMS/=2) THEN
    !Special (temporary) treatment for EMIS
    CALL PRINT_MSG(NVERB_INFO,'IO',TRIM(HSUBR),'NDIMS forced to 2 for EMIS')
    TPFIELD%NDIMS = 2
    TPFIELD%NDIMLIST(3)  = TPFIELD%NDIMLIST(4) ! Necessary if LTIMEDEP=.TRUE.
    TPFIELD%NDIMLIST(4:) = NMNHDIM_UNUSED
  END IF
  !
  IF (TPFIELD%NDIMS/=KDIMS) THEN
    WRITE(YTXT,'( I0,"/",I0 )') TPFIELD%NDIMS,KDIMS
    CALL PRINT_MSG(NVERB_WARNING,'IO',TRIM(HSUBR),'NDIMS different ('//TRIM(YTXT) &
                    //') than expected for article '//TRIM(HREC))
    TPFIELD%NDIMS = KDIMS
  END IF
ELSE
  CALL PRINT_MSG(NVERB_DEBUG,'IO',TRIM(HSUBR),TRIM(HREC)//' not found in FIELDLIST. Generating default metadata')
  TPFIELD = TFIELDMETADATA(      &
    CMNHNAME   = TRIM(HREC),     &
    CSTDNAME   = '',             &
    CLONGNAME  = TRIM(HREC),     &
    CUNITS     = '',             &
    CDIR       = HDIR,           &
    CCOMMENT   = TRIM(HCOMMENT), &
    NGRID      = KGRID,          &
    NTYPE      = KTYPE,          &
    NDIMS      = KDIMS,          &
    LTIMEDEP   = .FALSE.         )
#if 0
  IF (TPFIELD%NDIMS==0 .OR. TPFIELD%NTYPE==TYPECHAR .OR. TPFIELD%NTYPE==TYPEDATE .OR. TPFIELD%NTYPE==TYPELOG) THEN
    TPFIELD%LTIMEDEP   = .FALSE.
  ELSE
    TPFIELD%LTIMEDEP   = .TRUE.
  END IF
#endif
END IF
!
END SUBROUTINE PREPARE_METADATA_WRITE_SURF

END MODULE MODE_WRITE_SURF_MNH_TOOLS


!     #############################################################
      SUBROUTINE WRITE_SURFX0_MNH(HREC,PFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *WRITEX0* - routine to write a real scalar
!!
!!    PURPOSE
!!    -------
!
!       The purpose of WRITEX0 is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!!        06/08 P. Peyrille, V. Masson : change test for writing 
!!                                       YY, XY, DX, DY in 1D or 2D configuration
!!        03/09, G.Tanguy              : add write_surft1_mnh
!!                                       replace ZUNDEF(surfex) by XUNDEF(MNH)
!!        08/2015 M.Moge    write the COVERS as 2D fields because SURFEX cannot write/read 3D fields 
!!                          with Z-splitting using NB_PROC_IO_W / NB_PROC_IO_W
!!        J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!!  Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODD_CONF,           ONLY: CPROGRAM
USE MODD_CONF_n,         ONLY: CSTORAGE_TYPE
use modd_field,          only: tfieldmetadata, TYPEREAL
USE MODD_GRID
USE MODD_IO,             ONLY: TFILE_SURFEX

use MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
USE MODE_WRITE_SURF_MNH_TOOLS

IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=MNH_LEN_HREC),INTENT(IN)  :: HREC     ! name of the article to write
REAL,                   INTENT(IN)  :: PFIELD   ! the real scalar to write
INTEGER,                INTENT(OUT) :: KRESP    ! return-code if a problem appears
CHARACTER(LEN=100),     INTENT(IN)  :: HCOMMENT ! Comment string
!