mode_read_surf_fa.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_fa
!!
!!    PURPOSE
!!    -------
!
!       The purpose of READ_SURF_FA 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_fa
        MODULE PROCEDURE read_surfx0_fa
        MODULE PROCEDURE read_surfn0_fa
        MODULE PROCEDURE read_surfl0_fa
        MODULE PROCEDURE read_surfc0_fa
END INTERFACE
INTERFACE read_surfx_fa
        MODULE PROCEDURE read_surfx1_fa
        MODULE PROCEDURE read_surfx2_fa
END INTERFACE
INTERFACE read_surfn_fa
        MODULE PROCEDURE read_surfn1_fa
        MODULE PROCEDURE read_surfl1_fa
END INTERFACE
INTERFACE read_surft_fa
        MODULE PROCEDURE read_surft0_fa
        MODULE PROCEDURE read_surft2_fa
END INTERFACE
!
!----------------------------------------------------------------------------
!
CONTAINS
!
!----------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE sfx_fa_version(ONEW)
!     #############################################################
!
!!****  *SFX_FA_VERSION* - routine to find which fa version 
!                          (convergence with GMAP var name)
!
USE modd_io_surf_fa, ONLY : nunit_fa, cprefix1d
!
USE modi_error_read_surf_fa
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
LOGICAL, INTENT(OUT) :: ONEW
!
LOGICAL :: GOLD, GWORK
INTEGER :: INGRIB, INBITS, ISTRON, IPUILA, IRESP
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:SFX_FA_VERSION',0,zhook_handle)
!
iresp=0
!
 CALL fanion(iresp,nunit_fa,cprefix1d,0,'VERSION',onew,gwork,ingrib,inbits,istron,ipuila)
IF (iresp/=0) CALL error_read_surf_fa('FULLVERSION',iresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:SFX_FA_VERSION',1,zhook_handle)
!
END SUBROUTINE sfx_fa_version
!
!----------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE read_surfx0_fa (&
                                 HREC,PFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READX0* - routine to read a real scalar
!
USE modd_io_surf_fa, ONLY : nunit_fa, nluout, cmask, cprefix1d
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_read_surf_fa
!
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
 CHARACTER(LEN=18) :: YNAME ! Field Name
LOGICAL           :: GV8, GFOUND
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFX0_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
               hrec,'R',gfound)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)
ELSE
  ymask=cmask
  IF (gfound) ymask='FULL  '
  yname=trim(ymask)//trim(hrec)
ENDIF
!
 CALL falit_r(kresp,nunit_fa,yname,pfield)
IF (kresp/=0) CALL error_read_surf_fa(hrec,kresp)
!
ycomment = trim(yname)
hcomment = ycomment
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFX0_FA',1,zhook_handle)
!
END SUBROUTINE read_surfx0_fa
!
!----------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE read_surfx1_fa(HREC,KL,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, &
                            wlog_mpi, nreq
!
USE modd_io_surf_fa, ONLY : nunit_fa, nluout, nmask, nfull, nfull_ext, &
                            ndgl, ndlon, ndgux, ndlux, cprefix1d
!
USE mode_fasurfex
!
USE modi_pack_same_rank
USE modi_error_read_surf_fa
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,             INTENT(IN)  :: KL       ! number of points
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=4)           :: YPREFIX
 CHARACTER(LEN=3)           :: YPREF
LOGICAL                    :: GV8
!
INTEGER ::  I, J, INFOMPI
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS
#endif
!
REAL, DIMENSION(:), ALLOCATABLE :: ZWORK2, ZWORK
REAL   :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFX1_FA',0,zhook_handle)
!
!
kresp=0
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
  ALLOCATE(zwork(nfull))
  !
  ypref=hrec(1:3)
  !
  IF (ypref=='CLS' .OR. ypref=='SUR' .OR. ypref=='PRO' .OR. ypref=='ATM') THEN
    ALLOCATE(zwork2(nfull_ext))
    CALL facile(kresp,nunit_fa,hrec(1:4),0,hrec(5:16),zwork2,.false.)
    IF (kresp/=0) CALL error_read_surf_fa(hrec,kresp)
    DO j=1,ndgux
      DO i=1,ndlux
        zwork((j-1)*ndlux + i) = zwork2((j-1)*ndlon + i)
      ENDDO
    ENDDO
    DEALLOCATE(zwork2)
    hcomment = trim(hrec)
  ELSE
    CALL sfx_fa_version(gv8)
    IF(gv8)THEN
      yprefix=cprefix1d
    ELSE
      yprefix='S1D_'
    ENDIF
    CALL facile(kresp,nunit_fa,yprefix,0,hrec,zwork,.false.)
    IF (kresp/=0) CALL error_read_surf_fa(hrec,kresp)  
    hcomment = yprefix//trim(hrec)
  ENDIF
  !
