read_surf_mnh.f90

!MNH_LIC Copyright 1994-2014 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.
!     #############################################################
      SUBROUTINE READ_SURFX0_MNH(HREC,PFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READX0* - routine to read a real scalar
!!
!!    PURPOSE
!!    -------
!
!       The purpose of READX0 is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!!      10/10/2011 J.Escobar & G.Tanguy change BUGFIX/MNH to BUG/SURFEX version control
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODD_CONF, ONLY : CPROGRAM
USE MODD_GRID, ONLY: XRPK,XBETA,XLAT0,XLON0
USE MODD_PARAMETERS, ONLY: JPHEXT, XUNDEF
!
USE MODE_FIELD, ONLY : TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME,TYPEREAL
USE MODE_FM
USE MODE_FMREAD
USE MODE_GRIDPROJ
USE MODE_MSG
!
USE MODD_IO_SURF_MNH,        ONLY : COUT, TPINFILE, NLUOUT
!
USE MODI_GET_SURF_UNDEF
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=LEN_HREC),INTENT(IN)  :: HREC     ! name of the article to be read
REAL,                   INTENT(OUT) :: PFIELD   ! the real scalar to be read
INTEGER,                INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
CHARACTER(LEN=100),     INTENT(OUT) :: HCOMMENT ! comment
!
!*      0.2   Declarations of local variables
!
INTEGER           :: IGRID          ! IGRID : grid indicator
INTEGER           :: ILENCH         ! ILENCH : length of comment string

INTEGER           :: IMASDEV
INTEGER           :: IID,IRESP
INTEGER           :: IIMAX,IJMAX
REAL,DIMENSION(:), ALLOCATABLE :: ZXHAT,ZYHAT
REAL              :: ZLATOR,ZLONOR,ZXHATM,ZYHATM,ZLATORI,ZLONORI
REAL              :: ZRPK, ZBETA, ZLAT0, ZLON0
CHARACTER(LEN=100):: YCOMMENT ! comment
TYPE(TFIELDDATA)  :: TZFIELD
!-------------------------------------------------------------------------------
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFX0_MNH',TRIM(TPINFILE%CNAME)//': reading '//TRIM(HREC))
!
IF (HREC=='LONORI' .OR. HREC=='LATORI') THEN
  CALL IO_READ_FIELD(TPINFILE,'MASDEV',IMASDEV)
  IF (IMASDEV<=45) THEN
      ZLATORI = XUNDEF
      ZLONORI = XUNDEF
      !* saves projection parameters of MODD_GRID
      ZLAT0 = XLAT0
      ZLON0 = XLON0
      ZRPK  = XRPK
      ZBETA = XBETA
      !* reads projection and grid data in the file
      CALL IO_READ_FIELD(TPINFILE,'LAT0',XLAT0)
      CALL IO_READ_FIELD(TPINFILE,'LON0',XLON0)
      CALL IO_READ_FIELD(TPINFILE,'RPK', XRPK)
      CALL IO_READ_FIELD(TPINFILE,'BETA',XBETA)
      !
      CALL IO_READ_FIELD(TPINFILE,'IMAX',IIMAX)
      CALL IO_READ_FIELD(TPINFILE,'JMAX',IJMAX)
      ALLOCATE(ZXHAT(IIMAX+2*JPHEXT),ZYHAT(IJMAX+2*JPHEXT))
      CALL IO_READ_FIELD(TPINFILE,'XHAT',ZXHAT)
      CALL IO_READ_FIELD(TPINFILE,'YHAT',ZYHAT)
      !
      CALL FIND_FIELD_ID_FROM_MNHNAME('LONORI',IID,IRESP)
      TZFIELD = TFIELDLIST(IID)
      TZFIELD%CMNHNAME = 'LONOR'
      CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZLONOR)
      !
      CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
      TZFIELD = TFIELDLIST(IID)
      TZFIELD%CMNHNAME = 'LATOR'
      CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZLATOR)
      !
      ZXHATM = - 0.5 * (ZXHAT(1)+ZXHAT(2))
      ZYHATM = - 0.5 * (ZYHAT(1)+ZYHAT(2))
      DEALLOCATE(ZXHAT,ZYHAT)
      !* computes origin
      CALL SM_LATLON(ZLATOR,ZLONOR,ZXHATM,ZYHATM,ZLATORI,ZLONORI)
      IF (HREC=='LONORI') PFIELD = ZLONORI
      IF (HREC=='LATORI') PFIELD = ZLATORI
      !* restores projection parameters in module MODD_GRID
      XLAT0 = ZLAT0
      XLON0 = ZLON0
      XRPK  = ZRPK
      XBETA = ZBETA
      RETURN
  END IF
