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
      SUBROUTINE read_surfx0_ol(HREC,PFIELD,KRESP,HCOMMENT)
 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
END SUBROUTINE read_surfx0_ol
      SUBROUTINE read_surfn0_ol(HREC,KFIELD,KRESP,HCOMMENT)
 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
END SUBROUTINE read_surfn0_ol
      SUBROUTINE read_surfc0_ol(HREC,HFIELD,KRESP,HCOMMENT)
 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
END SUBROUTINE read_surfc0_ol
      SUBROUTINE read_surfl0_ol(HREC,OFIELD,KRESP,HCOMMENT)
 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
END SUBROUTINE read_surfl0_ol
END INTERFACE
INTERFACE read_surfn_ol
      SUBROUTINE read_surfx1_ol(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
 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 :
END SUBROUTINE read_surfx1_ol
      SUBROUTINE read_surfx2_ol(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
 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 :
END SUBROUTINE read_surfx2_ol
      SUBROUTINE read_surfx3_ol(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
 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 :
END SUBROUTINE read_surfx3_ol
      SUBROUTINE read_surfn1_ol(HREC,KFIELD,KRESP,HCOMMENT,HDIR)
 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 :
END SUBROUTINE read_surfn1_ol
      SUBROUTINE read_surfl1_ol(HREC,OFIELD,KRESP,HCOMMENT,HDIR)
 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 :
END SUBROUTINE read_surfl1_ol
END INTERFACE
INTERFACE read_surft_ol
      SUBROUTINE read_surft0_ol(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
 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
END SUBROUTINE read_surft0_ol
END INTERFACE
!
END MODULE mode_read_surf_ol
!
!     #############################################################
      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
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      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)=nf_inq_varid(ifile_id,hrec,ivar_id)
  iret(1)=nf_inq_vartype(ifile_id,ivar_id,itype)
  iret(1)=nf_inq_varndims(ifile_id,ivar_id,indims)
  !  
  ! 2. Get variable
  !----------------------------
  IF (itype==nf_double) THEN
    iret(2)=nf_get_var_double(ifile_id,ivar_id,pfield)
  ELSEIF (itype==nf_float) THEN
    iret(2)=nf_get_var_real(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.nf_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_surfex_omp, ONLY : xworkd, nworkb
!
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
!
IMPLICIT NONE
!
include "netcdf.inc"
!
#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*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)
!
!$OMP BARRIER
!
!$OMP SINGLE
nworkb=0
!$OMP END SINGLE
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !  
  ! 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)=nf_inq_varid(ifile_id,hrec,ivar_id)
    iret(1)=nf_inq_vartype(ifile_id,ivar_id,itype)
    iret(1)=nf_inq_varndims(ifile_id,ivar_id,indims)
    iret(1)=nf_inq_vardimid(ifile_id,ivar_id,idimids(1:indims))
    idimlen(:) = 1.
    DO jdim=1,indims
      jret=nf_inq_dimlen(ifile_id,idimids(jdim),idimlen(jdim))
    ENDDO
    ALLOCATE(xworkd(idimlen(1)*idimlen(2)))
    !
    ! 2. Get variable
    !----------------------------
    IF  (lpartr) THEN
      ! write partially a time-matrix. 
      ! Have to find which of the dimension is the time dimension
      ALLOCATE(istart(indims))
      ALLOCATE(icount(indims))
      ALLOCATE(istride(indims))
      DO  jdim=1,indims
        iret=nf_inq_dimname(ifile_id,idimids(jdim),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==nf_double) THEN
        iret(1)=nf_get_vars_double(ifile_id,ivar_id,istart,icount,istride,xworkd)
      ELSEIF (itype==nf_float) THEN
        ALLOCATE(ztab_1d4(idimlen(1)*idimlen(2)))
        iret(1)=nf_get_vars_real(ifile_id,ivar_id,istart,icount,istride,ztab_1d4)
        xworkd(:) = ztab_1d4(:)
        DEALLOCATE(ztab_1d4)
      ENDIF

      DEALLOCATE(istart)
      DEALLOCATE(icount)
      DEALLOCATE(istride)

    ELSE
      IF (itype==nf_double) THEN
        iret(1)=nf_get_var_double(ifile_id,ivar_id,xworkd)
      ELSEIF (itype==nf_float) THEN
        ALLOCATE(ztab_1d4(idimlen(1)*idimlen(2)))
        iret(1)=nf_get_var_real(ifile_id,ivar_id,ztab_1d4)
        xworkd(:) = ztab_1d4(:)
        DEALLOCATE(ztab_1d4)
      ENDIF            
    ENDIF
    !
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,1
    IF ((ifile_id==0).OR.iret(jret).NE.nf_noerr) THEN 
      xworkd = xundef
      nworkb=1
    ELSE
      IF (minval(xworkd)==xundef) THEN 
        nworkb = 1
        xworkd = xundef
     ENDIF
    ENDIF
  ENDDO
  !
!$OMP END SINGLE
  !
  IF (nworkb /=0) CALL error_read_surf_ol(hrec,nworkb)
  !
ELSE
!$OMP SINGLE
  ALLOCATE(xworkd(0))
!$OMP END SINGLE
ENDIF
!
kresp = nworkb
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (lmask) THEN
  CALL read_and_send_mpi(xworkd,pfield,nmask)
ELSE 
  CALL read_and_send_mpi(xworkd,pfield)
END IF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(xworkd)
!$OMP END SINGLE
!
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_surfex_omp, ONLY : xworkd2, nworkb
!
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
!
IMPLICIT NONE
!
include "netcdf.inc"
!
#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*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)
!
!$OMP BARRIER
!
!$OMP SINGLE
nworkb=0
!$OMP END SINGLE
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !  
  ! 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)=nf_inq_varid(ifile_id,hrec,ivar_id)
    iret(1)=nf_inq_vartype(ifile_id,ivar_id,itype)
    iret(1)=nf_inq_varndims(ifile_id,ivar_id,indims)
    iret(1)=nf_inq_vardimid(ifile_id,ivar_id,idimids(1:indims))
    idimlen(:) = 1.
    DO jdim=1,indims
      jret=nf_inq_dimlen(ifile_id,idimids(jdim),idimlen(jdim))
    ENDDO
    ! 
    ! 2. Get variable
    !----------------------------
    IF (lpartr) THEN
      ! write partially a time-matrix. 
      ! Have to find which of the dimension is the time dimension
      ALLOCATE(istart(indims))
      ALLOCATE(icount(indims))
      icount(:) = 1.
      ALLOCATE(istride(indims))
      DO jdim=1,indims
        iret=nf_inq_dimname(ifile_id,idimids(jdim),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(xworkd2(product(icount(1:indims-1)),icount(indims)))
      IF (itype==nf_double) THEN
        iret(2)=nf_get_vars_double(ifile_id,ivar_id,istart,icount,istride,xworkd2)
      ELSEIF (itype==nf_float) THEN
        ALLOCATE(ztab_2d4(product(icount(1:indims-1)),icount(indims)))
        iret(2)=nf_get_vars_real(ifile_id,ivar_id,istart,icount,istride,ztab_2d4)
        xworkd2(:,:) = ztab_2d4(:,:)
        DEALLOCATE(ztab_2d4)
      ENDIF
      DEALLOCATE(istart)
      DEALLOCATE(icount)
      DEALLOCATE(istride)

    ELSE
      ALLOCATE(xworkd2(product(idimlen(1:indims-1)),idimlen(indims)))
      IF (itype==nf_double) THEN
        iret(2)=nf_get_var_double(ifile_id,ivar_id,xworkd2)
      ELSEIF (itype==nf_float) THEN
        ALLOCATE(ztab_2d4(product(idimlen(1:indims-1)),idimlen(indims)))
        iret(2)=nf_get_var_real(ifile_id,ivar_id,ztab_2d4)
        xworkd2(:,:) = ztab_2d4(:,:)
        DEALLOCATE(ztab_2d4)
      ENDIF      
    ENDIF

  ENDIF

  ! 3. Check for errors
  !--------------------
  DO jret=1,2
    IF ((ifile_id==0).OR.iret(jret).NE.nf_noerr) THEN 
      xworkd2 = xundef
      nworkb=1
    ELSE
      IF (minval(xworkd2)==xundef) THEN 
        nworkb=1
        xworkd2 = xundef
      ENDIF
    ENDIF
  ENDDO
  !
!$OMP END SINGLE
  !
  IF (nworkb /=0) CALL error_read_surf_ol(hrec,nworkb)
  !
ELSE
!$OMP SINGLE
  ALLOCATE(xworkd2(0,0))
!$OMP END SINGLE
ENDIF
!
kresp = nworkb
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (lmask) THEN
  CALL read_and_send_mpi(xworkd2,pfield,nmask)
ELSE 
  CALL read_and_send_mpi(xworkd2,pfield)
END IF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(xworkd2) 
!$OMP END SINGLE
!
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_surfex_omp, ONLY: xworkd3, nworkb
!
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
!
IMPLICIT NONE
!
include "netcdf.inc"
!
#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*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)
!
!$OMP BARRIER
!
!$OMP SINGLE
nworkb=0
!$OMP END SINGLE
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !  
  ! 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)=nf_inq_varid(ifile_id,hrec,ivar_id)
    iret(1)=nf_inq_vartype(ifile_id,ivar_id,itype)
    iret(1)=nf_inq_varndims(ifile_id,ivar_id,indims)
    iret(1)=nf_inq_vardimid(ifile_id,ivar_id,idimids(1:indims))
    DO jdim=1,indims
      jret=nf_inq_dimlen(ifile_id,idimids(jdim),idimlen(jdim))
    ENDDO
    ! 
    ! 2. Get variable
    !----------------------------
    IF (lpartr) THEN
      ! write partially a time-matrix. 
      ! Have to find which of the dimension is the time dimension
      ALLOCATE(istart(indims))
      ALLOCATE(icount(indims))
      ALLOCATE(istride(indims))
      DO  jdim=1,indims
        iret=nf_inq_dimname(ifile_id,idimids(jdim),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(xworkd3(icount(1),icount(2),icount(3)))

      IF (itype==nf_double) THEN
        iret(2)=nf_get_vars_double(ifile_id,ivar_id,istart,icount,istride,xworkd3)
      ELSEIF (itype==nf_float) THEN
        ALLOCATE(ztab_3d4(icount(1),icount(2),icount(3)))
        iret(2)=nf_get_vars_real(ifile_id,ivar_id,istart,icount,istride,ztab_3d4)
        xworkd3(:,:,:) = ztab_3d4(:,:,:)
        DEALLOCATE(ztab_3d4)
      ENDIF
      DEALLOCATE(istart)
      DEALLOCATE(icount)
      DEALLOCATE(istride)
      !
    ELSE
      ALLOCATE(xworkd3(idimlen(1),idimlen(2),idimlen(3)))
      IF (itype==nf_double) THEN
        iret(2)=nf_get_var_double(ifile_id,ivar_id,xworkd3)
      ELSEIF (itype==nf_float) THEN
        ALLOCATE(ztab_3d4(icount(1),icount(2),icount(3)))
        iret(2)=nf_get_var_real(ifile_id,ivar_id,ztab_3d4)
        xworkd3(:,:,:) = ztab_3d4(:,:,:)
        DEALLOCATE(ztab_3d4)
      ENDIF      
    ENDIF
    !
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,2
    IF ((ifile_id==0).OR.iret(jret).NE.nf_noerr) THEN 
      xworkd3 = xundef
      nworkb = 1
    ELSE
      IF (minval(xworkd3)==xundef) THEN 
        nworkb = 1
        xworkd3 = xundef
      ENDIF
    ENDIF
  ENDDO
  !
!$OMP END SINGLE
  !
  IF (nworkb /=0) CALL error_read_surf_ol(hrec,nworkb)
  !
ELSE
!$OMP SINGLE
  ALLOCATE(xworkd3(0,0,0))
!$OMP END SINGLE
ENDIF
!
kresp = nworkb
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (lmask) THEN
  CALL read_and_send_mpi(xworkd3,pfield,nmask)
ELSE 
  CALL read_and_send_mpi(xworkd3,pfield)
END IF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(xworkd3)
!$OMP END SINGLE
!
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
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      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)=nf_inq_varid(ifile_id,hrec,ivar_id)
  !  
  ! 2. Get variable
  !----------------------------
  iret(2)=nf_get_var_int(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.nf_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
!RJ: missing interface, assumed shape on callee
USE modi_read_surfx1_ol
!
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
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      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)=nf_inq_varid(ifile_id,hrec,ivar_id)
  !  
  ! 2. Get variable
  !----------------------------
  iret(2)=nf_get_var_text(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.nf_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
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      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)=nf_inq_varid(ifile_id,hrec,ivar_id)
  !  
  ! 2. Get variable
  !----------------------------
  iret(2)=nf_get_var_text(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.nf_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 modd_surfex_omp, ONLY : lworkd, nworkb
!
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
!
IMPLICIT NONE
!
include "netcdf.inc"
!
#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)
!
!$OMP BARRIER
!
!$OMP SINGLE
nworkb=0
!$OMP END SINGLE
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
!$OMP SINGLE
ALLOCATE(lworkd(SIZE(ofield)))
!$OMP END SINGLE
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !
  ! 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)=nf_inq_varid(ifile_id,hrec,ivar_id)
    iret(1)=nf_inq_varndims(ifile_id,ivar_id,indims)
    iret(1)=nf_inq_vardimid(ifile_id,ivar_id,idimids)
    DO jdim=1,indims
      jret=nf_inq_dimlen(ifile_id,idimids(jdim),idimlen(jdim))
    ENDDO
    ALLOCATE(ytab_1d(idimlen(1)))
    !  
    ! 2. Get variable
    !----------------------------
    iret(1)=nf_get_var_text(ifile_id,ivar_id,ytab_1d)
    !
    DO jret=1,idimlen(1)
      IF (ytab_1d(jret) =='T') lworkd(jret)=.true.
      IF (ytab_1d(jret) =='F') lworkd(jret)=.false.
    ENDDO
    !
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,1
    IF ((ifile_id==0).OR.iret(jret).NE.nf_noerr) THEN 
      nworkb=1
    ENDIF
  ENDDO
  !
  DEALLOCATE(ytab_1d)
  !
!$OMP END SINGLE
  !  
  IF (nworkb /=0) CALL error_read_surf_ol(hrec,nworkb)
  !
ENDIF
!
kresp = nworkb
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (nproc>1) THEN
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
!$OMP SINGLE  
  CALL mpi_bcast(lworkd,SIZE(lworkd),mpi_logical,npio,ncomm,infompi)
!$OMP END SINGLE
  xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
#endif
ENDIF
!
ofield = lworkd
!
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
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      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=nf_inq_varid(ifile_id,yrecfm,ivar_id)
    !
    ! 2. Get variable
    !----------------------------
    IF (jwrk == 1) THEN 
      iret(jwrk)=nf_get_var_int(ifile_id,ivar_id,itdate)
      kyear  = itdate(1)
      kmonth = itdate(2)
      kday   = itdate(3)
    ELSE
      iret(jwrk)=nf_get_var_double(ifile_id,ivar_id,ptime)
    ENDIF
  ENDIF
ENDDO
!
! 3. Check for errors
!--------------------
DO jret=1,2
  IF ((ifile_id==0).OR.iret(jret).NE.nf_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
!