mode_read_surf_ol.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
MODULE mode_read_surf_ol
!
!!    PURPOSE
!!    -------
!
!       The purpose of READ_SURF_OL is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      F. Habets      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!----------------------------------------------------------------------------
!
INTERFACE read_surf0_ol
        MODULE PROCEDURE read_surfx0_ol
        MODULE PROCEDURE read_surfn0_ol
        MODULE PROCEDURE read_surfc0_ol
        MODULE PROCEDURE read_surfl0_ol
END INTERFACE
INTERFACE read_surfx1n1_ol
        MODULE PROCEDURE read_surfx1_ol
        MODULE PROCEDURE read_surfn1_ol
END INTERFACE
INTERFACE read_surfl1x2_ol
        MODULE PROCEDURE read_surfl1_ol
        MODULE PROCEDURE read_surfx2_ol
        MODULE PROCEDURE read_surfx3_ol
END INTERFACE
INTERFACE read_surft_ol
        MODULE PROCEDURE read_surft0_ol
END INTERFACE
!
CONTAINS
!
!     #############################################################
      SUBROUTINE read_surfx0_ol(HREC,PFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READX0* - routine to read a real scalar
!
USE modd_surf_par,   ONLY: xundef
!
USE modi_ol_find_file_read
USE modi_error_read_surf_ol
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*),  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
!
REAL*4 :: ZFIELD
 CHARACTER(LEN=100) :: YFILE          ! filename
INTEGER            :: IVAR_ID,IFILE_ID,JRET,IVAL,ITYPE,INDIMS
INTEGER,DIMENSION(4) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFX0_OL',0,zhook_handle)
!
kresp=0
hcomment = " "
!
! 0. find filename
! -----------------
 CALL ol_find_file_read(hrec,ifile_id)
!
IF (ifile_id.NE.0) THEN
  !       
  ! 1. Find id of the variable
  !----------------------------
  iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
  iret(1)=nf90_inquire_variable(ifile_id,ivar_id,xtype=itype)
  iret(1)=nf90_inquire_variable(ifile_id,ivar_id,ndims=indims)
  !  
  ! 2. Get variable
  !----------------------------
  IF (itype==nf90_double) THEN
    iret(2)=nf90_get_var(ifile_id,ivar_id,pfield)
  ELSEIF (itype==nf90_float) THEN
    iret(2)=nf90_get_var(ifile_id,ivar_id,zfield)
    pfield = zfield
  ENDIF
  !  
ENDIF
!
! 3. Check for errors
!--------------------
DO jret=1,2
  IF ((pfield==xundef).OR.(ifile_id==0).OR.iret(jret).NE.nf90_noerr) THEN 
    pfield=xundef
    kresp=1
  ENDIF