END IF

!-------------------------------------------------------------------------------

IF ( HREC=='LAT0' .OR. HREC=='LON0' .OR. HREC=='RPK' .OR. HREC=='BETA'  &
                 .OR. HREC=='LATORI'.OR. HREC=='LONORI'                  ) THEN
  CALL IO_READ_FIELD(TPINFILE,HREC,PFIELD,KRESP)
ELSE
  TZFIELD%CMNHNAME   = TRIM(HREC)
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(HREC)
  TZFIELD%CUNITS     = ''
  TZFIELD%CDIR       = '--'
  TZFIELD%CCOMMENT   = '' !Expected comment is not known
  TZFIELD%NGRID      = 0
  TZFIELD%NTYPE      = TYPEREAL
  TZFIELD%NDIMS      = 0
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,PFIELD,KRESP)
END IF

IF (KRESP /=0) THEN
  WRITE(NLUOUT,*) 'WARNING'
  WRITE(NLUOUT,*) '-------'
  WRITE(NLUOUT,*) 'error when reading article ', HREC,'KRESP=',KRESP
  WRITE(NLUOUT,*) 'default value may be used, who knows???'
  WRITE(NLUOUT,*) ' '
ENDIF
!-------------------------------------------------------------------------------
END SUBROUTINE READ_SURFX0_MNH
!
!     #############################################################
      SUBROUTINE READ_SURFX1_MNH(HREC,KL,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READX1* - routine to fill a real 1D array for the externalised surface
!!
!!    PURPOSE
!!    -------
!
!       The purpose of READ_SURFX1 is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODE_FIELD,       ONLY : TFIELDDATA,TYPEREAL
USE MODE_FM
USE MODE_FMREAD
USE MODE_ll
USE MODE_IO_ll
USE MODE_MSG
!
USE MODD_CST,         ONLY : XPI
!
USE MODD_IO_SURF_MNH, ONLY : COUT, CFILE, TPINFILE, NLUOUT,  NMASK, &
                             NIU, NJU, NIB, NJB, NIE, NJE, &
                             NIU_ALL, NJU_ALL, NIB_ALL,    &
                             NJB_ALL, NIE_ALL, NJE_ALL,    &
                             NMASK_ALL
USE MODD_PARAMETERS, ONLY: XUNDEF
!
USE MODI_PACK_2D_1D
!
USE MODI_GET_SURF_UNDEF
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC     ! name of the article to be read
INTEGER,                INTENT(IN) :: KL       !  number of points
REAL, DIMENSION(KL),    INTENT(OUT):: PFIELD   ! array containing the data field
INTEGER,                INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
CHARACTER(LEN=100),     INTENT(OUT):: HCOMMENT ! comment
CHARACTER(LEN=1),       INTENT(IN) :: HDIR     ! type of field :
!                                           ! 'H' for HOR : with hor. dim.; and  distributed.
!                                           ! 'A' for ALL : with hor. dim.; and not distributed.
!                                           ! '-' : no horizontal dim.

!
!*      0.2   Declarations of local variables
!
INTEGER           :: IGRID          ! IGRID : grid indicator
INTEGER           :: ILENCH         ! ILENCH : length of comment string
INTEGER           :: JI, JJ         ! loop counters

REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK  ! work array read in the file
REAL, DIMENSION(:),   ALLOCATABLE :: ZWORK1D! work array read in the file
REAL                              :: ZW     ! work value

INTEGER           :: IMASDEV
CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=2)  :: YSTORAGE_TYPE
!
INTEGER           :: IIU, IJU, IIB, IJB, IIE, IJE ! dimensions of horizontal fields
INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK       ! mask for packing
REAL              :: ZUNDEF         ! undefined value in SURFEX
TYPE(TFIELDDATA)  :: TZFIELD
!-------------------------------------------------------------------------------
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFX1_MNH',TRIM(TPINFILE%CNAME)//': reading '//TRIM(HREC))
!
KRESP = 0
!
IF (HDIR=='A') THEN
  IIU = NIU_ALL
  IJU = NJU_ALL
  IIB = NIB_ALL
  IJB = NJB_ALL
  IIE = NIE_ALL
  IJE = NJE_ALL
  ALLOCATE(IMASK(SIZE(NMASK_ALL)))
  IMASK = NMASK_ALL