ELSEIF (hdir/='-') THEN
  ALLOCATE(zwork(0))
ENDIF
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (hdir=='E') THEN
  IF ( nrank==npio ) THEN
    CALL pack_same_rank(nmask,zwork(:),pfield(:))
  ENDIF
ELSEIF (hdir=='A') THEN  ! no distribution on other tasks
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    pfield(:) = zwork(1:kl)
#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
#ifdef SFX_MPI
  IF (nproc>1) THEN
    xtime0 = mpi_wtime()
    CALL mpi_bcast(nfull,kind(nfull)/4,mpi_integer,npio,ncomm,infompi)
    IF ( nrank/=npio ) ALLOCATE(zwork(nfull))
    CALL mpi_bcast(zwork(1:kl),kl*kind(zwork)/4,mpi_real,npio,ncomm,infompi)
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
  ENDIF
#endif
  pfield(:) = zwork(1:kl)
ELSE
  CALL read_and_send_mpi(zwork,pfield,nmask)
  !IF (NRANK==NPIO) THEN
  !  CALL MPI_WAITALL(NPROC-1,NREQ,ISTATUS,INFOMPI)
  !ENDIF  
ENDIF
!
DEALLOCATE(zwork)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFX1_FA',1,zhook_handle)
! 
END SUBROUTINE read_surfx1_fa
!
!----------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE read_surfx2_fa(HREC,KL1,KL2,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, &
                            wlog_mpi, nreq
!
USE modd_io_surf_fa, ONLY : nunit_fa, nluout, nmask, nfull, cprefix2d
!
USE mode_fasurfex
!
USE modi_pack_same_rank
USE modi_error_read_surf_fa
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,                  INTENT(IN)  :: KL1      ! number of points
INTEGER,                  INTENT(IN)  :: KL2      ! 2nd dimension
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=4)           :: YPREFIX
 CHARACTER(LEN=2)           :: YPATCH
 CHARACTER(LEN=3)           :: YNUM
LOGICAL                    :: GV8
!
INTEGER :: JL, I, INFOMPI ! loop counter
!
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS
#endif
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2   ! work array read in the file
REAL:: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFX2_FA',0,zhook_handle)
!
!
kresp=0
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
  ALLOCATE(zwork2(nfull,kl2)) 
  !  
  CALL sfx_fa_version(gv8)
  !
  DO jl=1,kl2
    IF(gv8)THEN
      WRITE(ynum,'(I3.3)')jl
      yprefix=cprefix2d//ynum
    ELSE
      WRITE(ypatch,'(I2.2)')jl
      yprefix='S'//ypatch//'_'
    ENDIF
    CALL facile(kresp,nunit_fa,yprefix,jl,hrec,zwork2(:,jl),.false.)
     IF (kresp/=0) THEN
       hcomment = yprefix//trim(hrec)
       CALL error_read_surf_fa(hcomment,kresp)
     ENDIF  
  END DO
  !
  hcomment = 'PATCH_'//trim(hrec)
  !
ELSEIF (hdir/='-') THEN
  ALLOCATE(zwork2(0,0))
ENDIF
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (hdir=='E') THEN
  IF ( nrank==npio ) THEN
    CALL pack_same_rank(nmask,zwork2(:,:),pfield(:,:))
  ENDIF
ELSEIF (hdir=='A') THEN  ! no distribution on other tasks
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    pfield(:,:) = zwork2(1:kl1,1:kl2)
#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
#ifdef SFX_MPI
  IF (nproc>1) THEN
    xtime0 = mpi_wtime()
    CALL mpi_bcast(nfull,kind(nfull)/4,mpi_integer,npio,ncomm,infompi)
    IF ( nrank/=npio ) ALLOCATE(zwork2(nfull,kl2))    
    CALL mpi_bcast(zwork2(1:kl1,1:kl2),kl1*kl2*kind(zwork2)/4,mpi_real,npio,ncomm,infompi)
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
  ENDIF
#endif
  pfield(:,:) = zwork2(1:kl1,1:kl2)
ELSE
  CALL read_and_send_mpi(zwork2,pfield,nmask)
  !IF (NRANK==NPIO) THEN
  !  CALL MPI_WAITALL(NPROC-1,NREQ,ISTATUS,INFOMPI)
  !ENDIF  
ENDIF
!
DEALLOCATE(zwork2)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFX2_FA',1,zhook_handle)
!
END SUBROUTINE read_surfx2_fa
!
!----------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE read_surfn0_fa (&
                                 HREC,KFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READN0* - routine to read an integer
!
USE modd_io_surf_fa, ONLY : nunit_fa, nluout, nmask, cmask, cprefix1d
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_read_surf_fa
!
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
 CHARACTER(LEN=18) :: YNAME ! Field Name
LOGICAL           :: GV8, GFOUND
!
REAL(KIND=JPRB)  :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFN0_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
               hrec,'R',gfound)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)