ENDDO
!     
IF (kresp /=0) CALL error_read_surf_ol(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFX0_OL',1,zhook_handle)
!
END SUBROUTINE read_surfx0_ol
!
!     #############################################################
      SUBROUTINE read_surfx1_ol(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READX1* - routine to fill a real 1D array for the externalised surface 
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_read
!
USE modd_io_surf_ol, ONLY: lmask,nmask,xstart,xcount,xstride,lpartr
!
USE modd_surf_par,   ONLY: xundef
!
USE modi_ol_find_file_read
USE modi_error_read_surf_ol
USE modi_read_and_send_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*),  INTENT(IN)  :: HREC     ! name of the article to be read
REAL, DIMENSION(:), 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' : field with
                                            !       horizontal spatial dim.
                                            ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YFILE,YOUT          ! Filename
INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS, ITYPE
INTEGER,DIMENSION(2) :: IDIMIDS,IDIMLEN
INTEGER,DIMENSION(2) :: IRET
!
INTEGER,DIMENSION(:),ALLOCATABLE :: ISTART,ICOUNT,ISTRIDE
REAL, DIMENSION(:), ALLOCATABLE :: ZWORK
REAL*4, DIMENSION(:), ALLOCATABLE :: ZTAB_1D4
DOUBLE PRECISION   :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFX1_OL',0,zhook_handle)
!
!
kresp=0
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
  ! 0. find filename
  ! -----------------
  CALL ol_find_file_read(hrec,ifile_id)
  ! 
  IF (ifile_id.NE.0) THEN
    !  
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,xtype=itype)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,ndims=indims)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,dimids=idimids(1:indims))
    idimlen(:) = 1.
    DO jdim=1,indims
      jret=nf90_inquire_dimension(ifile_id,idimids(jdim),len=idimlen(jdim))
    ENDDO
    ALLOCATE(zwork(idimlen(1)*idimlen(2)))
    !
    ALLOCATE(istart(indims))
    ALLOCATE(icount(indims))
    !
    ! 2. Get variable
    !----------------------------
    IF  (lpartr) THEN
      ! write partially a time-matrix. 
      ! Have to find which of the dimension is the time dimension
      ALLOCATE(istride(indims))
      DO  jdim=1,indims
        iret=nf90_inquire_dimension(ifile_id,idimids(jdim),name=yout)
        IF ((index(yout,'time') > 0).OR.(index(yout,'TIME') >0) &
          .OR.(index(yout,'Time')>0.)) THEN  
          istart(jdim)=xstart
          icount(jdim)=xcount
          istride(jdim)=xstride
        ELSE
          istart(jdim)=1
          icount(jdim)=idimlen(jdim)
          istride(jdim)=1
        ENDIF
      ENDDO

      IF (itype==nf90_double) THEN
        iret(1)=nf90_get_var(ifile_id,ivar_id,zwork,istart,icount,istride)
      ELSEIF (itype==nf90_float) THEN
        ALLOCATE(ztab_1d4(idimlen(1)*idimlen(2)))
        iret(1)=nf90_get_var(ifile_id,ivar_id,ztab_1d4,istart,icount,istride)
        zwork(:) = ztab_1d4(:)
        DEALLOCATE(ztab_1d4)
      ENDIF

      DEALLOCATE(istride)

    ELSE

      istart(:) = 1
      icount(1:indims) = idimlen(1:indims)

      IF (itype==nf90_double) THEN
        iret(1)=nf90_get_var(ifile_id,ivar_id,zwork,istart,icount)
      ELSEIF (itype==nf90_float) THEN
        ALLOCATE(ztab_1d4(idimlen(1)*idimlen(2)))
        iret(1)=nf90_get_var(ifile_id,ivar_id,ztab_1d4,istart,icount)
        zwork(:) = ztab_1d4(:)
        DEALLOCATE(ztab_1d4)
      ENDIF    
        
    ENDIF
    !
    DEALLOCATE(istart)
    DEALLOCATE(icount)
    !
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,1
    IF ((ifile_id==0).OR.iret(jret).NE.nf90_noerr) THEN 
      zwork = xundef
      kresp=1
    ELSE
      IF (minval(zwork)==xundef) THEN 
        kresp = 1
        zwork = xundef
     ENDIF
    ENDIF
  ENDDO
  !
  IF (kresp /=0) CALL error_read_surf_ol(hrec,kresp)
  !
ELSE
  ALLOCATE(zwork(0))
ENDIF
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (lmask) THEN
  CALL read_and_send_mpi(zwork,pfield,nmask)
ELSE 
  CALL read_and_send_mpi(zwork,pfield)
END IF
!
DEALLOCATE(zwork)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFX1_OL',1,zhook_handle)
!
END SUBROUTINE read_surfx1_ol
!
!     #############################################################
      SUBROUTINE read_surfx2_ol(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READX2* - routine to fill a real 2D array for the externalised surface 
!
USE modd_surfex_mpi, ONLY: nrank, npio, xtime_npio_read
!
USE modd_io_surf_ol, ONLY: lmask,nmask,xstart,xcount,xstride,lpartr
USE modd_surf_par,   ONLY: xundef
!
USE modi_ol_find_file_read
USE modi_error_read_surf_ol
USE modi_read_and_send_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*),        INTENT(IN)  :: HREC     ! name of the article to be read
REAL, DIMENSION(:,:),     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' : field with
                                                  !       horizontal spatial dim.
                                                  ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YFILE,YOUT          ! filename