ELSE
  IIU = NIU
  IJU = NJU
  IIB = NIB
  IJB = NJB
  IIE = NIE
  IJE = NJE
  ALLOCATE(IMASK(SIZE(NMASK)))
  IMASK = NMASK
END IF
!
!*       2.    On traite d'abord des cas particuliers
!
IF (HREC=='LAT') THEN

  CALL IO_READ_FIELD(TPINFILE,'LAT0',ZW,KRESP)
  PFIELD(:) = ZW

ELSE IF (HREC=='LON') THEN

  CALL IO_READ_FIELD(TPINFILE,'LON0',ZW,KRESP)
  PFIELD(:) = ZW

ELSE IF (HREC=='MESH_SIZE') THEN

  PFIELD(:) = 0.
  HCOMMENT = ' '

ELSE IF (HREC=='XX') THEN
!! reading of a 1D field along X in the file
  ALLOCATE(ZWORK1D(IIU))
  ALLOCATE(ZWORK  (IIU,IJU))
  ZWORK(:,:) = 0.
  TZFIELD%CMNHNAME   = 'XHAT'
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: XHAT'
  TZFIELD%CUNITS     = ''
  TZFIELD%CCOMMENT   = '' !Expected comment is not known
  TZFIELD%NGRID      = 4
  TZFIELD%NTYPE      = TYPEREAL
  TZFIELD%NDIMS      = 1
  IF (HDIR/='A') THEN
    TZFIELD%CDIR       = 'XX'
  ELSE
    TZFIELD%CDIR       = '--'
  END IF
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK1D,KRESP)
  DO JJ = 1,IJU
    ZWORK(IIB:IIE,JJ) = 0.5 * ZWORK1D(IIB:IIE) + 0.5 * ZWORK1D(IIB+1:IIE+1)
  END DO
  CALL PACK_2D_1D(IMASK,ZWORK(IIB:IIE,IJB:IJE),PFIELD)
  DEALLOCATE(ZWORK1D)
  DEALLOCATE(ZWORK  )
ELSE IF (HREC=='DX') THEN
!! reading of a 1D field along X in the file
  ALLOCATE(ZWORK1D(IIU))
  ALLOCATE(ZWORK  (IIU,IJU))
  ZWORK(:,:) = 0.
  TZFIELD%CMNHNAME   = 'XHAT'
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: XHAT'
  TZFIELD%CUNITS     = ''
  TZFIELD%CCOMMENT   = '' !Expected comment is not known
  TZFIELD%NGRID      = 4
  TZFIELD%NTYPE      = TYPEREAL
  TZFIELD%NDIMS      = 1
  IF (HDIR/='A') THEN
    TZFIELD%CDIR       = 'XX'
  ELSE
    TZFIELD%CDIR       = '--'
  END IF
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK1D,KRESP)
  DO JJ = 1,IJU
    ZWORK(IIB:IIE,JJ) = - ZWORK1D(IIB:IIE) + ZWORK1D(IIB+1:IIE+1)
  END DO
  CALL PACK_2D_1D(IMASK,ZWORK(IIB:IIE,IJB:IJE),PFIELD)
  DEALLOCATE(ZWORK1D)
  DEALLOCATE(ZWORK  )
ELSE IF (HREC=='YY') THEN
!! reading of a 1D field along Y in the file
  ALLOCATE(ZWORK1D(IJU))
  ALLOCATE(ZWORK  (IIU,IJU))
  ZWORK(:,:) = 0.
  TZFIELD%CMNHNAME   = 'YHAT'
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: YHAT'
  TZFIELD%CUNITS     = ''
  TZFIELD%CCOMMENT   = '' !Expected comment is not known
  TZFIELD%NGRID      = 4
  TZFIELD%NTYPE      = TYPEREAL
  TZFIELD%NDIMS      = 1
  IF (HDIR/='A') THEN
    TZFIELD%CDIR       = 'YY'
  ELSE
    TZFIELD%CDIR       = '--'
  END IF
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK1D,KRESP)
  DO JI = 1,IIU
    ZWORK(JI,IJB:IJE) = 0.5 * ZWORK1D(IJB:IJE) + 0.5 * ZWORK1D(IJB+1:IJE+1)
  END DO
  CALL PACK_2D_1D(IMASK,ZWORK(IIB:IIE,IJB:IJE),PFIELD)
  DEALLOCATE(ZWORK1D)
  DEALLOCATE(ZWORK  )