ELSE
  ymask=cmask
  IF (gfound) ymask='FULL  '
  yname=trim(ymask)//trim(hrec)
ENDIF
!
 CALL falit_i(kresp,nunit_fa,yname,kfield)
IF (kresp/=0) CALL error_read_surf_fa(hrec,kresp)
!
ycomment = yname
hcomment = ycomment
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFN0_FA',1,zhook_handle)
!
END SUBROUTINE read_surfn0_fa
!
!----------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE read_surfn1_fa (&
                                 HREC,KL,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, & 
                            wlog_mpi
!
USE modd_io_surf_fa, ONLY : nunit_fa, nluout, nmask, nfull, cmask, cprefix1d
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_read_surf_fa
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,                INTENT(IN)  :: KL       ! number of points
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
 CHARACTER(LEN=18) :: YNAME ! Field Name
LOGICAL           :: GV8, GFOUND
!
INTEGER, DIMENSION(:), ALLOCATABLE :: IWORK
INTEGER ::  I, 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_FA:READ_SURFN1_FA',0,zhook_handle)
!
kresp = 0
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (hdir=='-') THEN
  ALLOCATE(iwork(kl))
ENDIF
!
IF (nrank==npio) THEN
  !
  CALL io_buff(&
               hrec,'R',gfound)
  !
  CALL sfx_fa_version(gv8)
  IF(gv8)THEN
    yname=cprefix1d//trim(hrec)
  ELSE
    ymask=cmask
    IF (gfound) ymask='FULL  '
    yname=trim(ymask)//trim(hrec)
  ENDIF
  !
  IF (hdir=='A') THEN
    ALLOCATE(iwork(kl))
  ELSEIF (hdir/='-') THEN
    ALLOCATE(iwork(nfull))
  END IF    
  !
  CALL falit_i_d(kresp,nunit_fa,yname,SIZE(iwork),iwork)
  IF (kresp/=0) CALL error_read_surf_fa(hrec,kresp)
  !
  hcomment = yname
  !
ELSEIF (hdir/='-') THEN
  ALLOCATE(iwork(0))
ENDIF
!
#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(:) = iwork(1:kl)
#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
#ifdef SFX_MPI
  IF (nproc>1) THEN
    xtime0 = mpi_wtime()
    CALL mpi_bcast(nfull,kind(nfull)/4,mpi_integer,npio,ncomm,infompi) 
    CALL mpi_bcast(iwork(1:kl),kl*kind(iwork)/4,mpi_integer,npio,ncomm,infompi)
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
  ENDIF
#endif
  kfield(:) = iwork(1:kl)
ELSE
  CALL read_and_send_mpi(iwork,kfield,nmask)
ENDIF
!
DEALLOCATE(iwork)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFN1_FA',1,zhook_handle)
!
END SUBROUTINE read_surfn1_fa
!
!----------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE read_surfc0_fa (&
                                 HREC,HFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READC0* - routine to read a character
!
USE modd_io_surf_fa, ONLY : nunit_fa, nluout, cmask, cprefix1d
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_read_surf_fa
!
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
!
 CHARACTER(LEN=50)       :: YCOMMENT
 CHARACTER(LEN=6)        :: YMASK
 CHARACTER(LEN=18)       :: YNAME ! Field Name
 CHARACTER,DIMENSION(40) :: YFIELD
LOGICAL                 :: GV8, GFOUND
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFC0_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
               hrec,'R',gfound)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)
ELSE
  ymask=cmask
  IF (gfound) ymask='FULL  '
  yname=trim(ymask)//trim(hrec)
ENDIF
!
 CALL falit_c(kresp,nunit_fa,yname,40,yfield)
IF (kresp/=0) CALL error_read_surf_fa(hrec,kresp)
WRITE(hfield,'(40A1)') yfield(:)
!
ycomment = yname
hcomment = ycomment
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFC0_FA',1,zhook_handle)
!
END SUBROUTINE read_surfc0_fa
!
!
!     #############################################################
      SUBROUTINE read_surfl0_fa (&
                                 HREC,OFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READL0* - routine to read a logical
!
USE modd_io_surf_fa, ONLY : nunit_fa, nluout, cmask, cprefix1d
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_read_surf_fa
!
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
 CHARACTER(LEN=18) :: YNAME ! Field Name
LOGICAL           :: GV8, GFOUND
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFL0_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
               hrec,'R',gfound)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)
ELSE
  ymask=cmask
  IF (gfound) ymask='FULL  '
  yname=trim(ymask)//trim(hrec)