INTEGER            :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS,ITYPE
INTEGER,DIMENSION(3) :: IDIMIDS,IDIMLEN
INTEGER,DIMENSION(2) :: IRET
INTEGER, DIMENSION(:), ALLOCATABLE :: ISTART,ISTRIDE,ICOUNT
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2
REAL*4, DIMENSION(:,:), ALLOCATABLE :: ZTAB_2D4
DOUBLE PRECISION   :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFX2_OL',0,zhook_handle)
!
!
kresp=0
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
  ! 0. find filename
  ! -----------------
  CALL ol_find_file_read(hrec,ifile_id)
  ! 
  IF (ifile_id.NE.0) THEN
    !   
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,xtype=itype)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,ndims=indims)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,dimids=idimids(1:indims))
    idimlen(:) = 1.
    DO jdim=1,indims
      jret=nf90_inquire_dimension(ifile_id,idimids(jdim),len=idimlen(jdim))
    ENDDO
    ! 
    ALLOCATE(istart(indims))
    ALLOCATE(icount(indims))
    !
    ! 2. Get variable
    !----------------------------
    IF (lpartr) THEN
      ! write partially a time-matrix. 
      ! Have to find which of the dimension is the time dimension
      icount(:) = 1.
      ALLOCATE(istride(indims))
      DO jdim=1,indims
        iret=nf90_inquire_dimension(ifile_id,idimids(jdim),name=yout)
        IF ((index(yout,'time') > 0).OR.(index(yout,'TIME') >0) &
          .OR.(index(yout,'Time')>0.)) THEN  
          istart(jdim)=xstart
          icount(jdim)=xcount
          istride(jdim)=xstride
        ELSE
          istart(jdim)=1
          icount(jdim)=idimlen(jdim)
          istride(jdim)=1
        ENDIF
      ENDDO

      ALLOCATE(zwork2(product(icount(1:indims-1)),icount(indims)))
      IF (itype==nf90_double) THEN
        iret(2)=nf90_get_var(ifile_id,ivar_id,zwork2,istart,icount,istride)
      ELSEIF (itype==nf90_float) THEN
        ALLOCATE(ztab_2d4(product(icount(1:indims-1)),icount(indims)))
        iret(2)=nf90_get_var(ifile_id,ivar_id,ztab_2d4,istart,icount,istride)
        zwork2(:,:) = ztab_2d4(:,:)
        DEALLOCATE(ztab_2d4)
      ENDIF
      DEALLOCATE(istride)

    ELSE

      istart(:) = 1
      icount(1:indims) = idimlen(1:indims)

      ALLOCATE(zwork2(product(idimlen(1:indims-1)),idimlen(indims)))
      IF (itype==nf90_double) THEN
        iret(2)=nf90_get_var(ifile_id,ivar_id,zwork2)
      ELSEIF (itype==nf90_float) THEN
        ALLOCATE(ztab_2d4(product(idimlen(1:indims-1)),idimlen(indims)))
        iret(2)=nf90_get_var(ifile_id,ivar_id,ztab_2d4)
        zwork2(:,:) = ztab_2d4(:,:)
        DEALLOCATE(ztab_2d4)
      ENDIF      
    ENDIF

    DEALLOCATE(istart)
    DEALLOCATE(icount)

  ENDIF

  ! 3. Check for errors
  !--------------------
  DO jret=1,2
    IF ((ifile_id==0).OR.iret(jret).NE.nf90_noerr) THEN 
      zwork2 = xundef
      kresp=1
    ELSE
      IF (minval(zwork2)==xundef) THEN 
        kresp=1
        zwork2 = xundef
      ENDIF
    ENDIF
  ENDDO
  !
  IF (kresp /=0) CALL error_read_surf_ol(hrec,kresp)
  !