ELSE IF (HREC=='DY') THEN
!! reading of a 1D field along Y in the file
  ALLOCATE(ZWORK1D(IJU))
  ALLOCATE(ZWORK  (IIU,IJU))
  ZWORK(:,:) = 0.
  TZFIELD%CMNHNAME   = 'YHAT'
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: YHAT'
  TZFIELD%CUNITS     = ''
  TZFIELD%CCOMMENT   = '' !Expected comment is not known
  TZFIELD%NGRID      = 4
  TZFIELD%NTYPE      = TYPEREAL
  TZFIELD%NDIMS      = 1
  IF (HDIR/='A') THEN
    TZFIELD%CDIR       = 'YY'
  ELSE
    TZFIELD%CDIR       = '--'
  END IF
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK1D,KRESP)
  DO JI = 1,IIU
    ZWORK(JI,IJB:IJE) = - ZWORK1D(IJB:IJE) + ZWORK1D(IJB+1:IJE+1)
  END DO
  CALL PACK_2D_1D(IMASK,ZWORK(IIB:IIE,IJB:IJE),PFIELD)
  DEALLOCATE(ZWORK1D)
  DEALLOCATE(ZWORK  )
!
ELSE
!
!! Reading of a 2D fields, masked and packed into 1D vector
!
  YREC = ' '
  YREC(1:LEN(HREC)) = HREC
  IF (HREC(1:8)=='Q_CANYON') THEN
    CALL IO_READ_FIELD(TPINFILE,'MASDEV',IMASDEV)
    IF (IMASDEV<=45) THEN
      CALL IO_READ_FIELD(TPINFILE,'STORAGE_TYPE',YSTORAGE_TYPE)
      IF (YSTORAGE_TYPE=='TT') THEN
        PFIELD = 0.
        DEALLOCATE(IMASK)
        RETURN
      ELSE
        YREC = 'R_CANYON            '
      END IF
    END IF
  END IF
  IF (HREC(1:8)=='T_CANYON') THEN
    CALL IO_READ_FIELD(TPINFILE,'MASDEV',IMASDEV)
    IF (IMASDEV<=45) THEN
      CALL IO_READ_FIELD(TPINFILE,'STORAGE_TYPE',YSTORAGE_TYPE)
      IF (YSTORAGE_TYPE=='TT') YREC = 'T_ROAD1             '
    END IF
  END IF
  IF (HREC(1:7)=='SSO_DIR') THEN
    CALL IO_READ_FIELD(TPINFILE,'MASDEV',IMASDEV)
    IF (IMASDEV<=45) YREC = 'SSO_DIRECTION       '
  END IF
!
  ALLOCATE(ZWORK(IIU,IJU))
!

  TZFIELD%CMNHNAME   = TRIM(YREC)
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(YREC)
  TZFIELD%CUNITS     = ''
  TZFIELD%CCOMMENT   = '' !Expected comment is not known
  TZFIELD%NGRID      = 4
  TZFIELD%NTYPE      = TYPEREAL
  IF (HDIR=='H') THEN
    TZFIELD%CDIR     = 'XY'
    TZFIELD%NDIMS    = 2
    CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
  ELSEIF (HDIR=='A') THEN
    TZFIELD%CDIR     = '--'
    TZFIELD%NDIMS    = 2
    CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
  ELSE
    TZFIELD%CDIR     = '--'
    TZFIELD%NDIMS    = 1
    CALL IO_READ_FIELD(TPINFILE,TZFIELD,PFIELD,KRESP)
  END IF
!
  IF (KRESP /=0) THEN
    WRITE(NLUOUT,*) 'WARNING'
    WRITE(NLUOUT,*) '-------'
    WRITE(NLUOUT,*) 'error when reading article ', HREC,'KRESP=',KRESP
    WRITE(NLUOUT,*) 'default value may be used, who knows???'
    WRITE(NLUOUT,*) ' '
  ELSE IF (HDIR=='H' .OR. HDIR=='A') THEN
    CALL PACK_2D_1D(IMASK,ZWORK(IIB:IIE,IJB:IJE),PFIELD)
    CALL GET_SURF_UNDEF(ZUNDEF)
