write_surf_mnh.f90

      SUBROUTINE WRITE_SURFC0_MNH(HREC,HFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *WRITEC0* - routine to write an integer
!!
!!    PURPOSE
!!    -------
!
!       The purpose of WRITEC0 is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODE_IO_WRITE_FIELD
USE MODE_FIELD,         ONLY: TFIELDDATA,TYPECHAR,TYPELOG
USE MODE_MSG
!
USE MODD_CONF_n,        ONLY: CSTORAGE_TYPE
USE MODD_IO_ll,         ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH,   ONLY: COUT, NLUOUT, NIU_ALL, NJU_ALL
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=LEN_HREC),INTENT(IN)  :: HREC     ! name of the article to write
CHARACTER(LEN=40),      INTENT(IN)  :: HFIELD   ! the string to write
INTEGER,                INTENT(OUT) :: KRESP    ! return-code if a problem appears
CHARACTER(LEN=100),     INTENT(IN)  :: HCOMMENT ! Comment string
!
!*      0.2   Declarations of local variables
!
LOGICAL          :: GCARTESIAN
TYPE(TFIELDDATA) :: TZFIELD
CHARACTER(LEN=5) :: YMSG
!-------------------------------------------------------------------------------
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFC0_MNH','writing '//TRIM(HREC))
!
IF ( (CSTORAGE_TYPE=='PG' .OR. CSTORAGE_TYPE=='SU')  &
     .AND. HREC=='GRID_TYPE       '                  ) THEN
  IF (HFIELD(1:10)=='CONF PROJ ') THEN
    GCARTESIAN = .FALSE.
  ELSE IF (HFIELD(1:10)=='CARTESIAN ') THEN
    GCARTESIAN = .TRUE.
  END IF
!
  TZFIELD%CMNHNAME   = 'CARTESIAN'
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: CARTESIAN'
  TZFIELD%CUNITS     = ''
  TZFIELD%CDIR       = '--'
  TZFIELD%CCOMMENT   = ''
  TZFIELD%NGRID      = 0
  TZFIELD%NTYPE      = TYPELOG
  TZFIELD%NDIMS      = 0
  CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,COUT,KRESP,GCARTESIAN)
!
END IF
!
TZFIELD%CMNHNAME   = TRIM(HREC)
TZFIELD%CSTDNAME   = ''
TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(HREC)
TZFIELD%CUNITS     = ''
TZFIELD%CDIR       = '--'
TZFIELD%CCOMMENT   = TRIM(HCOMMENT)
TZFIELD%NGRID      = 0
TZFIELD%NTYPE      = TYPECHAR
TZFIELD%NDIMS      = 0
CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,COUT,KRESP,HFIELD)
!
IF (KRESP /=0) THEN
  WRITE ( YMSG, '( I5 )' ) KRESP
  CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFC0_MNH','error when writing article '//TRIM(HREC)//' KRESP='//YMSG)
END IF
!-------------------------------------------------------------------------------
END SUBROUTINE WRITE_SURFC0_MNH
!
!     #############################################################
      SUBROUTINE WRITE_SURFL1_MNH(HREC,KL,OFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *WRITEL1* - routine to write a logical array
!!
!!    PURPOSE
!!    -------
!
!       The purpose of WRITEL1 is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODE_IO_WRITE_FIELD
USE MODE_FIELD,         ONLY: TFIELDDATA,TYPEINT,TYPELOG
USE MODE_MSG
!
USE MODD_CONF_n,        ONLY: CSTORAGE_TYPE
USE MODD_IO_ll,         ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH,   ONLY: COUT, NLUOUT, NMASK, CMASK, &
                              NIU, NJU, NIB, NJB, NIE, NJE
!
USE MODI_UNPACK_1D_2D
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=LEN_HREC),INTENT(IN)  :: HREC     ! name of the article to write
INTEGER,                INTENT(IN)  :: KL       ! number of points
LOGICAL, DIMENSION(KL), INTENT(IN)  :: OFIELD   ! array containing the data field
INTEGER,                INTENT(OUT) :: KRESP    ! return-code if a problem appears
CHARACTER(LEN=100),     INTENT(IN)  :: HCOMMENT ! Comment string
CHARACTER(LEN=1),       INTENT(IN)  :: HDIR     ! type of field :
!                                               ! 'H' : field with
!                                               !       horizontal spatial dim.
!                                               ! '-' : no horizontal dim.
!
!*      0.2   Declarations of local variables
!
LOGICAL, DIMENSION(:,:), ALLOCATABLE :: GWORK  ! work array written in the file
INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWORK  ! work array written in the file
!
CHARACTER(LEN=5) :: YMSG
TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFL1_MNH','writing '//TRIM(HREC))
!
IF (HDIR=='-') THEN
  IF( (CMASK /= 'FULL  ').AND. (HREC=='COVER') ) THEN
    CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFL1_MNH',TRIM(HREC)//' with mask '// &
                   TRIM(CMASK)//' not written in file by externalized surface')
    RETURN
  ELSE
    TZFIELD%CMNHNAME   = TRIM(HREC)
    TZFIELD%CSTDNAME   = ''
    TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(HREC)
    TZFIELD%CUNITS     = ''
    TZFIELD%CDIR       = '--'
    TZFIELD%CCOMMENT   = TRIM(HCOMMENT)
    TZFIELD%NGRID      = 0
    TZFIELD%NTYPE      = TYPELOG
    TZFIELD%NDIMS      = 1
    CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,COUT,KRESP,OFIELD(:))
  END IF