ELSE
  ALLOCATE(zwork2(0,0))
ENDIF
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (lmask) THEN
  CALL read_and_send_mpi(zwork2,pfield,nmask)
ELSE 
  CALL read_and_send_mpi(zwork2,pfield)
END IF
!
DEALLOCATE(zwork2) 
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFX2_OL',1,zhook_handle)
!
END SUBROUTINE read_surfx2_ol
!
!     #############################################################
      SUBROUTINE read_surfx3_ol(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READX3* - routine to fill a real 2D array for the externalised surface 
!
USE modd_surfex_mpi, ONLY: nrank, npio, xtime_npio_read
!
USE modd_io_surf_ol, ONLY: lmask,nmask,xstart,xcount,xstride,lpartr
USE modd_surf_par,   ONLY: xundef
!
USE modi_ol_find_file_read
USE modi_error_read_surf_ol
USE modi_read_and_send_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*),        INTENT(IN)  :: HREC     ! name of the article to be read
REAL, DIMENSION(:,:,:),   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' : field with
                                                  !       horizontal spatial dim.
                                                  ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YFILE,YOUT          ! filename
INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS,ITYPE
INTEGER,DIMENSION(3) :: IDIMIDS,IDIMLEN
INTEGER,DIMENSION(2) :: IRET
INTEGER, DIMENSION(:), ALLOCATABLE :: ISTART,ISTRIDE,ICOUNT
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3
REAL*4, DIMENSION(:,:,:), ALLOCATABLE :: ZTAB_3D4
DOUBLE PRECISION   :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFX3_OL',0,zhook_handle)
!
kresp=0
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
  ! 0. find filename
  ! -----------------
  CALL ol_find_file_read(hrec,ifile_id)
  ! 
  IF (ifile_id.NE.0) THEN
    !      
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,xtype=itype)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,ndims=indims)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,dimids=idimids(1:indims))
    DO jdim=1,indims
      jret=nf90_inquire_dimension(ifile_id,idimids(jdim),len=idimlen(jdim))
    ENDDO
    ! 
    ALLOCATE(istart(indims))
    ALLOCATE(icount(indims))
    !
    ! 2. Get variable
    !----------------------------
    IF (lpartr) THEN
      ! write partially a time-matrix. 
      ! Have to find which of the dimension is the time dimension
      ALLOCATE(istride(indims))
      DO  jdim=1,indims
        iret=nf90_inquire_dimension(ifile_id,idimids(jdim),name=yout)
        IF ((index(yout,'time') > 0).OR.(index(yout,'TIME') >0) &
            .OR.(index(yout,'Time')>0.)) THEN  
          istart(jdim)=xstart
          icount(jdim)=xcount
          istride(jdim)=xstride
        ELSE
          istart(jdim)=1
          icount(jdim)=idimlen(jdim)
          istride(jdim)=1
        ENDIF
      ENDDO

      ALLOCATE(zwork3(icount(1),icount(2),icount(3)))

      IF (itype==nf90_double) THEN
        iret(2)=nf90_get_var(ifile_id,ivar_id,zwork3,istart,icount,istride)
      ELSEIF (itype==nf90_float) THEN
        ALLOCATE(ztab_3d4(icount(1),icount(2),icount(3)))
        iret(2)=nf90_get_var(ifile_id,ivar_id,ztab_3d4,istart,icount,istride)
        zwork3(:,:,:) = ztab_3d4(:,:,:)
        DEALLOCATE(ztab_3d4)
      ENDIF
      DEALLOCATE(istride)
      !
    ELSE

      istart(:) = 1
      icount(1:indims) = idimlen(1:indims)

      ALLOCATE(zwork3(idimlen(1),idimlen(2),idimlen(3)))
      IF (itype==nf90_double) THEN
        iret(2)=nf90_get_var(ifile_id,ivar_id,zwork3)
      ELSEIF (itype==nf90_float) THEN
        ALLOCATE(ztab_3d4(icount(1),icount(2),icount(3)))
        iret(2)=nf90_get_var(ifile_id,ivar_id,ztab_3d4)
        zwork3(:,:,:) = ztab_3d4(:,:,:)
        DEALLOCATE(ztab_3d4)
      ENDIF   
   
    ENDIF
    !
    DEALLOCATE(istart)
    DEALLOCATE(icount)
    !
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,2
    IF ((ifile_id==0).OR.iret(jret).NE.nf90_noerr) THEN 
      zwork3 = xundef
      kresp = 1
    ELSE
      IF (minval(zwork3)==xundef) THEN 
        kresp = 1
        zwork3 = xundef
      ENDIF
    ENDIF
  ENDDO
  !
  IF (kresp /=0) CALL error_read_surf_ol(hrec,kresp)
  !
