mode_read_surf_asc.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_asc
!!
!!    PURPOSE
!!    -------
!
!       The purpose of READ_SURF_ASC is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!!      J.Escobar      10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
!----------------------------------------------------------------------------
!
INTERFACE read_surf0_asc
        MODULE PROCEDURE read_surfx0_asc
        MODULE PROCEDURE read_surfn0_asc
        MODULE PROCEDURE read_surfl0_asc
        MODULE PROCEDURE read_surfc0_asc
END INTERFACE
INTERFACE read_surfn_asc
        MODULE PROCEDURE read_surfx1_asc
        MODULE PROCEDURE read_surfn1_asc
        MODULE PROCEDURE read_surfl1_asc
        MODULE PROCEDURE read_surfx2_asc
END INTERFACE
INTERFACE read_surft_asc
        MODULE PROCEDURE read_surft0_asc
        MODULE PROCEDURE read_surft1_asc
        MODULE PROCEDURE read_surft2_asc
END INTERFACE
!
 CONTAINS
!
!     #############################################################
      SUBROUTINE read_surfx0_asc (&
                                  hrec,pfield,kresp,hcomment)
!     #############################################################
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_asc, ONLY : nunit, nluout, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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
!
 CHARACTER(LEN=50):: ycomment
 CHARACTER(LEN=6) :: ymask
LOGICAL          :: gfound
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFX0_ASC',0,zhook_handle)
!
kresp=0
!
ymask=cmask
 CALL io_buff(&
                hrec,'R',lwork0)