ENDIF
!
 CALL falit_l(kresp,nunit_fa,yname,ofield)
IF (kresp/=0)CALL error_read_surf_fa(hrec,kresp)
!
ycomment = yname
hcomment = ycomment
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFL0_FA',1,zhook_handle)
!
END SUBROUTINE read_surfl0_fa
!
!
!     #############################################################
      SUBROUTINE read_surfl1_fa (&
                                 HREC,KL,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, &
                            wlog_mpi
!
USE modd_io_surf_fa, ONLY : nunit_fa, nluout, cmask, cprefix1d
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_read_surf_fa
!
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,                INTENT(IN)  :: KL       ! number of points
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
 CHARACTER(LEN=18) :: YNAME ! Field Name
LOGICAL           :: GV8, GFOUND
!
INTEGER           :: INFOMPI
REAL  :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFL1_FA',0,zhook_handle)
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
kresp = 0
!
IF (nrank==npio) THEN
  !
  !
  CALL io_buff(&
               hrec,'R',gfound)
  !
  CALL sfx_fa_version(gv8)
  IF(gv8)THEN
    yname=cprefix1d//trim(hrec)
  ELSE
    ymask=cmask
    IF (gfound) ymask='FULL  '
    yname=trim(ymask)//trim(hrec)
  ENDIF
  !
  CALL falit_l_d(kresp,nunit_fa,yname,kl,ofield)
  IF (kresp/=0) CALL error_read_surf_fa(hrec,kresp)
  !
  hcomment = yname
  !
  !
ENDIF
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
#ifdef SFX_MPI
IF (nproc>1 .AND. hdir/='A') THEN
  xtime0 = mpi_wtime()
  CALL mpi_bcast(ofield,kl,mpi_logical,npio,ncomm,infompi)
  xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
ENDIF
#endif
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFL1_FA',1,zhook_handle)
!
END SUBROUTINE read_surfl1_fa
!
!----------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE read_surft0_fa (&
                                 HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READT0* - routine to read a date
!
USE modd_io_surf_fa, ONLY : nunit_fa, nluout, cmask, cprefix1d
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_read_surf_fa
!
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
 CHARACTER(LEN=18) :: YNAME ! Field Name
LOGICAL           :: GV8, GFOUND
!
INTEGER, DIMENSION(3) :: ITDATE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFT0_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
               hrec,'R',gfound)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)//'%TDATE'
ELSE
  ymask=cmask
  IF (gfound) ymask='FULL  '
  yname=trim(ymask)//trim(hrec)//'%TDATE'
ENDIF
!
 CALL falit_i_d(kresp,nunit_fa,yname,3,itdate)
IF (kresp/=0) CALL error_read_surf_fa(hrec,kresp)
!
kyear  = itdate(1)
kmonth = itdate(2)
kday   = itdate(3)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)//'%TIME'
ELSE
  ymask=cmask
  IF (gfound) ymask='FULL  '
  yname=trim(ymask)//trim(hrec)//'%TIME'
ENDIF
!
 CALL falit_r(kresp,nunit_fa,yname,ptime)
IF (kresp/=0) CALL error_read_surf_fa(hrec,kresp)
!
ycomment = trim(hrec)
hcomment = ycomment
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFT0_FA',1,zhook_handle)
!
END SUBROUTINE read_surft0_fa
!
!----------------------------------------------------------------------------
!
!     #############################################################
      SUBROUTINE read_surft2_fa (&
                                 HREC,KL1,KL2,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READT2* - routine to read a date
!
USE modd_io_surf_fa, ONLY : nunit_fa, nluout, cmask, cprefix1d
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_abor1_sfx
USE modi_error_read_surf_fa
!
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                                  :: KL1, KL2
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
 CHARACTER(LEN=18) :: YNAME ! Field Name
LOGICAL           :: GV8, GFOUND
!
INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: ITDATE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFT2_FA',0,zhook_handle)
!
kresp=0
!
kyear=0
kmonth=0
kday=0
ptime=0.
!
hcomment=""
!
 CALL io_buff(&
               hrec,'R',gfound)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)
ELSE
  ymask=cmask
  IF (gfound) ymask='FULL  '
  yname=trim(ymask)//trim(hrec)
ENDIF
!
WRITE(nluout,*) ' READ_SURFT2_FA : time in 2 dimensions not yet implemented : YNAME=',yname
 CALL abor1_sfx('MODE_READ_SURF_FA:READ_SURFT2_FA: time in 2 dimensions not yet implemented')
!
hcomment = ycomment
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFT2_FA',1,zhook_handle)
!
END SUBROUTINE read_surft2_fa
!
END MODULE mode_read_surf_fa