ELSE
  ALLOCATE(zwork3(0,0,0))
ENDIF
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (lmask) THEN
  CALL read_and_send_mpi(zwork3,pfield,nmask)
ELSE 
  CALL read_and_send_mpi(zwork3,pfield)
END IF
!
DEALLOCATE(zwork3)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFX3_OL',1,zhook_handle)
!
END SUBROUTINE read_surfx3_ol
!
!     #############################################################
      SUBROUTINE read_surfn0_ol(HREC,KFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READN0* - routine to read an integer
!
USE modd_surf_par,   ONLY: nundef
!
USE modi_ol_find_file_read
USE modi_error_read_surf_ol
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*),  INTENT(IN)  :: HREC     ! name of the article to be read
INTEGER,            INTENT(OUT) :: KFIELD   ! the integer 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
!
 CHARACTER(LEN=100):: YFILE          ! filename
INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS
INTEGER,DIMENSION(4) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFN0_OL',0,zhook_handle)
!
kresp=0
hcomment = " "
!
! 0. find filename
! -----------------
 CALL ol_find_file_read(hrec,ifile_id)
!
IF (ifile_id.NE.0) THEN
  !        
  ! 1. Find id of the variable
  !----------------------------
  iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
  !  
  ! 2. Get variable
  !----------------------------
  iret(2)=nf90_get_var(ifile_id,ivar_id,kfield)
  !  
ENDIF
!
! 3. Check for errors
!--------------------
DO jret=1,2
  IF ((kfield==nundef).OR.(ifile_id==0).OR.iret(jret).NE.nf90_noerr) THEN 
    kfield=nundef
    kresp=1
  ENDIF
ENDDO
!
IF (kresp /=0)  CALL error_read_surf_ol(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFN0_OL',1,zhook_handle)
!
END SUBROUTINE read_surfn0_ol
!
!     #############################################################
      SUBROUTINE read_surfn1_ol(HREC,KFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READN0* - routine to read an integer
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*),      INTENT(IN)  :: HREC     ! name of the article to be read
INTEGER, DIMENSION(:), INTENT(OUT) :: KFIELD   ! the integer scalar to be read
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' : field with
                                                !       horizontal spatial dim.
                                                ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
!
REAL, DIMENSION(SIZE(KFIELD)) :: ZFIELD
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFN1_OL',0,zhook_handle)
!
 CALL read_surfx1_ol(hrec,zfield,kresp,hcomment,hdir)
kfield = nint(zfield)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFN1_OL',1,zhook_handle)
!
END SUBROUTINE read_surfn1_ol
!
!     #############################################################
      SUBROUTINE read_surfc0_ol(HREC,HFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READC0* - routine to read a STRING
!
USE modi_ol_find_file_read
USE modi_error_read_surf_ol
!
USE modd_surf_par,   ONLY: xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*),   INTENT(IN)  :: HREC     ! name of the article to be read
 CHARACTER(LEN=40),   INTENT(OUT) :: HFIELD   ! the integer 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
!
 CHARACTER(LEN=100):: YFILE          ! filename
 CHARACTER(LEN=100):: YFIELD   
INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS
INTEGER,DIMENSION(4) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFC0_OL',0,zhook_handle)
!
kresp=0
hcomment = " "
!
! 0. find filename
! -----------------
 CALL ol_find_file_read(hrec,ifile_id)
!
IF (ifile_id.NE.0) THEN
  !       
  ! 1. Find id of the variable
  !----------------------------
  iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
  !  
  ! 2. Get variable
  !----------------------------
  iret(2)=nf90_get_var(ifile_id,ivar_id,yfield)
  hfield=yfield(:len_trim(yfield))
  !  
ENDIF

! 3. Check for errors
!--------------------
DO jret=1,2
  IF ((ifile_id==0).OR.iret(jret).NE.nf90_noerr) THEN 
    kresp=1
  ENDIF
ENDDO  
!
IF (kresp /=0) CALL error_read_surf_ol(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFC0_OL',1,zhook_handle)
!
END SUBROUTINE read_surfc0_ol
!
!     #############################################################
      SUBROUTINE read_surfl0_ol(HREC,OFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READL0* - routine to read a logical
!    
USE modi_ol_find_file_read
USE modi_error_read_surf_ol
!
USE modd_surf_par,   ONLY: xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*),        INTENT(IN)  :: HREC     ! name of the article to be read
LOGICAL,                  INTENT(OUT) :: OFIELD   ! array containing the data field
INTEGER,                  INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),       INTENT(OUT) :: HCOMMENT ! comment
!
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=1)   :: YFIELD   ! work array read in the file
 CHARACTER(LEN=100) :: YFILE    ! Filename
