mode_read_surf_lfi.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_lfi
!
!!    PURPOSE
!!    -------
!
!       The purpose of READ_SURF_LFI is
!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      S.Malardel      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                     01/08/03
!----------------------------------------------------------------------------
!
#ifdef SFX_LFI
!
INTERFACE read_surf0_lfi
        MODULE PROCEDURE read_surfx0_lfi
        MODULE PROCEDURE read_surfn0_lfi
        MODULE PROCEDURE read_surfl0_lfi
        MODULE PROCEDURE read_surfc0_lfi
END INTERFACE
INTERFACE read_surfn_lfi
        MODULE PROCEDURE read_surfx1_lfi
        MODULE PROCEDURE read_surfn1_lfi
        MODULE PROCEDURE read_surfl1_lfi
        MODULE PROCEDURE read_surfx2_lfi
END INTERFACE
INTERFACE read_surft_lfi
        MODULE PROCEDURE read_surft0_lfi
        MODULE PROCEDURE read_surft1_lfi
        MODULE PROCEDURE read_surft2_lfi
END INTERFACE
!
 CONTAINS
!
!     #############################################################
      SUBROUTINE read_surfx0_lfi(HREC,PFIELD,KRESP,HCOMMENT)
!     #############################################################
!
USE modd_io_surf_lfi,        ONLY : cfile_lfi, cluout_lfi
!
USE modi_fmread
USE modi_error_read_surf_lfi
!
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
!
INTEGER          :: igrid   ! position of data on grid
INTEGER          :: ilench  ! length of comment string
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFX0_LFI',0,zhook_handle)
!
kresp=0
!
 CALL fmreadx0(cfile_lfi,hrec,cluout_lfi,1,pfield,igrid,ilench,hcomment,kresp)
!
 CALL error_read_surf_lfi(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFX0_LFI',1,zhook_handle)
!
END SUBROUTINE read_surfx0_lfi
!
!     #############################################################
      SUBROUTINE read_surfx1_lfi(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 : xworkd, nworkb
!
USE modd_io_surf_lfi, ONLY : cfile_lfi, cluout_lfi, nmask, nfull, &
                             lmnh_compatible  
!
USE modi_fmread
USE modi_error_read_surf_lfi
USE modi_read_and_send_mpi
USE modi_get_surf_undef
!
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=18) :: yrec
REAL              :: zundef  ! default value
INTEGER           :: igrid   ! position of data on grid
INTEGER           :: ilench  ! length of comment string
INTEGER           :: iversion, ibugfix
INTEGER           :: il1, infompi
!
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: istatus
#endif
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFX1_LFI',0,zhook_handle)
!
!$OMP BARRIER
!
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))
  ENDIF
  !
  yrec = hrec
  !
  !---------------------------------------------------------------------------
  !* patch to read some test files done before version 3.5
  !  this should be removed once all tests with reading lfi files done with 923
  !  configuration (with these early versions) are finished.
  !
  IF (hrec(1:2)=='D_') THEN
    CALL fmreadn0(cfile_lfi,'VERSION',cluout_lfi,1,iversion,igrid,ilench,hcomment,nworkb)
    CALL fmreadn0(cfile_lfi,'BUG',cluout_lfi,1,ibugfix,igrid,ilench,hcomment,nworkb)
    IF (iversion<=2 .OR. (iversion==3 .AND. ibugfix<=5)) yrec = 'DATA_'//hrec(3:12)
  END IF
  !---------------------------------------------------------------------------
  !
  IF (hdir=='H' .OR. hdir=='A') THEN
    IF (.NOT. lmnh_compatible) THEN
      CALL fmreadx1(cfile_lfi,yrec,cluout_lfi,nfull,xworkd,igrid,ilench,hcomment,nworkb)
    ELSE
      CALL read_in_lfi_x1_for_mnh(yrec,xworkd,nworkb,hcomment,hdir)
    END IF
  ELSE
    CALL fmreadx1(cfile_lfi,yrec,cluout_lfi,il1,xworkd,igrid,ilench,hcomment,nworkb)
  END IF
  CALL error_read_surf_lfi(yrec,nworkb)
  !
