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_surfex_omp, ONLY : lwork0
!
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
!
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',lwork0)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)
ELSE
  ymask=cmask
  IF (lwork0) 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_omp, ONLY : xworkd, nworkb, cwork0
!
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, nfull_ext, &
                            ndgl, ndlon, ndgux, ndlux, cprefix1d
!
USE mode_fasurfex
!
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) :: istatus
#endif
!
REAL, DIMENSION(:), ALLOCATABLE :: zwork2
REAL   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_FA:READ_SURFX1_FA',0,zhook_handle)
!
!$OMP BARRIER
!
!$OMP SINGLE
nworkb=0
!$OMP END SINGLE
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !
  ALLOCATE(xworkd(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,nworkb)
    DO j=1,ndgux
      DO i=1,ndlux
        xworkd((j-1)*ndlux + i) = zwork2((j-1)*ndlon + i)
      ENDDO
    ENDDO
    DEALLOCATE(zwork2)
    cwork0 = trim(hrec)
  ELSE
    CALL sfx_fa_version(gv8)
    IF(gv8)THEN
      yprefix=cprefix1d
    ELSE
      yprefix='S1D_'
    ENDIF
    CALL facile(nworkb,nunit_fa,yprefix,0,hrec,xworkd,.false.)
    IF (nworkb/=0) CALL error_read_surf_fa(hrec,nworkb)  
    cwork0 = yprefix//trim(hrec)
  ENDIF
  !
!$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 (hdir=='A') THEN  ! no distribution on other tasks
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    pfield(:) = xworkd(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
!$OMP SINGLE
    xtime0 = mpi_wtime()
    CALL mpi_bcast(nfull,kind(nfull)/4,mpi_integer,npio,ncomm,infompi)
    IF ( nrank/=npio ) ALLOCATE(xworkd(nfull))
    CALL mpi_bcast(xworkd(1:kl),kl*kind(xworkd)/4,mpi_real,npio,ncomm,infompi)
    xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
!$OMP END SINGLE
  ENDIF
#endif
  pfield(:) = xworkd(1:kl)
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_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_omp, ONLY : xworkd2, nworkb, cwork0
!
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, cprefix2d
!
USE mode_fasurfex
!
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) :: istatus
#endif
REAL, DIMENSION(:,:), ALLOCATABLE :: zwork   ! 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)
!
!$OMP BARRIER
!
!$OMP SINGLE
nworkb=0
!$OMP END SINGLE
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !
  ALLOCATE(xworkd2(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(nworkb,nunit_fa,yprefix,jl,hrec,xworkd2(:,jl),.false.)
     IF (nworkb/=0) THEN
       cwork0 = yprefix//trim(hrec)
       CALL error_read_surf_fa(cwork0,nworkb)
     ENDIF  
  END DO
  !
  cwork0 = 'PATCH_'//trim(hrec)
  !
!$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 (hdir=='A') THEN  ! no distribution on other tasks
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    pfield(:,:) = xworkd2(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
!$OMP SINGLE
#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(xworkd2(nfull,kl2))    
    CALL mpi_bcast(xworkd2(1:kl1,1:kl2),kl1*kl2*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:kl1,1:kl2)
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_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_surfex_omp, ONLY : lwork0
!
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
!
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',lwork0)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)
ELSE
  ymask=cmask
  IF (lwork0) 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_surfex_omp, ONLY : lwork0, cwork0, nworkd, nworkb
!
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
!
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)
!
!$OMP SINGLE
nworkb = 0
!$OMP END SINGLE
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
IF (hdir=='-') THEN
!$OMP SINGLE
  ALLOCATE(nworkd(kl))
!$OMP END SINGLE
ENDIF
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !  
  CALL io_buff(&
               hrec,'R',lwork0)
  !
  CALL sfx_fa_version(gv8)
  IF(gv8)THEN
    yname=cprefix1d//trim(hrec)
  ELSE
    ymask=cmask
    IF (lwork0) ymask='FULL  '
    yname=trim(ymask)//trim(hrec)
  ENDIF
  !
  IF (hdir=='A') THEN
    ALLOCATE(nworkd(kl))
  ELSEIF (hdir/='-') THEN
    ALLOCATE(nworkd(nfull))
  END IF    
  !
  CALL falit_i_d(nworkb,nunit_fa,yname,SIZE(nworkd),nworkd)
  IF (nworkb/=0) CALL error_read_surf_fa(hrec,nworkb)
  !
  cwork0 = yname
  !
!$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 (hdir=='A') THEN  ! no distribution on other tasks
  IF ( nrank==npio ) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    kfield(:) = nworkd(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
!$OMP SINGLE
#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(nworkd(nfull))    
    CALL mpi_bcast(nworkd(1:kl),kl*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:kl)
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_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_surfex_omp, ONLY : lwork0
!
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
!
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',lwork0)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)
ELSE
  ymask=cmask
  IF (lwork0) 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_surfex_omp, ONLY : lwork0
!
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
!
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',lwork0)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)
ELSE
  ymask=cmask
  IF (lwork0) 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_omp, ONLY : lwork0, lworkd, nworkb, cwork0
!
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
!
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
!
!$OMP SINGLE
nworkb = 0
!
ALLOCATE(lworkd(kl))
!$OMP END SINGLE
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !
  CALL io_buff(&
               hrec,'R',lwork0)
  !
  CALL sfx_fa_version(gv8)
  IF(gv8)THEN
    yname=cprefix1d//trim(hrec)
  ELSE
    ymask=cmask
    IF (lwork0) ymask='FULL  '
    yname=trim(ymask)//trim(hrec)
  ENDIF
  !
  CALL falit_l_d(nworkb,nunit_fa,yname,kl,lworkd)
  IF (nworkb/=0) CALL error_read_surf_fa(hrec,nworkb)
  !
  cwork0 = yname
  !
!$OMP END SINGLE
  !
ENDIF
!
kresp = nworkb
hcomment = cwork0
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
#ifdef SFX_MPI
IF (nproc>1 .AND. hdir/='A') THEN
!$OMP SINGLE         
  xtime0 = mpi_wtime()
  CALL mpi_bcast(lworkd,kl,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_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_surfex_omp, ONLY : lwork0
!
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
!
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',lwork0)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)//'%TDATE'
ELSE
  ymask=cmask
  IF (lwork0) 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 (lwork0) 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_surfex_omp, ONLY : lwork0
!
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
!
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',lwork0)
!
 CALL sfx_fa_version(gv8)
IF(gv8)THEN
  yname=cprefix1d//trim(hrec)
ELSE
  ymask=cmask
  IF (lwork0) 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