INTEGER :: IVAR_ID,IFILE_ID, JRET
INTEGER,DIMENSION(2) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFL0_OL',0,zhook_handle)
!
kresp=0
hcomment = " "
!
! 0. find filename
! -----------------
 CALL ol_find_file_read(hrec,ifile_id)
!
IF (ifile_id.NE.0) THEN
  !       
  ! 1. Find id of the variable
  !----------------------------
  iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
  !  
  ! 2. Get variable
  !----------------------------
  iret(2)=nf90_get_var(ifile_id,ivar_id,yfield)
  !  
  IF (yfield =='T') ofield=.true.
  IF (yfield =='F') ofield=.false.
  !
ENDIF
!
! 3. Check for errors
!--------------------
IF ((ifile_id==0).OR.iret(1).NE.nf90_noerr) THEN 
  kresp=1
ENDIF
!
IF (kresp /=0)  CALL error_read_surf_ol(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFL0_OL',1,zhook_handle)
!
END SUBROUTINE read_surfl0_ol
!
!     #############################################################
      SUBROUTINE read_surfl1_ol(HREC,OFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READL1* - routine to read a logical array
!    
USE modd_surfex_mpi, ONLY : nrank, nproc, ncomm, npio, xtime_npio_read, xtime_comm_read
!
USE modi_ol_find_file_read
USE modi_error_read_surf_ol
!
USE modd_surf_par,   ONLY: xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*),        INTENT(IN)  :: HREC     ! name of the article to be read
LOGICAL, DIMENSION(:),   INTENT(OUT) :: OFIELD   ! 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' : field with
                                                  !       horizontal spatial dim.
                                                  ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YFILE          ! Filename
 CHARACTER(LEN=1), DIMENSION(:), ALLOCATABLE :: YTAB_1D  ! work array read in the file
!
INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS
INTEGER :: INFOMPI
INTEGER,DIMENSION(1) :: IDIMIDS,IDIMLEN
INTEGER,DIMENSION(2) :: IRET
INTEGER, DIMENSION(:),    POINTER     :: IMASK    ! 1D mask to read only interesting
DOUBLE PRECISION   :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFL1_OL',0,zhook_handle)
!
kresp=0
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
  !
  ! 0. find filename
  ! -----------------
  CALL ol_find_file_read(hrec,ifile_id)
  ! 
  IF (ifile_id.NE.0) THEN
    !   
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,ndims=indims)
    iret(1)=nf90_inquire_variable(ifile_id,ivar_id,dimids=idimids)
    DO jdim=1,indims
      jret=nf90_inquire_dimension(ifile_id,idimids(jdim),len=idimlen(jdim))
    ENDDO
    ALLOCATE(ytab_1d(idimlen(1)))
    !  
    ! 2. Get variable
    !----------------------------
    iret(1)=nf90_get_var(ifile_id,ivar_id,ytab_1d)
    !
    DO jret=1,idimlen(1)
      IF (ytab_1d(jret) =='T') ofield(jret)=.true.
      IF (ytab_1d(jret) =='F') ofield(jret)=.false.
    ENDDO
    !
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,1
    IF ((ifile_id==0).OR.iret(jret).NE.nf90_noerr) THEN 
      kresp=1
    ENDIF
  ENDDO
  !
  DEALLOCATE(ytab_1d)
  !
  IF (kresp /=0) CALL error_read_surf_ol(hrec,kresp)
  !