!$OMP END SINGLE
  !  
ELSEIF (hdir/='-') THEN
!$OMP SINGLE
  ALLOCATE(xworkd(0))
!$OMP END SINGLE
ENDIF
!
kresp = nworkb
!
#ifdef SFX_MPI
xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
!
IF (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    
  IF (nproc>1) THEN
#ifdef SFX_MPI
    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(:)
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_LFI:READ_SURFX1_LFI',1,zhook_handle)
!
 CONTAINS
!
!     #############################################################
      SUBROUTINE read_in_lfi_x1_for_mnh(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  * - routine to fill a read 2D array for the externalised surface 
!
USE modd_io_surf_lfi,        ONLY : cfile_lfi, cluout_lfi, &
                                    niu, nib, nie, nju, njb, nje
!
USE modi_fmread
USE modi_error_read_surf_lfi
!
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, 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 string
 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)   :: yrec1d
INTEGER :: ji, jj
INTEGER :: ilen
INTEGER :: igrid, ilench
REAL, DIMENSION(:),   ALLOCATABLE :: zwork1d! 1D work array read in the file
REAL, DIMENSION(:,:), ALLOCATABLE :: zwork2d ! work array read in a MNH file
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFX1_LFI:READ_IN_LFI_X1_FOR_MNH',0,zhook_handle)
!
ALLOCATE(zwork2d(niu,nju))
zwork2d(:,:) = 999.
!
IF (hrec=='XX                 ' .OR. hrec=='DX                 ') THEN
  ALLOCATE(zwork1d(niu))
  yrec1d = 'XHAT'
  ilen   = niu
ELSEIF (hrec=='YY                 ' .OR. hrec=='DY                 ') THEN
  ALLOCATE(zwork1d(nju))
  yrec1d = 'YHAT'
  ilen   = nju
ELSEIF (njb==nje) THEN
  ALLOCATE(zwork1d(niu))
  zwork1d(:) = 999.
ELSEIF (nib==nie) THEN
  ALLOCATE(zwork1d(nju))
  zwork1d(:) = 999. 
ENDIF
!
IF (hrec=='XX' .OR. hrec=='YY'.OR. hrec=='DX' .OR. hrec=='DY') THEN
!
  CALL fmreadx1(cfile_lfi,yrec1d,cluout_lfi,ilen,zwork1d,igrid,ilench,hcomment,kresp)
  CALL error_read_surf_lfi(yrec1d,kresp)
!
  SELECT CASE(hrec)
    CASE('XX                  ')
      DO jj = 1,SIZE(zwork2d,2)
        zwork2d(nib:nie,jj) = 0.5 * zwork1d(nib:nie) + 0.5 * zwork1d(nib+1:nie+1)
      END DO
    CASE('DX                  ')
      DO jj = 1,SIZE(zwork2d,2)
        zwork2d(nib:nie,jj) = - zwork1d(nib:nie) + zwork1d(nib+1:nie+1)
      END DO
    CASE('YY                  ')
      DO ji = 1,SIZE(zwork2d,1)
        zwork2d(ji,njb:nje) = 0.5 * zwork1d(njb:nje) + 0.5 * zwork1d(njb+1:nje+1)
      END DO
    CASE('DY                  ')
      DO ji = 1,SIZE(zwork2d,1)
        zwork2d(ji,njb:nje) = - zwork1d(njb:nje) + zwork1d(njb+1:nje+1)
      END DO
  END SELECT
!
  DEALLOCATE(zwork1d)
!
ELSEIF (njb==nje) THEN
!
  CALL fmreadx1(cfile_lfi,yrec,cluout_lfi,SIZE(zwork1d),zwork1d,igrid,ilench,hcomment,kresp)
  DO jj = 1,SIZE(zwork2d,2)
    zwork2d(nib:nie,jj) = zwork1d(nib:nie)
  END DO
!
  DEALLOCATE(zwork1d) 
!
ELSEIF (nib==nie) THEN
!
  CALL fmreadx1(cfile_lfi,yrec,cluout_lfi,SIZE(zwork1d),zwork1d,igrid,ilench,hcomment,kresp) 
  DO ji = 1,SIZE(zwork2d,1)
    zwork2d(ji,njb:nje) = zwork1d(njb:nje)
  END DO
!
  DEALLOCATE(zwork1d)
!
ELSE
!
  CALL fmreadx2(cfile_lfi,hrec,cluout_lfi,SIZE(zwork2d),zwork2d,igrid,ilench,hcomment,kresp)
!
ENDIF
!
DO jj=1,nje-njb+1
  DO ji=1,nie-nib+1
    pfield(ji+(nie-nib+1)*(jj-1)) = zwork2d(nib+ji-1,njb+jj-1) 
  END DO
END DO
!
DEALLOCATE(zwork2d) 
!  
 CALL error_read_surf_lfi(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFX1_LFI:READ_IN_LFI_X1_FOR_MNH',1,zhook_handle)
!
END SUBROUTINE read_in_lfi_x1_for_mnh
!
END SUBROUTINE read_surfx1_lfi
!
!     #############################################################
      SUBROUTINE read_surfx2_lfi(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
!
USE modd_io_surf_lfi, ONLY : cfile_lfi, cluout_lfi, nmask, nfull, &
                             lmnh_compatible  
!
USE modi_fmread
USE modi_error_read_surf_lfi
USE modi_read_and_send_mpi
USE modi_get_surf_undef
!
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=16) :: yrec
REAL              :: zundef  ! default value
INTEGER           :: igrid   ! position of data on grid
INTEGER           :: ilench  ! length of comment string
INTEGER           :: iversion, ibugfix
INTEGER           :: il1, il2, infompi
!
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: istatus
#endif
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFX2_LFI',0,zhook_handle)
!
!$OMP BARRIER
!
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))
  ENDIF
  !
  yrec = hrec
  !
  !---------------------------------------------------------------------------
  !* patch to read some test files done before version 3.5
  !  this should be removed once all tests with reading lfi files done with 923
  !  configuration (with these early versions) are finished.
  !
  IF (hrec(1:2)=='D_') THEN
    CALL fmreadn0(cfile_lfi,'VERSION',cluout_lfi,1,iversion,igrid,ilench,hcomment,nworkb)
    CALL fmreadn0(cfile_lfi,'BUG',cluout_lfi,1,ibugfix,igrid,ilench,hcomment,nworkb)
    IF (iversion<=2 .OR. (iversion==3 .AND. ibugfix<=5)) yrec = 'DATA_'//hrec(3:12)
    IF (yrec(13:15)=='SOI') yrec=yrec(1:15)//'L'
    IF (yrec(12:14)=='SOI') yrec=yrec(1:14)//'L'
  END IF
  !---------------------------------------------------------------------------
  !
  IF (hdir=='H' .OR. hdir=='A') THEN
    IF (.NOT. lmnh_compatible) THEN
      CALL fmreadx2(cfile_lfi,yrec,cluout_lfi,SIZE(xworkd2),xworkd2(:,:),igrid,ilench,hcomment,nworkb)
     ELSE
      CALL read_in_lfi_x2_for_mnh(yrec,xworkd2,nworkb,hcomment,hdir)
    END IF
  ELSE
    CALL fmreadx2(cfile_lfi,yrec,cluout_lfi,il1*il2,xworkd2(:,:),igrid,ilench,hcomment,nworkb)
  END IF
  CALL error_read_surf_lfi(yrec,nworkb)
  !