!================================================
! 13/03/2009 : G. TANGUY
! on supprime le test sur lesvaleurs indéfinies 
! pour l'orographie pour que l'altitude 999 m 
! soit autorisée
    IF (HREC(1:2)/='ZS') THEN
      WHERE (PFIELD==XUNDEF) PFIELD=ZUNDEF
    ENDIF
!================================================

  END IF
!
  DEALLOCATE(ZWORK)

ENDIF

DEALLOCATE(IMASK)
!-------------------------------------------------------------------------------
END SUBROUTINE READ_SURFX1_MNH
!
!     #############################################################
      SUBROUTINE READ_SURFX2_MNH(HREC,KL1,KL2,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READX2* - routine to fill a real 2D array for the externalised surface
!!
!!    PURPOSE
!!    -------
!
!       The purpose of READ_SURFX2 is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODE_ll
USE MODE_FIELD,         ONLY: TFIELDDATA,TYPEREAL
USE MODE_FM
USE MODE_FMREAD
USE MODE_IO_ll
USE MODE_MSG
!
USE MODD_IO_SURF_MNH, ONLY : COUT, CFILE , NLUOUT, TPINFILE, NMASK, NIU, NJU, NIB, NJB, NIE, NJE, &
                             NIU_ALL, NJU_ALL, NIB_ALL, NJB_ALL, NIE_ALL, NJE_ALL, NMASK_ALL
USE MODD_PARAMETERS, ONLY: XUNDEF
!
USE MODI_PACK_2D_1D
!
USE MODI_GET_SURF_UNDEF
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=LEN_HREC), INTENT(IN)  :: HREC     ! name of the article to be read
INTEGER,                 INTENT(IN)  :: KL1      ! number of points
INTEGER,                 INTENT(IN)  :: KL2      ! second dimension
REAL, DIMENSION(KL1,KL2),INTENT(OUT) :: PFIELD   ! array containing the data field
INTEGER,                 INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
CHARACTER(LEN=100),      INTENT(OUT) :: HCOMMENT ! comment
CHARACTER(LEN=1),        INTENT(IN)  :: HDIR     ! type of field :
!                                                ! 'H' for HOR : with hor. dim.; and  distributed.
!                                                ! 'A' for ALL : with hor. dim.; and not distributed.
!                                                ! '-' : no horizontal dim.
!
!*      0.2   Declarations of local variables
!
INTEGER           :: IGRID          ! IGRID : grid indicator
INTEGER           :: ILENCH         ! ILENCH : length of comment string

INTEGER           :: JP             ! loop index

REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK  ! work array read in the file
REAL              :: ZUNDEF         ! undefined value in SURFEX
TYPE(TFIELDDATA)  :: TZFIELD
!-------------------------------------------------------------------------------
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFX2_MNH',TRIM(TPINFILE%CNAME)//': reading '//TRIM(HREC))
!
!! Reading of a 3D field, masked (2 first dimensions) and with
!! 2 first dimensions packed into only 1 (results in a 2D array instead of 3D)
!
!*       1.     Dimension initializations:
!               -------------------------
!
!
!
TZFIELD%CMNHNAME   = TRIM(HREC)
TZFIELD%CSTDNAME   = ''
TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(HREC)
TZFIELD%CUNITS     = ''
TZFIELD%CCOMMENT   = '' !Expected comment is not known
TZFIELD%NGRID      = 4
TZFIELD%NTYPE      = TYPEREAL
IF (HDIR=='H') THEN
  ALLOCATE(ZWORK(NIU,NJU,SIZE(PFIELD,2)))
  TZFIELD%CDIR     = 'XY'
  TZFIELD%NDIMS    = 3
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
ELSEIF (HDIR=='A') THEN
  ALLOCATE(ZWORK(NIU_ALL,NJU_ALL,SIZE(PFIELD,2)))
  TZFIELD%CDIR     = '--'
  TZFIELD%NDIMS    = 3
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
ELSE
  TZFIELD%CDIR     = '--'
  TZFIELD%NDIMS    = 2
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,PFIELD,KRESP)
END IF
!
IF (KRESP /=0) THEN
    WRITE(NLUOUT,*) 'WARNING'
    WRITE(NLUOUT,*) '-------'
    WRITE(NLUOUT,*) 'error when reading article ', HREC,'KRESP=',KRESP
    WRITE(NLUOUT,*) 'default value may be used, who knows???'
    WRITE(NLUOUT,*) ' '
    DEALLOCATE(ZWORK)
 ELSE IF (HDIR=='H') THEN
    DO JP=1,SIZE(PFIELD,2)
       CALL PACK_2D_1D(NMASK,ZWORK(NIB:NIE,NJB:NJE,JP),PFIELD(:,JP))
    END DO
    DEALLOCATE(ZWORK)
 ELSE IF (HDIR=='A') THEN
    DO JP=1,SIZE(PFIELD,2)
       CALL PACK_2D_1D(NMASK_ALL,ZWORK(NIB_ALL:NIE_ALL,NJB_ALL:NJE_ALL,JP),PFIELD(:,JP))
    END DO
    DEALLOCATE(ZWORK)
 END IF
 CALL GET_SURF_UNDEF(ZUNDEF)
 WHERE (PFIELD==XUNDEF) PFIELD=ZUNDEF