ENDIF
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (nproc>1) THEN
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
  CALL mpi_bcast(ofield,SIZE(ofield),mpi_logical,npio,ncomm,infompi)
  xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
#endif
ENDIF
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFL1_OL',1,zhook_handle)
!
END SUBROUTINE read_surfl1_ol
!
!
!     #############################################################
      SUBROUTINE read_surft0_ol(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READT0* - routine to read a NETCDF  date_time scalar
!
USE modi_ol_find_file_read
USE modi_error_read_surf_ol
!
USE modd_surf_par,   ONLY: xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*),        INTENT(IN)  :: HREC     ! name of the article to be read
INTEGER,                  INTENT(OUT) :: KYEAR    ! year
INTEGER,                  INTENT(OUT) :: KMONTH   ! month
INTEGER,                  INTENT(OUT) :: KDAY     ! day
REAL,                     INTENT(OUT) :: PTIME    ! time
INTEGER,                  INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),       INTENT(OUT) :: HCOMMENT ! comment

!
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=18)  :: YRECFM    ! Name of the article to be written
 CHARACTER(LEN=100) :: YFILE          ! Filename
INTEGER :: IVAR_ID,IFILE_ID,JRET,JDIM,INDIMS,JWRK
INTEGER, DIMENSION(1) :: IDIMIDS,IDIMLEN
INTEGER, DIMENSION(4) :: IRET
INTEGER, DIMENSION(3) :: ITDATE  ! work array read in the file
INTEGER, DIMENSION(:), POINTER :: IMASK    ! 1D mask to read only interesting
REAL:: ZTIME
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFT0_OL',0,zhook_handle)
!
kresp=0
hcomment = " "
!
DO jwrk=1,2
  IF (jwrk == 1) THEN 
    yrecfm=trim(hrec)//'-TDATE'
  ELSE
    yrecfm=trim(hrec)//'-TIME'
  ENDIF
! 0. find filename
! -----------------
  CALL ol_find_file_read(yrecfm,ifile_id)
  !
  IF (ifile_id.NE.0) THEN
    !   
    ! 1. Find id of the variable
    !----------------------------
    jret=nf90_inq_varid(ifile_id,yrecfm,ivar_id)
    !
    ! 2. Get variable
    !----------------------------
    IF (jwrk == 1) THEN 
      iret(jwrk)=nf90_get_var(ifile_id,ivar_id,itdate)
      kyear  = itdate(1)
      kmonth = itdate(2)
      kday   = itdate(3)
    ELSE
      iret(jwrk)=nf90_get_var(ifile_id,ivar_id,ptime)
    ENDIF
  ENDIF
ENDDO
!
! 3. Check for errors
!--------------------
DO jret=1,2
  IF ((ifile_id==0).OR.iret(jret).NE.nf90_noerr) THEN 
    kresp=1
  ENDIF
ENDDO
IF (kresp /=0) CALL error_read_surf_ol(yrecfm,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_OL:READ_SURFT0_OL',1,zhook_handle)
!
END SUBROUTINE read_surft0_ol
!
END MODULE mode_read_surf_ol