!$OMP END SINGLE
  !  
ELSEIF (hdir/='-') THEN
  ALLOCATE(xworkd2(0,0))
ENDIF
!
kresp = nworkb
!
#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: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          
  IF (nproc>1) THEN
#ifdef SFX_MPI
    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 
  pfield(:,:) = xworkd2(1:il1,:)  
ELSE
  CALL read_and_send_mpi(xworkd2,pfield,nmask)
ENDIF
!
!$OMP BARRIER
!
!$OMP SINGLE
DEALLOCATE(xworkd2)
!$OMP END SINGLE
!
IF (hdir=='H' .OR. hdir=='A') THEN
  CALL get_surf_undef(zundef)
  WHERE(pfield==999.) pfield=zundef
ENDIF
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFX2_LFI',1,zhook_handle)
!
 CONTAINS
!
!     #############################################################
      SUBROUTINE read_in_lfi_x2_for_mnh(HREC,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  * - routine to fill a read 2D array for the externalised surface 
!
USE modd_io_surf_lfi,        ONLY : cfile_lfi, cluout_lfi, &
                                    niu, nib, nie, nju, njb, nje
!
USE modi_fmread
USE modi_error_read_surf_lfi
!
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, 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 string
 CHARACTER(LEN=1),         INTENT(IN) :: hdir     ! type of field :
                                                 ! 'H' : field with
                                                 !       horizontal spatial dim.
                                                 ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
! 
INTEGER :: ji, jj
INTEGER :: igrid, ilench
REAL, DIMENSION(:,:,:), ALLOCATABLE :: zwork3d ! work array read in a MNH file
REAL, DIMENSION(:,:), ALLOCATABLE :: zwork2d
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFX2_LFI:READ_IN_LFI_X2_FOR_MNH',0,zhook_handle)
!
ALLOCATE(zwork3d(niu,nju,SIZE(pfield,2)))
zwork3d(:,:,:) = 999.
!
IF (njb==nje) THEN
  ALLOCATE(zwork2d(niu,SIZE(pfield,2)))
  zwork2d(:,:) = 999.
ELSEIF (nib==nie) THEN
  ALLOCATE(zwork2d(nju,SIZE(pfield,2)))
  zwork2d(:,:) = 999. 
ENDIF
!
IF (njb==nje) THEN
!
  CALL fmreadx2(cfile_lfi,yrec,cluout_lfi,SIZE(zwork2d),zwork2d,igrid,ilench,hcomment,kresp)
  DO jj = 1,SIZE(zwork3d,2)
    zwork3d(nib:nie,jj,:) = zwork2d(nib:nie,:)
  END DO
!
  DEALLOCATE(zwork2d) 
!
ELSEIF (nib==nie) THEN
!
  CALL fmreadx2(cfile_lfi,yrec,cluout_lfi,SIZE(zwork2d),zwork2d,igrid,ilench,hcomment,kresp)
  DO ji = 1,SIZE(zwork3d,1)
    zwork3d(ji,nib:nie,:) = zwork2d(njb:nje,:)
  END DO  
!
  DEALLOCATE(zwork2d)
!
ELSE
!
  CALL fmreadx3(cfile_lfi,hrec,cluout_lfi,SIZE(zwork3d),zwork3d,igrid,ilench,hcomment,kresp)
!
ENDIF
!
DO jj=1,nje-njb+1
  DO ji=1,nie-nib+1
    pfield(ji+(nie-nib+1)*(jj-1),:) = zwork3d(nib+ji-1,njb+jj-1,:) 
  END DO
END DO
DEALLOCATE(zwork3d)
!  
 CALL error_read_surf_lfi(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFX2_LFI:READ_IN_LFI_X2_FOR_MNH',1,zhook_handle)
!
END SUBROUTINE read_in_lfi_x2_for_mnh
!
END SUBROUTINE read_surfx2_lfi
!
!     #############################################################
      SUBROUTINE read_surfn0_lfi(HREC,KFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READN0* - routine to read an integer
!!      B. Decharme 07/2011 : Grdid dimension only read in pgd file
!
USE modd_io_surf_lfi, ONLY : cfile_lfi, cluout_lfi, cfilepgd_lfi, &
                             lmnh_compatible, niu, nib, nie, nju, njb, nje
!
USE modd_surfex_omp, ONLY : nblock
!
USE modi_fmread
USE modi_error_read_surf_lfi
!
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=40) :: ygrid
INTEGER           :: igrid   ! position of data on grid
INTEGER           :: ilench  ! length of comment string
INTEGER           :: iimax, ijmax
INTEGER           :: inb ! number of articles in the file
INTEGER           :: iresp
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFN0_LFI',0,zhook_handle)
!
kresp=0
!
 CALL fmreadn0(cfile_lfi,hrec,cluout_lfi,1,kfield,igrid,ilench,hcomment,kresp)
!
 CALL error_read_surf_lfi(hrec,kresp)
!
!* tests compatibility with MesoNH files
!
IF (hrec/='DIM_FULL' .AND. lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFN0_LFI',1,zhook_handle)
IF (hrec/='DIM_FULL') RETURN
!
!-----------------------------------------------------------------------------------------------------
! READ PGD FILE
!-----------------------------------------------------------------------------------------------------
!
!IF (CFILE_LFI/=CFILEPGD_LFI) THEN
!  CALL FMOPEN(CFILEPGD_LFI,'OLD',CLUOUT_LFI,0,1,1,INB,IRESP)
!ENDIF
!
 CALL fmreadc0(cfile_lfi,'GRID_TYPE ',cluout_lfi,1,ygrid,igrid,ilench,hcomment,kresp)
 CALL error_read_surf_lfi('GRID_TYPE ',kresp)
lmnh_compatible = (ygrid=="CARTESIAN " .OR. ygrid=="CONF PROJ ")
!
IF (lmnh_compatible) THEN
  CALL fmreadn0(cfile_lfi,'IMAX',cluout_lfi,1,iimax,igrid,ilench,hcomment,kresp)
  CALL error_read_surf_lfi('IMAX',kresp)
  niu = iimax+2
  nib = 2
  nie = iimax+1
  CALL fmreadn0(cfile_lfi,'JMAX',cluout_lfi,1,ijmax,igrid,ilench,hcomment,kresp)
  CALL error_read_surf_lfi('JMAX',kresp)
  nju = ijmax+2
  njb = 2
  nje = ijmax+1
END IF
!
!IF(CFILE_LFI/=CFILEPGD_LFI)THEN
!  CALL FMCLOS(CFILEPGD_LFI,'KEEP',CLUOUT_LFI,IRESP)
!ENDIF
!
!-----------------------------------------------------------------------------------------------------
! END READ PGD FILE
!-----------------------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFN0_LFI',1,zhook_handle)
!
END SUBROUTINE read_surfn0_lfi
!
!     #############################################################
      SUBROUTINE read_surfn1_lfi(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 : nworkd, nworkb
!
USE modd_io_surf_lfi,        ONLY : cfile_lfi, cluout_lfi, nmask, nfull
!
USE modi_fmread
USE modi_error_read_surf_lfi
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
!
INTEGER          :: igrid   ! position of data on grid
INTEGER          :: ilench  ! length of comment string
INTEGER          :: il1, infompi
!
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: istatus
#endif
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFN1_LFI',0,zhook_handle)
!
!$OMP BARRIER
!
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))
  ENDIF 
  !  
  IF (hdir=='H')  THEN
    CALL fmreadn1(cfile_lfi,hrec,cluout_lfi,nfull,nworkd,igrid,ilench,hcomment,nworkb)
  ELSE
    CALL fmreadn1(cfile_lfi,hrec,cluout_lfi,il1,nworkd(:),igrid,ilench,hcomment,nworkb)
  END IF
  !
!$OMP END SINGLE 
  !  
  CALL error_read_surf_lfi(hrec,nworkb)
  !
ENDIF
!
kresp = nworkb
!
#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: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
  IF (nproc>1) THEN
#ifdef SFX_MPI
    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_LFI:READ_SURFN1_LFI',1,zhook_handle)
!
END SUBROUTINE read_surfn1_lfi
!
!     #############################################################
      SUBROUTINE read_surfc0_lfi(HREC,HFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READC0* - routine to read a character
!
USE modd_io_surf_lfi,        ONLY : cfile_lfi, cluout_lfi
!
USE modi_fmread
USE modi_error_read_surf_lfi
!
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          :: igrid   ! position of data on grid
INTEGER          :: ilench  ! length of comment string
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFC0_LFI',0,zhook_handle)
!
kresp=0
!
 CALL fmreadc0(cfile_lfi,hrec,cluout_lfi,1,hfield,igrid,ilench,hcomment,kresp)
!
 CALL error_read_surf_lfi(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFC0_LFI',1,zhook_handle)
!
END SUBROUTINE read_surfc0_lfi
!
!     #############################################################
      SUBROUTINE read_surfl0_lfi(HREC,OFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READL0* - routine to read a logical
!
USE modd_io_surf_lfi,        ONLY : cfile_lfi, cluout_lfi
!
USE modi_fmread
USE modi_error_read_surf_lfi
!
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
!
INTEGER          :: igrid   ! position of data on grid
INTEGER          :: ilench  ! length of comment string
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFL0_LFI',0,zhook_handle)
!
kresp=0
!
 CALL fmreadl0(cfile_lfi,hrec,cluout_lfi,1,ofield,igrid,ilench,hcomment,kresp)
!
 CALL error_read_surf_lfi(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFL0_LFI',1,zhook_handle)
!
END SUBROUTINE read_surfl0_lfi
!
!     #############################################################
      SUBROUTINE read_surfl1_lfi(HREC,OFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *READL1* - routine to read a logical array
!
USE modd_surfex_mpi, ONLY : nrank, nproc, ncomm, npio, xtime_npio_read, xtime_comm_read
!
USE modd_surfex_omp, ONLY : lworkd, nworkb
!
USE modd_io_surf_lfi,        ONLY : cfile_lfi, cluout_lfi
!
USE modi_fmread
USE modi_error_read_surf_lfi
USE modi_abor1_sfx
USE modi_get_luout
!
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
!
INTEGER :: iluout
INTEGER :: igrid   ! position of data on grid
INTEGER :: ilench  ! length of comment string
INTEGER :: il1, infompi
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFL1_LFI',0,zhook_handle)
!
!$OMP BARRIER
!
il1 = SIZE(ofield)
!
#ifdef SFX_MPI
xtime0 = mpi_wtime()
#endif
!
!$OMP SINGLE
nworkb=0
ALLOCATE(lworkd(il1))
!$OMP END SINGLE
!
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !   
  IF (hdir=='H') THEN
    CALL get_luout('LFI   ',iluout)
    WRITE(iluout,*) 'Error: 1D logical vector for reading on an horizontal grid:'
    WRITE(iluout,*) 'this option is not coded in READ_SURFL1_LFI'
    CALL abor1_sfx('MODE_READ_SURF_LFI: 1D LOGICAL VECTOR FOR READING NOT CODED IN READ_SURFL1_LFI')
  END IF
  !
  CALL fmreadl1(cfile_lfi,hrec,cluout_lfi,il1,lworkd,igrid,ilench,hcomment,nworkb)
  !
!$OMP END SINGLE
  !
  CALL error_read_surf_lfi(hrec,nworkb)
  !
ENDIF
!
kresp = nworkb
!
#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,il1,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_LFI:READ_SURFL1_LFI',1,zhook_handle)
!
END SUBROUTINE read_surfl1_lfi
!
!     #############################################################
      SUBROUTINE read_surft0_lfi(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READT0* - routine to read a date
!
USE modd_io_surf_lfi,  ONLY : cfile_lfi, cluout_lfi  
!
USE modi_fmread
USE modi_error_read_surf_lfi
!
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=12)     :: yrec     ! Name of the article to be read
INTEGER, DIMENSION(3) :: itdate
!
INTEGER          :: igrid   ! position of data on grid
INTEGER          :: ilench  ! length of comment string
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFT0_LFI',0,zhook_handle)
!
kresp=0
!
yrec=trim(hrec)//'%TDATE'
 CALL fmreadn1(cfile_lfi,yrec,cluout_lfi,3,itdate,igrid,ilench,hcomment,kresp)
 CALL error_read_surf_lfi(hrec,kresp)
!
yrec=trim(hrec)//'%TIME'
 CALL fmreadx0(cfile_lfi,yrec,cluout_lfi,1,ptime,igrid,ilench,hcomment,kresp)
 CALL error_read_surf_lfi(hrec,kresp)
!
kyear  = itdate(1)
kmonth = itdate(2)
kday   = itdate(3)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFT0_LFI',1,zhook_handle)
!
END SUBROUTINE read_surft0_lfi
!
!     #############################################################
      SUBROUTINE read_surft1_lfi(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READT0* - routine to read a date
!
USE modd_io_surf_lfi,        ONLY : cfile_lfi, cluout_lfi  
!
USE modi_fmread
USE modi_error_read_surf_lfi
!
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=12)     :: yrec     ! Name of the article to be read
INTEGER          :: iluout
INTEGER          :: igrid   ! position of data on grid
INTEGER          :: ilench  ! length of comment string
INTEGER, DIMENSION(3,SIZE(KYEAR)) :: itdate
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFT1_LFI',0,zhook_handle)
!
kresp=0
!
yrec=trim(hrec)//'%TDATE'
 CALL fmreadn2(cfile_lfi,yrec,cluout_lfi,SIZE(itdate),itdate,igrid,ilench,hcomment,kresp)
 CALL error_read_surf_lfi(hrec,kresp)
!
yrec=trim(hrec)//'%TIME'
 CALL fmreadx1(cfile_lfi,yrec,cluout_lfi,SIZE(ptime),ptime,igrid,ilench,hcomment,kresp)
 CALL error_read_surf_lfi(hrec,kresp)
!
kyear(:) = itdate(1,:)
kmonth(:) = itdate(2,:)
kday(:) = itdate(3,:)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFT1_LFI',1,zhook_handle)
!
END SUBROUTINE read_surft1_lfi
!
!     #############################################################
      SUBROUTINE read_surft2_lfi(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *READT0* - routine to read a date
!
USE modd_io_surf_lfi,        ONLY : cfile_lfi, cluout_lfi  
!
USE modi_fmread
USE modi_error_read_surf_lfi
!
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=12)     :: yrec     ! Name of the article to be read
INTEGER          :: iluout
INTEGER          :: igrid   ! position of data on grid
INTEGER          :: ilench  ! length of comment string
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFT2_LFI',0,zhook_handle)
!
kresp=0
!
yrec=trim(hrec)//'%YEAR'
 CALL fmreadn2(cfile_lfi,yrec,cluout_lfi,SIZE(kyear),kyear,igrid,ilench,hcomment,kresp)
 CALL error_read_surf_lfi(hrec,kresp)
!
yrec=trim(hrec)//'%MONTH'
 CALL fmreadn2(cfile_lfi,yrec,cluout_lfi,SIZE(kmonth),kmonth,igrid,ilench,hcomment,kresp)
 CALL error_read_surf_lfi(hrec,kresp)
!
yrec=trim(hrec)//'%DAY'
 CALL fmreadn2(cfile_lfi,yrec,cluout_lfi,SIZE(kday),kday,igrid,ilench,hcomment,kresp)
 CALL error_read_surf_lfi(hrec,kresp)
!
yrec=trim(hrec)//'%TIME'
 CALL fmreadx2(cfile_lfi,yrec,cluout_lfi,SIZE(ptime),ptime,igrid,ilench,hcomment,kresp)
 CALL error_read_surf_lfi(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_READ_SURF_LFI:READ_SURFT2_LFI',1,zhook_handle)
!
END SUBROUTINE read_surft2_lfi
!
#endif
!
END MODULE mode_read_surf_lfi