!
!-------------------------------------------------------------------------------
END SUBROUTINE READ_SURFX2_MNH
!
!     #############################################################
      SUBROUTINE READ_SURFX2COV_MNH(HREC,KL1,KL2,PFIELD,OFLAG,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READX1* - routine to fill a real 2D array for the externalised surface
!!                 with Logical mask by level
!!
!!    PURPOSE
!!    -------
!
!       The purpose of READ_SURFX1 is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!!  06/2016     (G.Delautier) phasage surfex 8
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODE_ll
USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
USE MODE_FM
USE MODE_FMREAD
USE MODE_IO_ll
USE MODE_MSG
!
USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
USE MODD_CST,         ONLY : XPI
!
USE MODD_IO_SURF_MNH, ONLY : COUT, CFILE, TPINFILE, NLUOUT, NMASK, &
                             NIU, NJU, NIB, NJB, NIE, NJE, &
                             NIU_ALL, NJU_ALL, NIB_ALL,    &
                             NJB_ALL, NIE_ALL, NJE_ALL,    &
                             NMASK_ALL
!
USE MODI_PACK_2D_1D
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=LEN_HREC),   INTENT(IN) :: HREC     ! name of the article to be read
INTEGER,                   INTENT(IN) :: KL1,KL2  !  number of points
REAL, DIMENSION(KL1,KL2),  INTENT(OUT):: PFIELD   ! array containing the data field
LOGICAL,DIMENSION(JPCOVER),INTENT(IN) :: OFLAG    ! mask for array filling
INTEGER,                   INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
CHARACTER(LEN=100),        INTENT(OUT):: HCOMMENT ! comment
CHARACTER(LEN=1),          INTENT(IN) :: HDIR     ! type of field :
!                                           ! 'H' for HOR : with hor. dim.; and  distributed.
!                                           ! 'A' for ALL : with hor. dim.; and not distributed.
!                                           ! '-' : no horizontal dim.

!
!*      0.2   Declarations of local variables
!
INTEGER           :: IGRID          ! IGRID : grid indicator
INTEGER           :: ILENCH         ! ILENCH : length of comment string

CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=2)  :: YDIR
CHARACTER(LEN=2)  :: YSTORAGE_TYPE
!
INTEGER           :: IIU, IJU, IIB, IJB, IIE, IJE ! dimensions of horizontal fields
INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK       ! mask for packing
!JUANZ
INTEGER           :: NCOVER,ICOVER,JL2
REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D
!JUANZ
INTEGER  :: IRESP
INTEGER  :: IVERSION, IBUGFIX
LOGICAL  :: GCOVER_PACKED ! .T. if COVER are all packed into one field
TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFX2COV_MNH',TRIM(TPINFILE%CNAME)//': reading '//TRIM(HREC))
!
KRESP = 0
IRESP = 0
!
IF (HDIR=='A') THEN
  YDIR="--"
  IIU = NIU_ALL
  IJU = NJU_ALL
  IIB = NIB_ALL
  IJB = NJB_ALL
  IIE = NIE_ALL
  IJE = NJE_ALL
  ALLOCATE(IMASK(SIZE(NMASK_ALL)))
  IMASK = NMASK_ALL
ELSE
  YDIR="XY"
  IIU = NIU
  IJU = NJU
  IIB = NIB
  IJB = NJB
  IIE = NIE
  IJE = NJE
  ALLOCATE(IMASK(SIZE(NMASK)))
  IMASK = NMASK