!
ELSE IF (HDIR=='H') THEN
!
  ALLOCATE(GWORK(NIU,NJU))
  GWORK(:,:) = .FALSE.
!
  CALL UNPACK_1D_2D(NMASK,OFIELD,GWORK(NIB:NIE,NJB:NJE))
!
  ALLOCATE(IWORK(NIU,NJU))
  IWORK = 0
  WHERE(GWORK) IWORK = 1
!
  TZFIELD%CMNHNAME   = TRIM(HREC)
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(HREC)
  TZFIELD%CUNITS     = ''
  TZFIELD%CDIR       = 'XY'
  TZFIELD%CCOMMENT   = TRIM(HCOMMENT)
  TZFIELD%NGRID      = 4
  TZFIELD%NTYPE      = TYPEINT
  TZFIELD%NDIMS      = 2
  CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,COUT,KRESP,IWORK(:,:))
  !
  DEALLOCATE(IWORK)
  DEALLOCATE(GWORK)
!
END IF
!
IF (KRESP /=0) THEN
  WRITE ( YMSG, '( I5 )' ) KRESP
  CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFL1_MNH','error when writing article '//TRIM(HREC)//' KRESP='//YMSG)
END IF
!-------------------------------------------------------------------------------
END SUBROUTINE WRITE_SURFL1_MNH
!
!
!     #############################################################
      SUBROUTINE WRITE_SURFL0_MNH(HREC,OFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *WRITEL1* - routine to write a logical
!!
!!    PURPOSE
!!    -------
!
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODE_IO_WRITE_FIELD
USE MODE_FIELD,         ONLY: TFIELDDATA,TYPELOG
USE MODE_MSG
!
USE MODD_CONF_n,        ONLY: CSTORAGE_TYPE
USE MODD_IO_ll,         ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH,   ONLY: COUT, NLUOUT, CMASK
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=LEN_HREC),INTENT(IN)  :: HREC     ! name of the article to write
LOGICAL,                INTENT(IN)  :: OFIELD   ! array containing the data field
INTEGER,                INTENT(OUT) :: KRESP    ! return-code if a problem appears
CHARACTER(LEN=100),     INTENT(IN)  :: HCOMMENT ! Comment string
!
!*      0.2   Declarations of local variables
!
CHARACTER(LEN=5) :: YMSG
TYPE(TFIELDDATA) :: TZFIELD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFL0_MNH','writing '//TRIM(HREC))
!
IF( (CMASK /= 'FULL  ').AND. (HREC=='COVER') ) THEN
  CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFL0_MNH',TRIM(HREC)//' with mask '// &
                 TRIM(CMASK)//' not written in file by externalized surface')
  RETURN
ELSE
  TZFIELD%CMNHNAME   = TRIM(HREC)
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(HREC)
  TZFIELD%CUNITS     = ''
  TZFIELD%CDIR       = '--'
  TZFIELD%CCOMMENT   = TRIM(HCOMMENT)
  TZFIELD%NGRID      = 0
  TZFIELD%NTYPE      = TYPELOG
  TZFIELD%NDIMS      = 0
  CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,COUT,KRESP,OFIELD)
END IF
!
IF (KRESP /=0) THEN
  WRITE ( YMSG, '( I5 )' ) KRESP
  CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFL0_MNH','error when writing article '//TRIM(HREC)//' KRESP='//YMSG)
END IF
!-------------------------------------------------------------------------------
END SUBROUTINE WRITE_SURFL0_MNH
!
!     #############################################################
      SUBROUTINE WRITE_SURFT0_MNH(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *WRITET0* - routine to write a MESO-NH date_time scalar
!!
!!    PURPOSE
!!    -------
!
!       The purpose of WRITET0 is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      V. MASSON      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     18/08/97
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODE_FIELD,       ONLY: TFIELDDATA, TYPEDATE
USE MODE_FM
USE MODE_FMWRIT
USE MODE_MSG
!
USE MODD_CONF_n,      ONLY : CSTORAGE_TYPE
USE MODD_IO_ll,         ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH, ONLY : COUT, COUTFILE, NLUOUT
USE MODD_TYPE_DATE
!
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=LEN_HREC),  INTENT(IN)  :: HREC     ! name of the article to be written
INTEGER,            INTENT(IN)  :: KYEAR    ! year
INTEGER,            INTENT(IN)  :: KMONTH   ! month
INTEGER,            INTENT(IN)  :: KDAY     ! day
REAL,               INTENT(IN)  :: PTIME    ! time
INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
CHARACTER(LEN=100), INTENT(IN)  :: HCOMMENT ! Comment string