IF (lwork0) ymask='FULL  '
!
 CALL posnam(nunit,ymask//' '//hrec,gfound,nluout)
IF (.NOT. gfound) CALL posnam(nunit,'FULL  '//' '//hrec,gfound,nluout) ! used for auxilliary files
!
READ(nunit,fmt=*,end=100)
READ(nunit,fmt='(A50)') ycomment
READ(nunit,fmt=*,err=100) pfield
!
hcomment = ycomment
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFX0_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_read_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFX0_ASC',1,zhook_handle)
!
END SUBROUTINE read_surfx0_asc
!
!     #############################################################
      SUBROUTINE read_surfx1_asc (&
                                  hrec,pfield,kresp,hcomment,hdir)
!     #############################################################
!
!!****  *READX1* - routine to fill a real 1D 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 : lwork0, xworkd, nworkb, cwork0, nblock
!
USE modd_io_surf_asc,  ONLY : nunit, nluout, nmask, nfull, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
USE modi_read_and_send_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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=6)  :: ymask
INTEGER           :: il1, infompi
!
REAL   :: xtime0
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: istatus
#endif
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFX1_ASC',0,zhook_handle)
!
il1 = SIZE(pfield)
!
!$OMP SINGLE
nworkb=0
!$OMP END SINGLE
!
#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 (hdir=='A') THEN
    ALLOCATE(xworkd(il1))
  ELSEIF (hdir/='-') THEN
    ALLOCATE(xworkd(nfull))
  END IF
  !
  IF (hdir=='A') THEN
    CALL posnam(nunit,cmask//' '//hrec,lwork0,nluout)
    IF (.NOT. lwork0) CALL posnam(nunit,'FULL  '//' '//hrec,lwork0,nluout)
  ELSE
    ymask=cmask
    CALL io_buff(&
                hrec,'R',lwork0)
    IF (lwork0) ymask='FULL  '
    CALL posnam(nunit,ymask//' '//hrec,lwork0,nluout)
  ENDIF
  !
  READ(nunit,fmt=*,iostat=nworkb)
  READ(nunit,fmt='(A50)',iostat=nworkb) cwork0
  READ(nunit,fmt=*,iostat=nworkb) xworkd
  !
!$OMP END SINGLE
  !
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 (kresp/=0) CALL error_read_surf_asc(hrec,kresp)
!
IF (hdir=='A') THEN  ! no distribution on other tasks
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    pfield(:) = xworkd(1:il1)
#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,il1*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:il1)
ELSE
  CALL read_and_send_mpi(xworkd,pfield,nmask)
ENDIF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(xworkd)
!$OMP END SINGLE
!  
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFX1_ASC',1,zhook_handle)
!
END SUBROUTINE read_surfx1_asc
!
!     #############################################################
      SUBROUTINE read_surfx2_asc (&
                                  hrec,pfield,kresp,hcomment,hdir)
!     #############################################################
!
!!****  *READX2* - routine to fill a real 2D array for the externalised surface 
!

!
!
!
USE modd_surfex_omp, ONLY : lwork0, xworkd2, nworkb, cwork0, lwork0
!
USE modd_surfex_mpi, ONLY : nrank, nproc, ncomm, npio, xtime_npio_read, xtime_comm_read
!
USE modd_io_surf_asc,        ONLY : nunit, nluout, nmask, nfull, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
USE modi_read_and_send_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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=6)  :: ymask
INTEGER           :: il1, il2, infompi
!
REAL   :: xtime0
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: istatus
#endif
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFX2_ASC',0,zhook_handle)
!
il1 = SIZE(pfield,1)
il2 = SIZE(pfield,2)
!
!$OMP SINGLE
nworkb=0
!$OMP END SINGLE
!
#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 (hdir=='A') THEN
    ALLOCATE(xworkd2(il1,il2))
  ELSEIF (hdir/='-') THEN
    ALLOCATE(xworkd2(nfull,il2))
  END IF                 
  !
  IF (hdir=='A') THEN
    CALL posnam(nunit,cmask//' '//hrec,lwork0,nluout)
    IF (.NOT. lwork0) CALL posnam(nunit,'FULL  '//' '//hrec,lwork0,nluout)
  ELSE
    ymask=cmask
    CALL io_buff(&
                hrec,'R',lwork0)
    IF (lwork0) ymask='FULL  '
    CALL posnam(nunit,ymask//' '//hrec,lwork0,nluout)
  ENDIF
  !
  READ(nunit,fmt=*,iostat=nworkb)
  READ(nunit,fmt='(A50)',iostat=nworkb) cwork0
  READ(nunit,fmt=*,iostat=nworkb) xworkd2
  !
!$OMP END SINGLE
  !
ELSEIF (hdir/='-') THEN
!$OMP SINGLE
  ALLOCATE(xworkd2(0,0))
!$OMP END SINGLE
ENDIF
!
kresp = nworkb
hcomment = cwork0
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (kresp/=0) CALL error_read_surf_asc(hrec,kresp)
!
IF (hdir=='A') THEN
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    pfield(:,:) = xworkd2(1:il1,:)
#ifdef SFX_MPI
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
#endif
  ENDIF
ELSEIF (hdir=='-') THEN
!$OMP SINGLE
#ifdef SFX_MPI
  IF (nproc>1) THEN
    xtime0 = mpi_wtime()
    CALL mpi_bcast(xworkd2,il1*il2*kind(xworkd2)/4,mpi_real,npio,ncomm,infompi)   
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
  ENDIF
#endif
!$OMP END SINGLE
  IF (nrank==npio) pfield(:,:) = xworkd2(1:il1,:)
ELSE
  CALL read_and_send_mpi(xworkd2,pfield,nmask)
ENDIF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(xworkd2)
!$OMP END SINGLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFX2_ASC',1,zhook_handle)
!
END SUBROUTINE read_surfx2_asc
!
!     #############################################################
      SUBROUTINE read_surfn0_asc (&
                                  hrec,kfield,kresp,hcomment)
!     #############################################################
!
!!****  *READN0* - routine to read an integer
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_asc,        ONLY : nunit, nluout, nmask, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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 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=50) :: ycomment
 CHARACTER(LEN=6)  :: ymask
LOGICAL           :: gfound
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFN0_ASC',0,zhook_handle)
!
kresp=0
!
ymask=cmask
 CALL io_buff(&
                hrec,'R',lwork0)
IF (lwork0) ymask='FULL  '
!
 CALL posnam(nunit,ymask//' '//hrec,gfound,nluout)
IF (.NOT. gfound) CALL posnam(nunit,'FULL  '//' '//hrec,gfound,nluout) ! used for auxilliary files
!
READ(nunit,fmt=*,end=100)
READ(nunit,fmt='(A50)') ycomment
READ(nunit,fmt=*,err=100) kfield
!
hcomment = ycomment
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFN0_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_read_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFN0_ASC',1,zhook_handle)
!-------------------------------------------------------------------------------
END SUBROUTINE read_surfn0_asc
!
!     #############################################################
      SUBROUTINE read_surfn1_asc (&
                                  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 : lwork0, cwork0, nworkd, nworkb
!
USE modd_io_surf_asc,        ONLY : nunit, nluout, nmask, nfull, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
USE modi_read_and_send_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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
INTEGER, DIMENSION(:),  INTENT(OUT) :: kfield   ! the integer 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=6)  :: ymask
INTEGER           :: il1, infompi
!
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: istatus
#endif
REAL   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFN1_ASC',0,zhook_handle)
!  
il1 = SIZE(kfield)
!
!$OMP SINGLE
nworkb = 0
!$OMP END SINGLE
!
#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 (hdir=='A') THEN
    ALLOCATE(nworkd(il1))
  ELSEIF (hdir/='-') THEN
    ALLOCATE(nworkd(nfull))
  END IF            
  !
  IF (hdir=='A') THEN
    CALL posnam(nunit,cmask//' '//hrec,lwork0,nluout)
    IF (.NOT. lwork0) CALL posnam(nunit,'FULL  '//' '//hrec,lwork0,nluout)
  ELSE
    ymask=cmask
    CALL io_buff(&
                hrec,'R',lwork0)
    IF (lwork0) ymask='FULL  '
    CALL posnam(nunit,ymask//' '//hrec,lwork0,nluout)
  ENDIF
  !
  READ(nunit,fmt=*,iostat=nworkb)
  READ(nunit,fmt='(A50)',iostat=nworkb) cwork0
  READ(nunit,fmt=*,iostat=nworkb) nworkd
  !
!$OMP END SINGLE
  !
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 (kresp/=0) CALL error_read_surf_asc(hrec,kresp)
!
IF (hdir=='A') THEN
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    kfield(:) = nworkd(1:il1)
#ifdef SFX_MPI
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
#endif
  ENDIF
ELSEIF (hdir=='-') THEN
!$OMP SINGLE
#ifdef SFX_MPI
  IF (nproc>1) THEN
    xtime0 = mpi_wtime()
    CALL mpi_bcast(nworkd,il1*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:il1)
ELSE
  CALL read_and_send_mpi(nworkd,kfield,nmask)
ENDIF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(nworkd)
!$OMP END SINGLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFN1_ASC',1,zhook_handle)
!
END SUBROUTINE read_surfn1_asc
!
!     #############################################################
      SUBROUTINE read_surfc0_asc (&
                                  hrec,hfield,kresp,hcomment)
!     #############################################################
!
!!****  *READC0* - routine to read a character
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_asc,        ONLY : nunit, nluout, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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 to be read
INTEGER,            INTENT(OUT) :: kresp     ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(OUT) :: hcomment  ! comment
!
!*      0.2   Declarations of local variables
!
INTEGER :: iresp
 CHARACTER(LEN=50):: ycomment
 CHARACTER(LEN=6) :: ymask
LOGICAL          :: gfound
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFC0_ASC',0,zhook_handle)
!
kresp=0
!
ymask=cmask
 CALL io_buff(&
                hrec,'R',lwork0)
IF (lwork0) ymask='FULL  '
!
 CALL posnam(nunit,ymask//' '//hrec,gfound,nluout)
IF (.NOT. gfound) CALL posnam(nunit,'FULL  '//' '//hrec,gfound,nluout) ! used for auxilliary files
!
READ(nunit,fmt=*,iostat=iresp)
READ(nunit,fmt='(A50)',iostat=iresp) ycomment
READ(nunit,fmt='(A40)',iostat=iresp) hfield
!
IF (iresp/=0) CALL error_read_surf_asc(hrec,kresp)

hcomment = ycomment
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFC0_ASC',1,zhook_handle)
!
END SUBROUTINE read_surfc0_asc
!
!     #############################################################
      SUBROUTINE read_surfl0_asc (&
                                  hrec,ofield,kresp,hcomment)
!     #############################################################
!
!!****  *READL0* - routine to read a logical
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_asc,        ONLY : nunit, nluout, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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=50) :: ycomment
 CHARACTER(LEN=6)  :: ymask
LOGICAL           :: gfound
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFL0_ASC',0,zhook_handle)
kresp=0
!
ymask=cmask
 CALL io_buff(&
                hrec,'R',lwork0)
IF (lwork0) ymask='FULL  '
!
 CALL posnam(nunit,ymask//' '//hrec,gfound,nluout)
IF (.NOT. gfound) CALL posnam(nunit,'FULL  '//' '//hrec,gfound,nluout) ! used for auxilliary files
!
READ(nunit,fmt=*,end=100)
READ(nunit,fmt='(A50)') ycomment
READ(nunit,fmt=*,err=100) ofield
!
hcomment = ycomment
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFL0_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_read_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFL0_ASC',1,zhook_handle)
!
END SUBROUTINE read_surfl0_asc
!
!     #############################################################
      SUBROUTINE read_surfl1_asc (&
                                  hrec,ofield,kresp,hcomment,hdir)
!     #############################################################
!
!!****  *READL1* - routine to read a logical array
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0, lworkd, nworkb, cwork0
!
USE modd_surfex_mpi, ONLY : nrank, nproc, ncomm, npio, xtime_npio_read, xtime_comm_read
!
USE modd_io_surf_asc,        ONLY : nunit, nluout, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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=6) :: ymask
INTEGER          :: infompi, il1
REAL :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFL1_ASC',0,zhook_handle)
!
il1 = SIZE(ofield)
!
nworkb = 0
!
!$OMP BARRIER
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
!$OMP SINGLE
ALLOCATE(lworkd(il1))
!$OMP END SINGLE
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  ! 
  ymask=cmask
  CALL io_buff(&
                hrec,'R',lwork0)
  IF (lwork0) ymask='FULL  '
  !
  CALL posnam(nunit,ymask//' '//hrec,lwork0,nluout)
  IF (.NOT. lwork0) CALL posnam(nunit,'FULL  '//' '//hrec,lwork0,nluout) ! used for auxilliary files
  !
  READ(nunit,fmt=*,iostat=nworkb)
  READ(nunit,fmt='(A50)',iostat=nworkb) cwork0
  READ(nunit,fmt=*,iostat=nworkb) lworkd
  !
!$OMP END SINGLE
  !
ENDIF
!
kresp = nworkb
hcomment = cwork0
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (kresp/=0) CALL error_read_surf_asc(hrec,kresp)
!
#ifdef SFX_MPI
IF (nproc>1 .AND. hdir/='A') THEN
!$OMP SINGLE 
  xtime0 = mpi_wtime()
  CALL mpi_bcast(lworkd,il1,mpi_logical,npio,ncomm,infompi)
  xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
!$OMP END SINGLE
ENDIF
#endif
!
ofield = lworkd
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFL1_ASC',1,zhook_handle)
!
END SUBROUTINE read_surfl1_asc
!
!
!     #############################################################
      SUBROUTINE read_surft0_asc (&
                                  hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
!     #############################################################
!
!!****  *READT0* - routine to read a date
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank
USE modd_surfex_omp, ONLY : lwork0, nblock
!
USE modd_io_surf_asc,        ONLY : nunit, nluout, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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    ! year
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=50) :: ycomment
 CHARACTER(LEN=6)  :: ymask
LOGICAL           :: gfound
INTEGER, DIMENSION(3) :: itdate
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFT0_ASC',0,zhook_handle)
kresp=0
!
ymask=cmask
 CALL io_buff(&
                hrec,'R',lwork0)
IF (lwork0) ymask='FULL  '
!
 CALL posnam(nunit,ymask//' '//trim(hrec)//'%TDATE',gfound,nluout)
!IF (.NOT. GFOUND) CALL POSNAM(NUNIT,'FULL  '//' '//HREC,GFOUND,NLUOUT) ! used for auxilliary files
!
READ(nunit,fmt=*,end=100)
READ(nunit,fmt='(A50)') ycomment
READ(nunit,fmt=*,err=100) itdate(:)
!
kyear  = itdate(1)
kmonth = itdate(2)
kday   = itdate(3)
!
 CALL posnam(nunit,ymask//' '//trim(hrec)//'%TIME',gfound,nluout)
IF (.NOT. gfound) CALL posnam(nunit,'FULL  '//' '//hrec,gfound,nluout) ! used for auxilliary files
!
READ(nunit,fmt=*,end=100)
READ(nunit,fmt='(A50)') ycomment
READ(nunit,fmt=*,err=100) ptime
!
hcomment = ycomment
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFT0_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_read_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFT0_ASC',1,zhook_handle)
!
END SUBROUTINE read_surft0_asc
!
!     #############################################################
      SUBROUTINE read_surft1_asc (&
                                  hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
!     #############################################################
!
!!****  *READT2* - routine to read a date
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank
USE modd_surfex_omp, ONLY : lwork0, nblock
!
USE modd_io_surf_asc,        ONLY : nunit, nluout, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      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    ! year
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=50) :: ycomment
 CHARACTER(LEN=6)  :: ymask
LOGICAL           :: gfound
INTEGER, DIMENSION(3,SIZE(KYEAR)) :: itdate
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFT1_ASC',0,zhook_handle)
!
kresp=0
!
ymask=cmask
 CALL io_buff(&
                hrec,'R',lwork0)
IF (lwork0) ymask='FULL  '
!
 CALL posnam(nunit,ymask//' '//trim(hrec)//'%TDATE',gfound,nluout)
!
READ(nunit,fmt=*,end=100)
READ(nunit,fmt='(A50)') ycomment
READ(nunit,fmt=*,err=100) itdate(:,:)
!
kyear(:) = itdate(1,:)
kmonth(:) = itdate(2,:)
kday(:) = itdate(3,:)
!
 CALL posnam(nunit,cmask//' '//trim(hrec)//'%TIME',gfound,nluout)
!
READ(nunit,fmt=*,end=100)
READ(nunit,fmt='(A50)') ycomment
READ(nunit,fmt=*,err=100) ptime
!
hcomment = ycomment
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFT1_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_read_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFT1_ASC',1,zhook_handle)
!
END SUBROUTINE read_surft1_asc
!
!     #############################################################
      SUBROUTINE read_surft2_asc (&
                                  hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
!     #############################################################
!
!!****  *READT2* - routine to read a date
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_asc,        ONLY : nunit, nluout, cmask
!
USE mode_pos_surf
!
USE modi_io_buff
USE modi_error_read_surf_asc
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      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    ! year
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=50) :: ycomment
 CHARACTER(LEN=6)  :: ymask
LOGICAL           :: gfound
INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: itdate
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFT2_ASC',0,zhook_handle)
!
kresp=0
!
ymask=cmask
 CALL io_buff(&
                hrec,'R',lwork0)
IF (lwork0) ymask='FULL  '
!
 CALL posnam(nunit,ymask//' '//trim(hrec)//'%TDATE',gfound,nluout)
!
READ(nunit,fmt=*,end=100)
READ(nunit,fmt='(A50)') ycomment
READ(nunit,fmt=*,err=100) itdate(:,:,:)
!
kyear(:,:) = itdate(1,:,:)
kmonth(:,:) = itdate(2,:,:)
kday(:,:) = itdate(3,:,:)
!
 CALL posnam(nunit,ymask//' '//trim(hrec)//'%TIME',gfound,nluout)

READ(nunit,fmt=*,end=100)
READ(nunit,fmt='(A50)') ycomment
READ(nunit,fmt=*,err=100) ptime
!
hcomment = ycomment
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFT2_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_read_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_READ_SURF_ASC:READ_SURFT2_ASC',1,zhook_handle)
!
END SUBROUTINE read_surft2_asc
!
END MODULE mode_read_surf_asc