END IF
!
!! Reading of a 2D fields, masked and packed into 1D vector
!
!
NCOVER=COUNT(OFLAG)
ALLOCATE (ZWORK3D(IIU,IJU,NCOVER))
ZWORK3D(:,:,:) =  0.0
!
CALL IO_READ_FIELD(TPINFILE,'VERSION',IVERSION)
CALL IO_READ_FIELD(TPINFILE,'BUG',    IBUGFIX)

IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX==0)) THEN
  GCOVER_PACKED = .FALSE.
ELSE
  TZFIELD%CMNHNAME   = 'COVER_PACKED'
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: COVER_PACKED'
  TZFIELD%CUNITS     = ''
  TZFIELD%CDIR       = '--'
  TZFIELD%CCOMMENT   = ''
  TZFIELD%NGRID      = 0
  TZFIELD%NTYPE      = TYPELOG
  TZFIELD%NDIMS      = 0
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,GCOVER_PACKED)
END IF
!
IF (.NOT. GCOVER_PACKED) THEN
  ICOVER=0
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CUNITS     = ''
  TZFIELD%CCOMMENT   = '' !Expected comment is not known
  TZFIELD%NGRID      = 4
  TZFIELD%NTYPE      = TYPEREAL
  TZFIELD%NDIMS      = 2
  DO JL2=1,SIZE(OFLAG)
    WRITE(YREC,'(A5,I3.3)') 'COVER',JL2
    TZFIELD%CMNHNAME   = TRIM(YREC)
    TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(YREC)
    TZFIELD%CDIR       = YDIR
    IF (OFLAG(JL2)) THEN
      ICOVER=ICOVER+1
      CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK3D(:,:,ICOVER),IRESP)
    END IF
    IF (IRESP/=0) KRESP=IRESP
  END DO
ELSE
  TZFIELD%CMNHNAME   = TRIM(HREC)
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(HREC)
  TZFIELD%CUNITS     = ''
  TZFIELD%CDIR       = YDIR
  TZFIELD%CCOMMENT   = '' !Expected comment is not known
  TZFIELD%NGRID      = 4
  TZFIELD%NTYPE      = TYPEREAL
  TZFIELD%NDIMS      = 3
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK3D(:,:,:),KRESP)
END IF
!
IF (KRESP /=0) THEN
  WRITE(NLUOUT,*) 'WARNING'
  WRITE(NLUOUT,*) '-------'
  WRITE(NLUOUT,*) 'error when reading article ', HREC,'KRESP=',KRESP
  WRITE(NLUOUT,*) ' '
ELSE IF (HDIR=='H' .OR. HDIR=='A') THEN
   ICOVER=0
   DO JL2=1,NCOVER
     CALL PACK_2D_1D(IMASK,ZWORK3D(IIB:IIE,IJB:IJE,JL2),PFIELD(:,JL2))
   END DO
END IF
!
DEALLOCATE(ZWORK3D)
!
DEALLOCATE(IMASK)
!-------------------------------------------------------------------------------
END SUBROUTINE READ_SURFX2COV_MNH
!
!     #############################################################
      SUBROUTINE READ_SURFX2COV_1COV_MNH(HREC,KL1,KCOVER,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READX1* - routine to fill a real 2D array for the externalised surface
!!                 with Logical mask on one specified vertical level
!!
!!    PURPOSE
!!    -------
!
!       The purpose of READ_SURFX1 is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
USE MODE_FM
USE MODE_FMREAD
USE MODE_ll
USE MODE_IO_ll
USE MODE_MSG
!
USE MODD_CST,         ONLY : XPI
!
USE MODD_IO_SURF_MNH, ONLY : COUT, CFILE, TPINFILE, NLUOUT, NMASK, &
                             NIU, NJU, NIB, NJB, NIE, NJE, &
                             NIU_ALL, NJU_ALL, NIB_ALL,    &
                             NJB_ALL, NIE_ALL, NJE_ALL,    &
                             NMASK_ALL
!
USE MODI_PACK_2D_1D
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC     ! name of the article to be read
INTEGER,                INTENT(IN) :: KL1      !  number of points
INTEGER,                INTENT(IN) :: KCOVER   ! index of the vertical level, it should be a index such that LCOVER(KCOVER)=.TRUE.
REAL, DIMENSION(KL1),   INTENT(OUT):: PFIELD   ! array containing the data field
INTEGER,                INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
CHARACTER(LEN=100),     INTENT(OUT):: HCOMMENT ! comment
CHARACTER(LEN=1),       INTENT(IN) :: HDIR     ! type of field :
!                                           ! 'H' for HOR : with hor. dim.; and  distributed.
!                                           ! 'A' for ALL : with hor. dim.; and not distributed.
!                                           ! '-' : no horizontal dim.

!
!*      0.2   Declarations of local variables
!
INTEGER           :: IGRID          ! IGRID : grid indicator
INTEGER           :: ILENCH         ! ILENCH : length of comment string

CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=2)  :: YDIR
CHARACTER(LEN=2)  :: YSTORAGE_TYPE
!
INTEGER           :: IIU, IJU, IIB, IJB, IIE, IJE ! dimensions of horizontal fields
INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK       ! mask for packing
!JUANZ
INTEGER           :: NCOVER,ICOVER,JL2
REAL,DIMENSION(:,:), ALLOCATABLE :: ZWORK2D
!JUANZ
INTEGER  :: IVERSION, IBUGFIX
LOGICAL  :: GCOVER_PACKED ! .T. if COVER are all packed into one field
CHARACTER(LEN=1) :: YDIR1
TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFX2COV_1COV_MNH',TRIM(TPINFILE%CNAME)//': reading '//TRIM(HREC))
!
KRESP = 0
!YDIR1 = 'H'
!IF (PRESENT(HDIR)) YDIR1 = HDIR
YDIR1 = HDIR
!
IF (YDIR1=='A') THEN
  YDIR="--"
  IIU = NIU_ALL
  IJU = NJU_ALL
  IIB = NIB_ALL
  IJB = NJB_ALL
  IIE = NIE_ALL
  IJE = NJE_ALL
  ALLOCATE(IMASK(SIZE(NMASK_ALL)))
  IMASK = NMASK_ALL