!*      0.2   Declarations of local variables
!
!
CHARACTER(LEN=LEN_HREC)      :: YRECFM    ! Name of the article to be written
INTEGER, DIMENSION(3)  :: ITDATE
CHARACTER(LEN=5) :: YMSG
TYPE (DATE_TIME) :: TZDATA
TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFT0_MNH','writing '//TRIM(HREC))
!
IF( HREC=='DTCUR' .AND. CSTORAGE_TYPE/='SU' ) THEN
  CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFT0_MNH',TRIM(HREC)//' not written in file by externalized surface')
  RETURN
ELSE
  TZDATA%TDATE = DATE(KYEAR,KMONTH,KDAY)
  TZDATA%TIME  = PTIME
  !  
  TZFIELD%CMNHNAME   = TRIM(HREC)
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(HREC)
  TZFIELD%CUNITS     = ''
  TZFIELD%CDIR       = '--'
  TZFIELD%CCOMMENT   = TRIM(HCOMMENT)
  TZFIELD%NGRID      = 0
  TZFIELD%NTYPE      = TYPEDATE
  TZFIELD%NDIMS      = 0
  !
  CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,COUT,KRESP,TZDATA)
END IF
!
IF (KRESP /=0) THEN
  WRITE ( YMSG, '( I5 )' ) KRESP
  CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFT0_MNH','error when writing article '//TRIM(HREC)//' KRESP='//YMSG)
END IF
!
END SUBROUTINE WRITE_SURFT0_MNH
!
!     #############################################################
      SUBROUTINE WRITE_SURFT1_MNH(HREC,KL1,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  * - routine to write a date vector
!!
!!    PURPOSE
!!    -------
!
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      G.TANGUY      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     03/03/09
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODE_FM
USE MODE_FMWRIT
USE MODE_MSG
!
USE MODD_IO_SURF_MNH,        ONLY : COUT, COUTFILE, NLUOUT
USE MODD_CONF_n,               ONLY : CSTORAGE_TYPE
!
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=LEN_HREC),  INTENT(IN) :: HREC     ! name of the article to be written
INTEGER,            INTENT(IN) :: KL1       ! number of points
INTEGER, DIMENSION(KL1), INTENT(IN)  :: KYEAR    ! year
INTEGER, DIMENSION(KL1), INTENT(IN)  :: KMONTH   ! month
INTEGER, DIMENSION(KL1), INTENT(IN)  :: KDAY     ! day
REAL,    DIMENSION(KL1), INTENT(IN)  :: PTIME    ! time
INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
CHARACTER(LEN=100), INTENT(IN)  :: HCOMMENT ! Comment string

!*      0.2   Declarations of local variables
!
!
CHARACTER(LEN=LEN_HREC)      :: YRECFM    ! Name of the article to be written
INTEGER, DIMENSION(3,KL1)  :: ITDATE
CHARACTER(LEN=5) :: YMSG
!-------------------------------------------------------------------------------
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFT1_MNH','writing '//TRIM(HREC))
!
IF( HREC=='DTCUR' .AND. CSTORAGE_TYPE/='SU' ) THEN
  CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFT1_MNH',TRIM(HREC)//' not written in file by externalized surface')
  RETURN
ELSE
!
  YRECFM=TRIM(HREC)//'%TDATE'
!
  ITDATE(1,:) = KYEAR  (:)
  ITDATE(2,:) = KMONTH (:)
  ITDATE(3,:) = KDAY   (:)
  CALL FMWRIT(COUTFILE,YRECFM,COUT,'--',ITDATE(:,:),0,LEN(HCOMMENT),HCOMMENT,KRESP)
!
  IF (KRESP /=0) THEN
    WRITE ( YMSG, '( I5 )' ) KRESP
    CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFT1_MNH','error when writing article '//TRIM(HREC)//' KRESP='//YMSG)
  END IF
!
  YRECFM=TRIM(HREC)//'%TIME'
  CALL FMWRIT(COUTFILE,YRECFM,COUT,'--',PTIME(:),0,LEN(HCOMMENT),HCOMMENT,KRESP)
!
  IF (KRESP /=0) THEN
    WRITE ( YMSG, '( I5 )' ) KRESP
    CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFT1_MNH','error when writing article '//TRIM(HREC)//' KRESP='//YMSG)
  END IF
!
END IF
!
END SUBROUTINE WRITE_SURFT1_MNH