mode_read_surf_nc.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_nc
!
!!    PURPOSE
!!    -------
!
!       The purpose of READ_SURF_NC is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      F. Habets      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!----------------------------------------------------------------------------
!
INTERFACE read_surf0_nc
      SUBROUTINE read_surfx0_nc(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_nc
      SUBROUTINE read_surfn0_nc(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_nc
      SUBROUTINE read_surfc0_nc(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_nc
      SUBROUTINE read_surfl0_nc(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_nc
END INTERFACE
INTERFACE read_surfn_nc
      SUBROUTINE read_surfx1_nc(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_nc
      SUBROUTINE read_surfx2_nc(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_nc
      SUBROUTINE read_surfn1_nc(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_nc
      SUBROUTINE read_surfn2_nc(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_surfn2_nc
      SUBROUTINE read_surfl1_nc(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_nc
END INTERFACE
INTERFACE read_surft_nc
      SUBROUTINE read_surft0_nc(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_nc
      SUBROUTINE read_surft1_nc(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
 CHARACTER(LEN=*),        INTENT(IN)  :: hrec     ! name of the article to be read
INTEGER, DIMENSION(:),    INTENT(OUT) :: kyear    ! year
INTEGER, DIMENSION(:),    INTENT(OUT) :: kmonth   ! month
INTEGER, DIMENSION(:),    INTENT(OUT) :: kday     ! day
REAL, DIMENSION(:),       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_surft1_nc
      SUBROUTINE read_surft2_nc(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
 CHARACTER(LEN=*),        INTENT(IN)  :: hrec     ! name of the article to be read
INTEGER, DIMENSION(:,:),  INTENT(OUT) :: kyear    ! year
INTEGER, DIMENSION(:,:),  INTENT(OUT) :: kmonth   ! month
INTEGER, DIMENSION(:,:),  INTENT(OUT) :: kday     ! day
REAL, DIMENSION(:,:),     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_surft2_nc

END INTERFACE
!
END MODULE mode_read_surf_nc
!
!     #############################################################
      SUBROUTINE read_surfx0_nc(HREC,PFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READX0* - routine to read a real scalar
!
USE modd_surf_par,   ONLY: xundef
!
USE modd_io_surf_nc, ONLY : nid_nc
!
USE modi_error_read_surf_nc
!
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,jret,ival,itype,indims
INTEGER,DIMENSION(4) :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFX0_NC',0,zhook_handle)
!
kresp=0
hcomment = " "
!
IF (nid_nc.NE.0) THEN
  !       
  ! 1. Find id of the variable
  !----------------------------
  iret(1)=nf_inq_varid(nid_nc,hrec,ivar_id)
  iret(1)=nf_inq_vartype(nid_nc,ivar_id,itype)
  iret(1)=nf_inq_varndims(nid_nc,ivar_id,indims)
  !  
  ! 2. Get variable
  !----------------------------
  IF (itype==nf_double) THEN
    iret(2)=nf_get_var_double(nid_nc,ivar_id,pfield)
  ELSEIF (itype==nf_float) THEN
    iret(2)=nf_get_var_real(nid_nc,ivar_id,zfield)
    pfield = zfield
  ENDIF
  !
  iret(3) = nf_get_att_text(nid_nc,ivar_id,"comment",hcomment)
  !
ENDIF
!
! 3. Check for errors
!--------------------
DO jret=1,2
  IF ((pfield==xundef).OR.(nid_nc==0).OR.iret(jret).NE.nf_noerr) THEN 
    pfield=xundef
    kresp=1
  ENDIF
ENDDO
!     
IF (kresp /=0) CALL error_read_surf_nc(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFX0_NC',1,zhook_handle)
!
END SUBROUTINE read_surfx0_nc
!
!     #############################################################
      SUBROUTINE read_surfx1_nc(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, nproc, ncomm, &
                                 xtime_npio_read, xtime_comm_read
!
USE modd_surfex_omp, ONLY : xworkd, nworkb, cwork0
!
USE modd_io_surf_nc, ONLY: lmask,nmask,nid_nc
!
USE modd_surf_par,   ONLY: xundef
!
USE modi_error_read_surf_nc
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
 CHARACTER(LEN=100)    :: yname
INTEGER :: il1, ivar_id,jret,jdim,indims, itype, infompi
INTEGER,DIMENSION(4) :: idimids,idimlen
INTEGER,DIMENSION(4) :: iret
!
REAL*4, DIMENSION(:), ALLOCATABLE :: ztab_1d4
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFX1_NC',0,zhook_handle)
!
il1 = SIZE(pfield)
!
!$OMP SINGLE
nworkb=0
 cwork0 = " "
!$OMP END SINGLE
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (hdir=='-') THEN
!$OMP SINGLE
  ALLOCATE(xworkd(il1))
!$OMP END SINGLE
ENDIF
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !  
  IF (nid_nc.NE.0) THEN
    !  
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf_inq_varid(nid_nc,hrec,ivar_id)
    iret(2)=nf_inq_vartype(nid_nc,ivar_id,itype)
    !
    IF (hdir=='A') THEN
      !
      ALLOCATE(xworkd(il1))
      !
    ELSEIF (hdir/='-') THEN
      !
      iret(3)=nf_inq_varndims(nid_nc,ivar_id,indims)
      iret(4)=nf_inq_vardimid(nid_nc,ivar_id,idimids(1:indims))
      idimlen(:) = 1.
      DO jdim=1,indims
        jret=nf_inq_dimlen(nid_nc,idimids(jdim),idimlen(jdim))
      ENDDO
      iret(4)=nf_inq_dimname(nid_nc,idimids(1),yname)
      !
      IF (trim(yname).NE.'Number_of_points') THEN
        ALLOCATE(xworkd(idimlen(1)*idimlen(2)))
      ELSE
        ALLOCATE(xworkd(idimlen(1)))
      ENDIF
      !
    ENDIF
    !
    ! 2. Get variable
    !----------------------------
    IF (itype==nf_double) THEN
      iret(1)=nf_get_var_double(nid_nc,ivar_id,xworkd)
    ELSEIF (itype==nf_float) THEN
      ALLOCATE(ztab_1d4(SIZE(xworkd)))
      iret(2)=nf_get_var_real(nid_nc,ivar_id,ztab_1d4)
      xworkd(:) = ztab_1d4(:)
      DEALLOCATE(ztab_1d4)
    ENDIF
    !
    iret(3) = nf_get_att_text(nid_nc,ivar_id,"comment",cwork0)   
    !
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,1
    IF ((nid_nc==0).OR.iret(jret).NE.nf_noerr) THEN 
      xworkd = xundef
      nworkb=1
    ENDIF
  ENDDO
  !
!$OMP END SINGLE
  !
  IF (nworkb /=0) CALL error_read_surf_nc(hrec,nworkb)
  !
ELSEIF (hdir/='-') THEN
!$OMP SINGLE
  ALLOCATE(xworkd(0))
!$OMP END SINGLE
ENDIF
!
kresp = nworkb
hcomment = cwork0
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (hdir=='A') THEN  ! no distribution on other tasks
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    pfield(:) = xworkd(1:SIZE(pfield))
#ifdef SFX_MPI
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
#endif
  ENDIF
ELSEIF (hdir=='-') THEN ! distribution of the total field on other tasks
!$OMP SINGLE
#ifdef SFX_MPI
  IF (nproc>1) THEN
    xtime0 = mpi_wtime()
    CALL mpi_bcast(xworkd,SIZE(xworkd)*kind(xworkd)/4,mpi_real,npio,ncomm,infompi)   
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
  ENDIF
#endif
!$OMP END SINGLE
  pfield(:) = xworkd(1:SIZE(pfield))
ELSE
  IF (lmask) THEN
    CALL read_and_send_mpi(xworkd,pfield,nmask)
  ELSE 
    CALL read_and_send_mpi(xworkd,pfield)
  END IF
ENDIF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(xworkd)
!$OMP END SINGLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFX1_NC',1,zhook_handle)
!
END SUBROUTINE read_surfx1_nc
!
!     #############################################################
      SUBROUTINE read_surfx2_nc(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READX2* - routine to fill a real 2D array for the externalised surface 
!
USE modd_surfex_mpi, ONLY: nrank, nproc, ncomm, npio, xtime_npio_read, xtime_comm_read
!
USE modd_surfex_omp, ONLY : xworkd2, nworkb, cwork0
!
USE modd_io_surf_nc, ONLY: lmask,nmask,nid_nc
!
USE modd_surf_par,   ONLY: xundef
!
USE modi_error_read_surf_nc
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
 CHARACTER(LEN=100)    :: yname 
INTEGER            :: il1, il2
INTEGER            :: ivar_id,jret,jdim,indims,itype, infompi
INTEGER,DIMENSION(4) :: idimids,idimlen
INTEGER,DIMENSION(4) :: iret
REAL*4, DIMENSION(:,:), ALLOCATABLE :: ztab_2d4
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFX2_NC',0,zhook_handle)
!
il1 = SIZE(pfield,1)
il2 = SIZE(pfield,2)
!
!$OMP SINGLE
nworkb=0
 cwork0 = " "
!$OMP END SINGLE
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (hdir=='-') THEN
!$OMP SINGLE
  ALLOCATE(xworkd2(il1,il2))
!$OMP END SINGLE
ENDIF
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !  
  IF (nid_nc.NE.0) THEN
    !
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf_inq_varid(nid_nc,hrec,ivar_id)
    iret(2)=nf_inq_vartype(nid_nc,ivar_id,itype)
    !
    IF (hdir=='A') THEN
      !
      ALLOCATE(xworkd2(il1,il2))
      !
    ELSEIF (hdir/='-') THEN
      !
      iret(3)=nf_inq_varndims(nid_nc,ivar_id,indims)
      iret(4)=nf_inq_vardimid(nid_nc,ivar_id,idimids(1:indims))
      idimlen(:) = 1.
      DO jdim=1,indims
        jret=nf_inq_dimlen(nid_nc,idimids(jdim),idimlen(jdim))
      ENDDO
      !
      iret(4)=nf_inq_dimname(nid_nc,idimids(1),yname)    
      ! 
      IF (trim(yname).NE.'Number_of_points') THEN
        ALLOCATE(xworkd2(idimlen(1)*idimlen(2),idimlen(3)))
      ELSE
        ALLOCATE(xworkd2(idimlen(1),idimlen(2)))
      ENDIF
      !
    ENDIF
    !
    ! 2. Get variable
    !----------------------------
    !
    IF (itype==nf_double) THEN
      iret(2)=nf_get_var_double(nid_nc,ivar_id,xworkd2)
    ELSEIF (itype==nf_float) THEN
      ALLOCATE(ztab_2d4(SIZE(xworkd2,1),SIZE(xworkd2,2)))
      iret(2)=nf_get_var_real(nid_nc,ivar_id,ztab_2d4)
      xworkd2(:,:) = ztab_2d4(:,:)
      DEALLOCATE(ztab_2d4)
    ENDIF      
    !
    iret(3) = nf_get_att_text(nid_nc,ivar_id,"comment",cwork0)  
    !
  ENDIF

  ! 3. Check for errors
  !--------------------
  DO jret=1,2
    IF ((nid_nc==0).OR.iret(jret).NE.nf_noerr) THEN 
      xworkd2 = xundef
      nworkb=1
    ENDIF
  ENDDO
  !
!$OMP END SINGLE
  !
  IF (nworkb /=0) CALL error_read_surf_nc(hrec,nworkb)
  !
ELSEIF (hdir/='-') THEN
!$OMP SINGLE
  ALLOCATE(xworkd2(1,SIZE(pfield,2)))
!$OMP END SINGLE
ENDIF
!
kresp = nworkb
hcomment = cwork0
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (hdir=='A') THEN  ! no distribution on other tasks
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    pfield(:,:) = xworkd2(:,1:SIZE(pfield,2))
#ifdef SFX_MPI
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
#endif
  ENDIF
ELSEIF (hdir=='-') THEN ! distribution of the total field on other tasks
!$OMP SINGLE
#ifdef SFX_MPI
  IF (nproc>1) THEN
    xtime0 = mpi_wtime()
    CALL mpi_bcast(xworkd2,SIZE(xworkd2)*kind(xworkd2)/4,mpi_real,npio,ncomm,infompi)   
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
  ENDIF
#endif
!$OMP END SINGLE
  pfield(:,:) = xworkd2(:,1:SIZE(pfield,2))
ELSE
  IF (lmask) THEN
    CALL read_and_send_mpi(xworkd2(:,1:SIZE(pfield,2)),pfield,nmask)
  ELSE 
    CALL read_and_send_mpi(xworkd2(:,1:SIZE(pfield,2)),pfield)
  END IF
ENDIF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(xworkd2)
!$OMP END SINGLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFX2_NC',1,zhook_handle)
!
END SUBROUTINE read_surfx2_nc
!
!     #############################################################
      SUBROUTINE read_surfn0_nc(HREC,KFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READN0* - routine to read an integer
!
USE modd_surf_par,   ONLY: nundef
!
USE modd_io_surf_nc, ONLY : nid_nc
!
USE modi_error_read_surf_nc
!
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,jret,jdim,indims
INTEGER,DIMENSION(4) :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFN0_NC',0,zhook_handle)
!
kresp=0
hcomment = " "
!
IF (nid_nc.NE.0) THEN
  !        
  ! 1. Find id of the variable
  !----------------------------
  iret(1)=nf_inq_varid(nid_nc,hrec,ivar_id)
  !  
  ! 2. Get variable
  !----------------------------
  iret(2)=nf_get_var_int(nid_nc,ivar_id,kfield)
  !
  iret(3)=nf_get_att_text(nid_nc,ivar_id,"comment",hcomment)
  !
ENDIF
!
! 3. Check for errors
!--------------------
DO jret=1,2
  IF ((kfield==nundef).OR.(nid_nc==0).OR.iret(jret).NE.nf_noerr) THEN 
    kfield=nundef
    kresp=1
  ENDIF
ENDDO
!
IF (kresp /=0)  CALL error_read_surf_nc(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFN0_NC',1,zhook_handle)
!
END SUBROUTINE read_surfn0_nc
!
!     #############################################################
      SUBROUTINE read_surfn1_nc(HREC,KFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READN0* - routine to read an integer
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_read, nproc, ncomm, &
                                 xtime_npio_read, xtime_comm_read
!
USE modd_surfex_omp, ONLY : nworkd, nworkb, cwork0
!
USE modd_io_surf_nc, ONLY: lmask,nmask,nid_nc
!
USE modd_surf_par,   ONLY: nundef
!
USE modi_error_read_surf_nc
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
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
!
 CHARACTER(LEN=100) :: yfile,yout          ! Filename
 CHARACTER(LEN=100)    :: yname
INTEGER :: il1, ivar_id,jret,jdim,indims, itype, infompi
INTEGER,DIMENSION(4) :: idimids,idimlen
INTEGER,DIMENSION(4) :: iret
!
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFX1_NC',0,zhook_handle)
!
il1 = SIZE(kfield)
!
!$OMP SINGLE
nworkb=0
 cwork0 = " "
!$OMP END SINGLE
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (hdir=='-') THEN
!$OMP SINGLE
  ALLOCATE(nworkd(il1))
!$OMP END SINGLE
ENDIF
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !  
  IF (nid_nc.NE.0) THEN
    !  
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf_inq_varid(nid_nc,hrec,ivar_id)
    iret(2)=nf_inq_vartype(nid_nc,ivar_id,itype)
    iret(3)=nf_inq_varndims(nid_nc,ivar_id,indims)
    iret(4)=nf_inq_vardimid(nid_nc,ivar_id,idimids(1:indims))
    idimlen(:) = 1.
    DO jdim=1,indims
      jret=nf_inq_dimlen(nid_nc,idimids(jdim),idimlen(jdim))
    ENDDO
    !
    iret(4)=nf_inq_dimname(nid_nc,idimids(1),yname)
    !
    IF (trim(yname).NE.'Number_of_points') THEN
      ALLOCATE(nworkd(idimlen(1)*idimlen(2)))
    ELSE
      ALLOCATE(nworkd(idimlen(1)))
    ENDIF
    !
    ! 2. Get variable
    !----------------------------
    IF (itype==nf_int) THEN
      iret(1)=nf_get_var_int(nid_nc,ivar_id,nworkd)
    ENDIF
    !  
    iret(2) = nf_get_att_text(nid_nc,ivar_id,"comment",cwork0)
    !
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,1
    IF ((nid_nc==0).OR.iret(jret).NE.nf_noerr) THEN 
      nworkd = nundef
      nworkb=1
    ENDIF
  ENDDO
  !
!$OMP END SINGLE
  !
  IF (nworkb /=0) CALL error_read_surf_nc(hrec,nworkb)
  !
ELSEIF (hdir/='-') THEN
!$OMP SINGLE
  ALLOCATE(nworkd(0))
!$OMP END SINGLE
ENDIF
!
kresp = nworkb
hcomment = cwork0
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (hdir=='A') THEN  ! no distribution on other tasks
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    kfield(:) = nworkd(1:SIZE(kfield))
#ifdef SFX_MPI
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
#endif
  ENDIF
ELSEIF (hdir=='-') THEN ! distribution of the total field on other tasks
!$OMP SINGLE
#ifdef SFX_MPI
  IF (nproc>1) THEN
    xtime0 = mpi_wtime()
    CALL mpi_bcast(nworkd,SIZE(nworkd)*kind(nworkd)/4,mpi_integer,npio,ncomm,infompi)   
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
  ENDIF
#endif
!$OMP END SINGLE
  kfield(:) = nworkd(1:SIZE(kfield))
ELSE
  IF (lmask) THEN
    CALL read_and_send_mpi(nworkd,kfield,nmask)
  ELSE 
    CALL read_and_send_mpi(nworkd,kfield)
  END IF
ENDIF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(nworkd)
!$OMP END SINGLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFN1_NC',1,zhook_handle)
!
END SUBROUTINE read_surfn1_nc
!
!     #############################################################
      SUBROUTINE read_surfn2_nc(HREC,KFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READN0* - routine to read an integer
!
USE modd_surfex_mpi, ONLY: nrank, nproc, ncomm, npio, xtime_npio_read, xtime_comm_read
!
USE modd_surfex_omp, ONLY : nworkd2, nworkb, cwork0
!
USE modd_io_surf_nc, ONLY: lmask,nmask,nid_nc
!
USE modd_surf_par,   ONLY: nundef
!
USE modi_error_read_surf_nc
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
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
!
 CHARACTER(LEN=100) :: yfile,yout          ! filename
 CHARACTER(LEN=100)    :: yname 
INTEGER            ::  il1, il2, ivar_id,jret,jdim,indims,itype, infompi
INTEGER,DIMENSION(4) :: idimids,idimlen
INTEGER,DIMENSION(4) :: iret
REAL*4, DIMENSION(:,:), ALLOCATABLE :: ztab_2d4
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFN2_NC',0,zhook_handle)
!
il1 = SIZE(kfield,1)
il2 = SIZE(kfield,2)
!
!$OMP SINGLE
nworkb=0
 cwork0 = " "
!$OMP END SINGLE
!
hcomment = " "
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (hdir=='-') THEN
!$OMP SINGLE
  ALLOCATE(nworkd2(il1,il2))
!$OMP END SINGLE
ENDIF
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !  
  IF (nid_nc.NE.0) THEN
    !   
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf_inq_varid(nid_nc,hrec,ivar_id)
    iret(2)=nf_inq_vartype(nid_nc,ivar_id,itype)
    iret(3)=nf_inq_varndims(nid_nc,ivar_id,indims)
    iret(4)=nf_inq_vardimid(nid_nc,ivar_id,idimids(1:indims))
    idimlen(:) = 1.
    DO jdim=1,indims
      jret=nf_inq_dimlen(nid_nc,idimids(jdim),idimlen(jdim))
    ENDDO
    !
    iret(4)=nf_inq_dimname(nid_nc,idimids(1),yname)    
    ! 
    ! 2. Get variable
    !----------------------------
    IF (trim(yname).NE.'Number_of_points') THEN
      ALLOCATE(nworkd2(idimlen(1)*idimlen(2),idimlen(3)))
    ELSE
      ALLOCATE(nworkd2(idimlen(1),idimlen(2)))
    ENDIF
    !
    IF (itype==nf_int) THEN
      iret(2)=nf_get_var_int(nid_nc,ivar_id,nworkd2)
    ENDIF      
    !
    iret(3) = nf_get_att_text(nid_nc,ivar_id,"comment",cwork0)
  ENDIF

  ! 3. Check for errors
  !--------------------
  DO jret=1,2
    IF ((nid_nc==0).OR.iret(jret).NE.nf_noerr) THEN 
      nworkd2 = nundef
      nworkb=1
    ENDIF
  ENDDO
  !
!$OMP END SINGLE
  !
  IF (nworkb /=0) CALL error_read_surf_nc(hrec,nworkb)
  !
ELSEIF (hdir/='-') THEN
!$OMP SINGLE
  ALLOCATE(nworkd2(0,0))
!$OMP END SINGLE
ENDIF
!
kresp = nworkb
hcomment = cwork0
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (hdir=='A') THEN  ! no distribution on other tasks
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    kfield(:,:) = nworkd2(:,:)
#ifdef SFX_MPI
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
#endif
  ENDIF
ELSEIF (hdir=='-') THEN ! distribution of the total field on other tasks
!$OMP SINGLE
#ifdef SFX_MPI
  IF (nproc>1) THEN
    xtime0 = mpi_wtime()
    CALL mpi_bcast(nworkd2,SIZE(nworkd2)*kind(nworkd2)/4,mpi_integer,npio,ncomm,infompi)   
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
  ENDIF
#endif
!$OMP END SINGLE
  kfield(:,:) = nworkd2(:,:)
ELSE
  IF (lmask) THEN
    CALL read_and_send_mpi(nworkd2,kfield,nmask)
  ELSE 
    CALL read_and_send_mpi(nworkd2,kfield)
  END IF
ENDIF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(nworkd2) 
!$OMP END SINGLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFN2_NC',1,zhook_handle)
!
END SUBROUTINE read_surfn2_nc
!
!     #############################################################
      SUBROUTINE read_surfc0_nc(HREC,HFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READC0* - routine to read a STRING
!
USE modd_surf_par,   ONLY: xundef
!
USE modd_io_surf_nc, ONLY : nid_nc
!
USE modi_error_read_surf_nc
!
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=40):: yfield   
INTEGER :: ivar_id,jret,jdim,indims
INTEGER,DIMENSION(4) :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFC0_NC',0,zhook_handle)
!
kresp=0
hcomment = " "
!
IF (nid_nc.NE.0) THEN
  !       
  ! 1. Find id of the variable
  !----------------------------
  iret(1)=nf_inq_varid(nid_nc,hrec,ivar_id)
  !  
  ! 2. Get variable
  !----------------------------
  iret(2)=nf_get_var_text(nid_nc,ivar_id,yfield)
  hfield=yfield(:len_trim(yfield))
  !
  iret(3) = nf_get_att_text(nid_nc,ivar_id,"comment",hcomment)
  !
ENDIF

! 3. Check for errors
!--------------------
DO jret=1,2
  IF ((nid_nc==0).OR.iret(jret).NE.nf_noerr) THEN 
    kresp=1
  ENDIF
ENDDO  
!
IF (kresp /=0) CALL error_read_surf_nc(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFC0_NC',1,zhook_handle)
!
END SUBROUTINE read_surfc0_nc
!
!     #############################################################
      SUBROUTINE read_surfl0_nc(HREC,OFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READL0* - routine to read a logical
!    
USE modd_io_surf_nc, ONLY : nid_nc
!
USE modi_error_read_surf_nc
!
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,jret
INTEGER,DIMENSION(3) :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFL0_NC',0,zhook_handle)
!
kresp=0
hcomment = " "
!
IF (nid_nc.NE.0) THEN
  !       
  ! 1. Find id of the variable
  !----------------------------
  iret(1)=nf_inq_varid(nid_nc,hrec,ivar_id)
  !  
  ! 2. Get variable
  !----------------------------
  iret(2)=nf_get_var_text(nid_nc,ivar_id,yfield)
  !
  iret(3) = nf_get_att_text(nid_nc,ivar_id,"comment",hcomment)
  !  
ENDIF
!  
IF (yfield =="T") ofield=.true.
IF (yfield =="F") ofield=.false.
!
! 3. Check for errors
!--------------------
IF ((nid_nc==0).OR.iret(1).NE.nf_noerr) THEN 
  kresp=1
ENDIF
!
IF (kresp /=0)  CALL error_read_surf_nc(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFL0_NC',1,zhook_handle)
!
END SUBROUTINE read_surfl0_nc
!
!     #############################################################
      SUBROUTINE read_surfl1_nc(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, cwork0
!
USE modd_io_surf_nc, ONLY : nid_nc
!
USE modi_error_read_surf_nc
!
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,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_NC:READ_SURFL1_NC',0,zhook_handle)
!
!$OMP BARRIER
!
!$OMP SINGLE
nworkb=0
 cwork0 = " "
!$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
  ! 
  IF (nid_nc.NE.0) THEN
    !   
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf_inq_varid(nid_nc,hrec,ivar_id)
    iret(1)=nf_inq_varndims(nid_nc,ivar_id,indims)
    iret(1)=nf_inq_vardimid(nid_nc,ivar_id,idimids)
    DO jdim=1,indims
      jret=nf_inq_dimlen(nid_nc,idimids(jdim),idimlen(jdim))
    ENDDO
    ALLOCATE(ytab_1d(idimlen(1)))
    !  
    ! 2. Get variable
    !----------------------------
    iret(1)=nf_get_var_text(nid_nc,ivar_id,ytab_1d)
    !
    DO jret=1,SIZE(lworkd)
      IF (ytab_1d(jret) =="T") lworkd(jret)=.true.
      IF (ytab_1d(jret) =="F") lworkd(jret)=.false.
    ENDDO
    !
    iret(2) = nf_get_att_text(nid_nc,ivar_id,"comment",cwork0)
    !
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,1
    IF ((nid_nc==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_nc(hrec,nworkb)
  !
ENDIF
!
kresp = nworkb
hcomment = cwork0
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (nproc>1 .AND. hdir/='A') 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_NC:READ_SURFL1_NC',1,zhook_handle)
!
END SUBROUTINE read_surfl1_nc
!
!
!     #############################################################
      SUBROUTINE read_surft0_nc(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READT0* - routine to read a NETCDF  date_time scalar
!
USE modd_io_surf_nc, ONLY : nid_nc
!
USE modi_error_read_surf_nc
!
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,jret,jdim,indims,jwrk
INTEGER, DIMENSION(1) :: idimids,idimlen
INTEGER, DIMENSION(5) :: iret
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_NC:READ_SURFT0_NC',0,zhook_handle)
!
kresp=0
hcomment = " "
!
DO jwrk=1,4
  !
  IF (jwrk == 1) THEN 
    yrecfm=trim(hrec)//'-YEAR'
  ELSEIF (jwrk == 2) THEN
    yrecfm = trim(hrec)//'-MONTH'
  ELSEIF (jwrk == 3) THEN
    yrecfm = trim(hrec)//'-DAY'
  ELSEIF (jwrk == 4) THEN    
    yrecfm=trim(hrec)//'-TIME'
  ENDIF
! 0. find filename
  !
  IF (nid_nc.NE.0) THEN
    !   
    ! 1. Find id of the variable
    !----------------------------
    jret=nf_inq_varid(nid_nc,yrecfm,ivar_id)
    !
    ! 2. Get variable
    !----------------------------
    IF (jwrk == 1) THEN 
      iret(jwrk)=nf_get_var_int(nid_nc,ivar_id,kyear)
    ELSEIF (jwrk==2) THEN
      iret(jwrk)=nf_get_var_int(nid_nc,ivar_id,kmonth)
    ELSEIF (jwrk==3) THEN
      iret(jwrk)=nf_get_var_int(nid_nc,ivar_id,kday)
    ELSEIF (jwrk==4) THEN      
      iret(jwrk)=nf_get_var_double(nid_nc,ivar_id,ptime)
    ENDIF
    !
    iret(5) = nf_get_att_text(nid_nc,ivar_id,"comment",hcomment)
    !
  ENDIF
ENDDO
!
! 3. Check for errors
!--------------------
DO jret=1,4
  IF ((nid_nc==0).OR.iret(jret).NE.nf_noerr) THEN 
    kresp=1
  ENDIF
ENDDO
IF (kresp /=0) CALL error_read_surf_nc(yrecfm,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFT0_NC',1,zhook_handle)
!
END SUBROUTINE read_surft0_nc
!
!     #############################################################
      SUBROUTINE read_surft1_nc(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READT0* - routine to read a NETCDF  date_time scalar
!
USE modd_io_surf_nc, ONLY : nid_nc
!
USE modi_error_read_surf_nc
!
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, DIMENSION(:),    INTENT(OUT) :: kyear    ! year
INTEGER, DIMENSION(:),    INTENT(OUT) :: kmonth   ! month
INTEGER, DIMENSION(:),    INTENT(OUT) :: kday     ! day
REAL, DIMENSION(:),       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,jret,jdim,indims,jwrk
INTEGER, DIMENSION(1) :: idimids,idimlen
INTEGER, DIMENSION(5) :: iret
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_NC:READ_SURFT1_NC',0,zhook_handle)
!
kresp=0
hcomment = " "
!
DO jwrk=1,4
  !
  IF (jwrk == 1) THEN 
    yrecfm=trim(hrec)//'-YEAR'
  ELSEIF (jwrk == 2) THEN
    yrecfm = trim(hrec)//'-MONTH'
  ELSEIF (jwrk == 3) THEN
    yrecfm = trim(hrec)//'-DAY'
  ELSEIF (jwrk == 4) THEN    
    yrecfm=trim(hrec)//'-TIME'
  ENDIF
! 0. find filename
  !
  IF (nid_nc.NE.0) THEN
    !   
    ! 1. Find id of the variable
    !----------------------------
    jret=nf_inq_varid(nid_nc,yrecfm,ivar_id)
    !
    ! 2. Get variable
    !----------------------------
    IF (jwrk == 1) THEN 
      iret(jwrk)=nf_get_var_int(nid_nc,ivar_id,kyear)
    ELSEIF (jwrk==2) THEN
      iret(jwrk)=nf_get_var_int(nid_nc,ivar_id,kmonth)
    ELSEIF (jwrk==3) THEN
      iret(jwrk)=nf_get_var_int(nid_nc,ivar_id,kday)
    ELSEIF (jwrk==4) THEN      
      iret(jwrk)=nf_get_var_double(nid_nc,ivar_id,ptime)
    ENDIF
    !
    iret(5) = nf_get_att_text(nid_nc,ivar_id,"comment",hcomment)
    !
  ENDIF
ENDDO
!
! 3. Check for errors
!--------------------
DO jret=1,4
  IF ((nid_nc==0).OR.iret(jret).NE.nf_noerr) THEN 
    kresp=1
  ENDIF
ENDDO
IF (kresp /=0) CALL error_read_surf_nc(yrecfm,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFT1_NC',1,zhook_handle)
!
END SUBROUTINE read_surft1_nc
!
!     #############################################################
      SUBROUTINE read_surft2_nc(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READT0* - routine to read a NETCDF  date_time scalar
!
USE modd_io_surf_nc, ONLY : nid_nc
!
USE modi_error_read_surf_nc
!
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, DIMENSION(:,:),  INTENT(OUT) :: kyear    ! year
INTEGER, DIMENSION(:,:),  INTENT(OUT) :: kmonth   ! month
INTEGER, DIMENSION(:,:),  INTENT(OUT) :: kday     ! day
REAL, DIMENSION(:,:),     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,jret,jdim,indims,jwrk
INTEGER, DIMENSION(1) :: idimids,idimlen
INTEGER, DIMENSION(5) :: iret
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_NC:READ_SURFT2_NC',0,zhook_handle)
!
kresp=0
hcomment = " "
!
DO jwrk=1,4
  !
  IF (jwrk == 1) THEN 
    yrecfm=trim(hrec)//'-YEAR'
  ELSEIF (jwrk == 2) THEN
    yrecfm = trim(hrec)//'-MONTH'
  ELSEIF (jwrk == 3) THEN
    yrecfm = trim(hrec)//'-DAY'
  ELSEIF (jwrk == 4) THEN    
    yrecfm=trim(hrec)//'-TIME'
  ENDIF
! 0. find filename
  !
  IF (nid_nc.NE.0) THEN
    !   
    ! 1. Find id of the variable
    !----------------------------
    jret=nf_inq_varid(nid_nc,yrecfm,ivar_id)
    !
    ! 2. Get variable
    !----------------------------
    IF (jwrk == 1) THEN 
      iret(jwrk)=nf_get_var_int(nid_nc,ivar_id,kyear)
    ELSEIF (jwrk==2) THEN
      iret(jwrk)=nf_get_var_int(nid_nc,ivar_id,kmonth)
    ELSEIF (jwrk==3) THEN
      iret(jwrk)=nf_get_var_int(nid_nc,ivar_id,kday)
    ELSEIF (jwrk==4) THEN      
      iret(jwrk)=nf_get_var_double(nid_nc,ivar_id,ptime)
    ENDIF
    !
    iret(5) = nf_get_att_text(nid_nc,ivar_id,"comment",hcomment)
    !
  ENDIF
ENDDO
!
! 3. Check for errors
!--------------------
DO jret=1,4
  IF ((nid_nc==0).OR.iret(jret).NE.nf_noerr) THEN 
    kresp=1
  ENDIF
ENDDO
IF (kresp /=0) CALL error_read_surf_nc(yrecfm,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_NC:READ_SURFT2_NC',1,zhook_handle)
!
END SUBROUTINE read_surft2_nc
!