ELSE
  YDIR="XY"
  IIU = NIU
  IJU = NJU
  IIB = NIB
  IJB = NJB
  IIE = NIE
  IJE = NJE
  ALLOCATE(IMASK(SIZE(NMASK)))
  IMASK = NMASK
END IF
!
!! Reading of a 2D fields, masked and packed into 1D vector
!
!
ALLOCATE (ZWORK2D(IIU,IJU))
ZWORK2D(:,:) =  0.0
!
CALL IO_READ_FIELD(TPINFILE,'VERSION',IVERSION)
CALL IO_READ_FIELD(TPINFILE,'BUG',    IBUGFIX)

IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX==0)) THEN
  GCOVER_PACKED = .FALSE.
ELSE
  TZFIELD%CMNHNAME   = 'COVER_PACKED'
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: COVER_PACKED'
  TZFIELD%CUNITS     = ''
  TZFIELD%CDIR       = '--'
  TZFIELD%CCOMMENT   = ''
  TZFIELD%NGRID      = 0
  TZFIELD%NTYPE      = TYPELOG
  TZFIELD%NDIMS      = 0
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,GCOVER_PACKED,KRESP)
END IF
!
IF (.NOT. GCOVER_PACKED) THEN
  WRITE(YREC,'(A5,I3.3)') 'COVER',KCOVER
  TZFIELD%CMNHNAME   = TRIM(YREC)
  TZFIELD%CSTDNAME   = ''
  TZFIELD%CLONGNAME  = 'SURFEX: '//TRIM(YREC)
  TZFIELD%CUNITS     = ''
  TZFIELD%CDIR       = YDIR1
  TZFIELD%CCOMMENT   = '' !Expected comment is not known
  TZFIELD%NGRID      = 4
  TZFIELD%NTYPE      = TYPEREAL
  TZFIELD%NDIMS      = 2
  CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK2D,KRESP)
ELSE
  WRITE(NLUOUT,*) 'WARNING'
  WRITE(NLUOUT,*) '-------'
  WRITE(NLUOUT,*) 'error : GCOVER_PACKED = ', GCOVER_PACKED, ' and we try to read the covers one by one '
  WRITE(NLUOUT,*) ' '
  CALL ABORT
END IF
!
IF (KRESP /=0) THEN
  WRITE(NLUOUT,*) 'WARNING'
  WRITE(NLUOUT,*) '-------'
  WRITE(NLUOUT,*) 'error when reading article ', HREC,'KRESP=',KRESP
  WRITE(NLUOUT,*) ' '
ELSE IF (YDIR1=='H' .OR. YDIR1=='A') THEN
   CALL PACK_2D_1D(IMASK,ZWORK2D(IIB:IIE,IJB:IJE),PFIELD(:))