mode_write_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.
!     ######spl
MODULE mode_write_surf_lfi
!
#ifdef SFX_LFI
!
USE modi_get_luout
INTERFACE write_surf0_lfi
        MODULE PROCEDURE write_surfx0_lfi
        MODULE PROCEDURE write_surfn0_lfi
        MODULE PROCEDURE write_surfl0_lfi
        MODULE PROCEDURE write_surfc0_lfi
END INTERFACE
INTERFACE write_surfn_lfi
        MODULE PROCEDURE write_surfx1_lfi
        MODULE PROCEDURE write_surfn1_lfi
        MODULE PROCEDURE write_surfl1_lfi
        MODULE PROCEDURE write_surfx2_lfi
END INTERFACE
INTERFACE write_surft_lfi
        MODULE PROCEDURE write_surft0_lfi
        MODULE PROCEDURE write_surft1_lfi 
        MODULE PROCEDURE write_surft2_lfi        
END INTERFACE
!
 CONTAINS
!
!     #############################################################
      SUBROUTINE write_surfx0_lfi (&
                                   hrec,pfield,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write a real scalar
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_lfi,        ONLY : cfileout_lfi, cluout_lfi
!
USE modi_io_buff
USE modi_fmwrit
USE modi_error_write_surf_lfi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN) :: hrec     ! name of the article to be read
REAL,               INTENT(IN) :: pfield   ! the real scalar to be read
INTEGER,            INTENT(OUT):: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN) :: hcomment ! comment string
!
!*      0.2   Declarations of local variables
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX0_LFI',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX0_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
 CALL fmwritx0(cfileout_lfi,hrec,cluout_lfi,1,pfield,4,100,hcomment,kresp)
!
 CALL error_write_surf_lfi(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX0_LFI',1,zhook_handle)
!
END SUBROUTINE write_surfx0_lfi
!
!     #############################################################
      SUBROUTINE write_surfn0_lfi (&
                                   hrec,kfield,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write an integer
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_lfi,        ONLY : cfileout_lfi, cluout_lfi, &
                                    lmnh_compatible, niu, nib, nie, nju, njb, nje
!
USE modi_io_buff
USE modi_fmwrit
USE modi_error_write_surf_lfi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN) :: hrec     ! name of the article to be read
INTEGER,            INTENT(IN) :: kfield   ! the integer to be read
INTEGER,            INTENT(OUT):: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN) :: hcomment ! comment string
!
!*      0.2   Declarations of local variables
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFN0_LFI',0,zhook_handle)
!
kresp=0
!
IF (lmnh_compatible .AND. hrec=='IMAX') THEN
  niu = kfield+2
  nib = 2
  nie = kfield+1
END IF
IF (lmnh_compatible .AND. hrec=='JMAX') THEN
  nju = kfield+2
  njb = 2
  nje = kfield+1
END IF
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFN0_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
 CALL fmwritn0(cfileout_lfi,hrec,cluout_lfi,1,kfield,4,100,hcomment,kresp)
!
 CALL error_write_surf_lfi(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFN0_LFI',1,zhook_handle)
!
END SUBROUTINE write_surfn0_lfi
!
!     #############################################################
      SUBROUTINE write_surfl0_lfi (&
                                   hrec,ofield,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write a logical
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_lfi,        ONLY : cfileout_lfi, cluout_lfi
!
USE modi_io_buff
USE modi_fmwrit
USE modi_error_write_surf_lfi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN) :: hrec     ! name of the article to be read
LOGICAL,            INTENT(IN) :: ofield   ! array containing the data field
INTEGER,            INTENT(OUT):: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN) :: hcomment ! comment string
!
!*      0.2   Declarations of local variables
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFL0_LFI',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFL0_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
 CALL fmwritl0(cfileout_lfi,hrec,cluout_lfi,1,ofield,4,100,hcomment,kresp)
!
 CALL error_write_surf_lfi(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFL0_LFI',1,zhook_handle)
!
END SUBROUTINE write_surfl0_lfi
!
!     #############################################################
      SUBROUTINE write_surfc0_lfi (&
                                   hrec,hfield,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write a character
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_lfi,        ONLY : cfileout_lfi, cluout_lfi, lmnh_compatible, lcartesian
!
USE modi_io_buff
USE modi_fmwrit
USE modi_error_write_surf_lfi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN)  :: hrec      ! name of the article to be read
 CHARACTER(LEN=40),  INTENT(IN)  :: hfield    ! the integer to be read
INTEGER,            INTENT(OUT) :: kresp     ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: hcomment  ! comment string
!
!*      0.2   Declarations of local variables
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFC0_LFI',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFC0_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
 CALL fmwritc0(cfileout_lfi,hrec,cluout_lfi,1,hfield,4,100,hcomment,kresp)
!
IF (hrec=="GRID_TYPE") lmnh_compatible = (hfield=="CARTESIAN " .OR. hfield=="CONF PROJ ")
IF (hrec=="GRID_TYPE" .AND. lmnh_compatible) lcartesian=(hfield=="CARTESIAN ")
!
 CALL error_write_surf_lfi(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFC0_LFI',1,zhook_handle)
!
END SUBROUTINE write_surfc0_lfi
!
!     #############################################################
      SUBROUTINE write_surfx1_lfi (&
                                   hrec,pfield,kresp,hcomment,hdir)
!     #############################################################
!
!!****  * - routine to fill a write 1D array for the externalised surface 
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
!
USE modd_surfex_omp, ONLY : lwork0, nworkb
!
USE modd_io_surf_lfi, ONLY : cfileout_lfi, cluout_lfi, nmask, nfull, &
                             lmnh_compatible, niu, nib, nie, nju, njb, nje
!
USE modi_io_buff
USE modi_fmwrit
USE modi_error_write_surf_lfi
USE modi_gather_and_write_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=12),   INTENT(IN) :: hrec     ! name of the article to be read
REAL, DIMENSION(:),  INTENT(IN) :: pfield   ! array containing the data field
INTEGER,             INTENT(OUT):: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),  INTENT(IN) :: 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=20)        :: yrec
INTEGER                  :: ji, jj
DOUBLE PRECISION         :: xtime0
REAL                     :: zundef  ! default value
REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD)))   :: zwork   ! work array read in the file
REAL, DIMENSION(NIU,NJU) :: zwork2d ! work array read in a MNH file
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI',0,zhook_handle)
!
!$OMP BARRIER 
!
!$OMP SINGLE
!
nworkb=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
!
!$OMP END SINGLE
!
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
IF (hdir=='H') CALL gather_and_write_mpi(pfield,zwork,nmask)
!  
IF (nrank==npio) THEN
  !
!$OMP SINGLE
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !   
  IF (hdir=='H') THEN
    !
    CALL get_surf_undef(zundef)
    !
    IF (.NOT. lmnh_compatible) THEN
      CALL fmwritx1(cfileout_lfi,hrec,cluout_lfi,nfull,zwork,4,100,hcomment,nworkb)
      CALL error_write_surf_lfi(hrec,nworkb)
    ELSE
      !
      zwork2d(:,:) = zundef
      DO jj=1,nje-njb+1
        DO ji=1,nie-nib+1
          zwork2d(nib+ji-1,njb+jj-1) = zwork(ji+(nie-nib+1)*(jj-1))
        END DO
      END DO
      !
      IF     (hrec=='DX              ' .OR. hrec=='XX              ') THEN
        yrec = 'XHAT'
        CALL write_in_lfi_x1_for_mnh(hrec,yrec,zwork2d(nib:nie,njb),nworkb,hcomment,niu,nib,nie)
      ELSEIF (hrec=='DY              ' .OR. hrec=='YY              ') THEN
        yrec = 'YHAT'
        CALL write_in_lfi_x1_for_mnh(hrec,yrec,zwork2d(nib,njb:nje),nworkb,hcomment,nju,njb,nje)
      ELSEIF (njb==nje) THEN
         yrec = hrec
        CALL write_in_lfi_x1_for_mnh(hrec,yrec,zwork2d(:,njb),nworkb,hcomment,niu,nib,nie)
      ELSEIF (nib==nie) THEN
        yrec = hrec
        CALL write_in_lfi_x1_for_mnh(hrec,yrec,zwork2d(nib,:),nworkb,hcomment,nju,njb,nje)
      ELSE
        CALL fmwritx2(cfileout_lfi,hrec,cluout_lfi,SIZE(zwork2d),zwork2d,4,100,hcomment,nworkb)
        CALL error_write_surf_lfi(hrec,nworkb)
      ENDIF
      !
    END IF
    !
  ELSE
    CALL fmwritx1(cfileout_lfi,hrec,cluout_lfi,SIZE(pfield),pfield,4,100,hcomment,nworkb)
    CALL error_write_surf_lfi(hrec,nworkb)
  END IF
  ! 
!$OMP END SINGLE
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
kresp = nworkb
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI',1,zhook_handle)
!
 CONTAINS
!
!     #############################################################
      SUBROUTINE write_in_lfi_x1_for_mnh(HREC,HREC2,PFIELD,KRESP,HCOMMENT,KU,KB,KE)
!     #############################################################
!
!!****  * - routine to fill a write 2D array for the externalised surface 
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=12),        INTENT(IN) :: hrec     ! name of the article to be read
 CHARACTER(LEN=20),        INTENT(IN) :: hrec2    ! name of the article to be read
REAL, DIMENSION(:),       INTENT(IN) :: pfield   ! array containing the data field
INTEGER,                  INTENT(OUT):: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),       INTENT(IN) :: hcomment ! comment string
INTEGER,                  INTENT(IN) :: ku
INTEGER,                  INTENT(IN) :: kb
INTEGER,                  INTENT(IN) :: ke
!
!*      0.2   Declarations of local variables
! 
REAL, DIMENSION(KU)      :: zwork ! 1D work array read in the file
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI:WRITE_IN_LFI_X1_FOR_MNH',0,zhook_handle)
!
zwork(:) = 0.
!
SELECT CASE(hrec)
  !
  CASE('DX              ','DY              ')
    IF (kb/=ke) THEN
      IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI:WRITE_IN_LFI_X1_FOR_MNH',1,zhook_handle)
      RETURN
    ENDIF
    zwork(1) = - pfield(1)*0.5  ! 1D case
    zwork(2) =   pfield(1)*0.5
    zwork(3) =   pfield(1)*1.5
  !
  CASE('XX              ','YY              ')
    IF (kb==ke) THEN
      IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI:WRITE_IN_LFI_X1_FOR_MNH',1,zhook_handle)
      RETURN
    ENDIF          
    zwork(kb+1:ke)   = 0.5 * pfield(1:ke-2) + 0.5 * pfield(2:ke-1)
    zwork(kb)        = 1.5 * pfield(1)      - 0.5 * pfield(2)
    zwork(kb-1)      = 2. * zwork(kb) - zwork(kb+1)
    zwork(ke+1)      = 2. * zwork(ke) - zwork(ke-1)
  CASE default
    zwork(:) = pfield(:)
  !  
END SELECT
!
 CALL fmwritx1(cfileout_lfi,hrec2,cluout_lfi,ku,zwork,4,100,hcomment,kresp)
 CALL error_write_surf_lfi(hrec2,kresp)
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX1_LFI:WRITE_IN_LFI_X1_FOR_MNH',1,zhook_handle)
END SUBROUTINE write_in_lfi_x1_for_mnh
!
END SUBROUTINE write_surfx1_lfi
!
!     #############################################################
      SUBROUTINE write_surfx2_lfi (&
                                   hrec,pfield,kresp,hcomment,hdir)
!     #############################################################
!
!!****  * - routine to fill a write 2D array for the externalised surface 
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
USE modd_surfex_omp, ONLY : lwork0, nworkb
!
USE modd_io_surf_lfi,        ONLY : cfileout_lfi, cluout_lfi, nmask, nfull, &
                                    lmnh_compatible, niu, nib, nie, nju, njb, nje
!
USE modi_io_buff
USE modi_fmwrit
USE modi_error_write_surf_lfi
USE modi_gather_and_write_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=12),        INTENT(IN) :: hrec     ! name of the article to be read
REAL, DIMENSION(:,:),     INTENT(IN) :: pfield   ! array containing the data field
INTEGER,                  INTENT(OUT):: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),       INTENT(IN) :: 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
!
DOUBLE PRECISION :: xtime0
REAL             :: zundef  ! default value
REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2)) :: zwork   ! work array read in the file
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX2_LFI',0,zhook_handle)
!
!$OMP BARRIER
!
!$OMP SINGLE
!
nworkb=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
!
!$OMP END SINGLE
!
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX2_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
IF (hdir=='H') CALL gather_and_write_mpi(pfield,zwork,nmask)
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !  
!$OMP SINGLE
  !   
  IF (hdir=='H') THEN
    !
    CALL get_surf_undef(zundef)
    !
    IF (.NOT. lmnh_compatible) THEN
      CALL fmwritx2(cfileout_lfi,hrec,cluout_lfi,SIZE(zwork),zwork,4,100,hcomment,nworkb)
      CALL error_write_surf_lfi(hrec,nworkb)
    ELSE
      CALL write_in_lfi_x2_for_mnh(hrec,zwork,nworkb,hcomment)
    END IF
    !
  ELSE
    CALL fmwritx2(cfileout_lfi,hrec,cluout_lfi,SIZE(pfield),pfield,4,100,hcomment,nworkb)
    CALL error_write_surf_lfi(hrec,nworkb)
  END IF
  !
!$OMP END SINGLE
  !   
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
kresp = nworkb
!
!if (HREC=='ALBVIS_ISBA') stop
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX2_LFI',1,zhook_handle)
!
 CONTAINS
!
!     #############################################################
      SUBROUTINE write_in_lfi_x2_for_mnh(HREC,PFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  * - routine to fill a write 2D array for the externalised surface 
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=12),        INTENT(IN) :: hrec     ! name of the article to be read
REAL, DIMENSION(:,:),     INTENT(IN) :: pfield   ! array containing the data field
INTEGER,                  INTENT(OUT):: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),       INTENT(IN) :: hcomment ! comment string
!
!*      0.2   Declarations of local variables
! 
INTEGER :: ji, jj
REAL    :: zundef
REAL, DIMENSION(NIU,NJU,SIZE(PFIELD,2)) :: zwork3d ! work array read in a MNH file
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX2_LFI:WRITE_IN_LFI_X2_FOR_MNH',0,zhook_handle)
!
 CALL get_surf_undef(zundef)
!
zwork3d=zundef
DO jj=1,nje-njb+1
  DO ji=1,nie-nib+1
    zwork3d(nib+ji-1,njb+jj-1,:) = pfield(ji+(nie-nib+1)*(jj-1),:)
  END DO
END DO
!
IF (nje==njb) THEN
  CALL fmwritx2(cfileout_lfi,hrec,cluout_lfi,SIZE(zwork3d,3)*niu,zwork3d(:,nje,:),4,100,hcomment,kresp)
ELSEIF (nie==nib) THEN
  CALL fmwritx2(cfileout_lfi,hrec,cluout_lfi,SIZE(zwork3d,3)*nju,zwork3d(nie,:,:),4,100,hcomment,kresp)
ELSE
  CALL fmwritx3(cfileout_lfi,hrec,cluout_lfi,SIZE(zwork3d),zwork3d,4,100,hcomment,kresp)
ENDIF
!  
 CALL error_write_surf_lfi(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFX2_LFI:WRITE_IN_LFI_X2_FOR_MNH',1,zhook_handle)
END SUBROUTINE write_in_lfi_x2_for_mnh
!
END SUBROUTINE write_surfx2_lfi
!
!     #############################################################
      SUBROUTINE write_surfn1_lfi (&
                                   hrec,kfield,kresp,hcomment,hdir)
!     #############################################################
!
!!****  * - routine to write an integer array
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
USE modd_surfex_omp, ONLY : lwork0, nworkb
!
USE modd_io_surf_lfi, ONLY : cfileout_lfi, cluout_lfi, nmask, nfull
!
USE modi_io_buff
USE modi_fmwrit
USE modi_error_write_surf_lfi
USE modi_gather_and_write_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=12),      INTENT(IN) :: hrec     ! name of the article to be read
INTEGER, DIMENSION(:),  INTENT(IN) :: kfield   ! the integer to be read
INTEGER,                INTENT(OUT):: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),     INTENT(IN) :: 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, DIMENSION(MAX(NFULL,SIZE(KFIELD))) :: iwork  ! work array read in the file
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFN1_LFI',0,zhook_handle)
!
!$OMP SINGLE
!
nworkb=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
!
!$OMP END SINGLE
!
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFN1_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
IF (hdir=='H') CALL gather_and_write_mpi(kfield,iwork,nmask)
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE
  !    
  IF (hdir=='H') THEN
    CALL fmwritn1(cfileout_lfi,hrec,cluout_lfi,nfull,iwork,4,100,hcomment,nworkb)
  ELSE
    CALL fmwritn1(cfileout_lfi,hrec,cluout_lfi,SIZE(kfield),kfield,4,100,hcomment,nworkb)
  END IF
  !  
!$OMP END SINGLE 
  !
  CALL error_write_surf_lfi(hrec,nworkb)
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !   
ENDIF
!
kresp = nworkb
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFN1_LFI',1,zhook_handle)
!
END SUBROUTINE write_surfn1_lfi
!
!     #############################################################
      SUBROUTINE write_surfl1_lfi (&
                                   hrec,ofield,kresp,hcomment,hdir)
!     #############################################################
!
!!****  * - routine to write a logical array
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
USE modd_surfex_omp, ONLY : lwork0, nworkb
!
USE modd_io_surf_lfi,        ONLY : cfileout_lfi, cluout_lfi
!
USE modi_io_buff
USE modi_get_luout
USE modi_fmwrit
USE modi_abor1_sfx
USE modi_error_write_surf_lfi
!
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=12),      INTENT(IN) :: hrec     ! name of the article to be read
LOGICAL, DIMENSION(:),  INTENT(IN) :: ofield   ! array containing the data field
INTEGER,                INTENT(OUT):: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),     INTENT(IN) :: 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         :: iluout ! listing logical unit
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFL1_LFI',0,zhook_handle)
!
!$OMP SINGLE
nworkb=0
!  
 CALL io_buff(&
                hrec,'W',lwork0)
!$OMP END SINGLE
!
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFL1_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  IF (hdir=='H') THEN
    CALL get_luout('LFI   ',iluout)
    WRITE(iluout,*) 'Error: 1D logical vector for writing on an horizontal grid:'
    WRITE(iluout,*) 'this option is not coded in WRITE_SURFL1_LFI'
    CALL abor1_sfx('MODE_WRITE_SURF_LFI: 1D LOGICAL VECTOR FOR WRITING NOT CODED IN WRITE_SURFL1_LFI')
  ELSE
    !
!$OMP SINGLE
    !
    CALL fmwritl1(cfileout_lfi,hrec,cluout_lfi,SIZE(ofield),ofield,4,100,hcomment,nworkb)
    !
!$OMP END SINGLE
    !    
    CALL error_write_surf_lfi(hrec,nworkb)
  END IF
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
kresp = nworkb
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFL1_LFI',1,zhook_handle)
!
END SUBROUTINE write_surfl1_lfi
!
!     #############################################################
      SUBROUTINE write_surft0_lfi (&
                                   hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write a date
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_lfi,        ONLY : cfileout_lfi, cluout_lfi
!
USE modi_io_buff
USE modi_get_surf_undef
USE modi_fmwrit
USE modi_error_write_surf_lfi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN)  :: hrec     ! name of the article to be read
INTEGER,            INTENT(IN)  :: kyear    ! year
INTEGER,            INTENT(IN)  :: kmonth   ! month
INTEGER,            INTENT(IN)  :: kday     ! day
REAL,               INTENT(IN)  :: ptime    ! time
INTEGER,            INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: hcomment ! comment string

!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=12)     :: yrec     ! Name of the article to be written
INTEGER, DIMENSION(3) :: itdate
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFT0_LFI',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFT0_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
itdate(1) = kyear
itdate(2) = kmonth
itdate(3) = kday
!
yrec=trim(hrec)//'%TDATE'
 CALL fmwritn1(cfileout_lfi,yrec,cluout_lfi,3,itdate,4,100,hcomment,kresp)
 CALL error_write_surf_lfi(hrec,kresp)
!
yrec=trim(hrec)//'%TIME'
 CALL fmwritx0(cfileout_lfi,yrec,cluout_lfi,1,ptime,4,100,hcomment,kresp)
 CALL error_write_surf_lfi(hrec,kresp)
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFT0_LFI',1,zhook_handle)
!
END SUBROUTINE write_surft0_lfi
!
!     #############################################################
      SUBROUTINE write_surft1_lfi (&
                                   hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write a date
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
USE modd_surfex_omp, ONLY : lwork0, nworkb
!
USE modd_io_surf_lfi,        ONLY : cfileout_lfi, cluout_lfi
!
USE modi_io_buff
USE modi_fmwrit
USE modi_error_write_surf_lfi
!
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=12),    INTENT(IN)  :: hrec     ! name of the article to be read
INTEGER, DIMENSION(:), INTENT(IN) :: kyear    ! year
INTEGER, DIMENSION(:), INTENT(IN) :: kmonth   ! month
INTEGER, DIMENSION(:), INTENT(IN) :: kday     ! day
REAL,    DIMENSION(:), INTENT(IN) :: ptime    ! time
INTEGER,            INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: hcomment ! comment string

!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=12) :: yrec     ! Name of the article to be written
INTEGER, DIMENSION(3,SIZE(KYEAR)) :: itdate
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFT1_LFI',0,zhook_handle)
!
!$OMP SINGLE
nworkb = 0
!
 CALL io_buff(&
                hrec,'W',lwork0)
!$OMP END SINGLE
!
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFT1_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !  
  kresp=0
  !
!$OMP SINGLE
  !    
  itdate(1,:) = kyear(:)
  itdate(2,:) = kmonth(:)
  itdate(3,:) = kday(:)
  !
  yrec=trim(hrec)//'%TDATE'
  CALL fmwritn2(cfileout_lfi,yrec,cluout_lfi,SIZE(itdate),itdate,4,100,hcomment,nworkb)
  !
  yrec=trim(hrec)//'%TIME'
  CALL fmwritx1(cfileout_lfi,yrec,cluout_lfi,SIZE(ptime),ptime,4,100,hcomment,nworkb)
  !
!$OMP END SINGLE
  !   
  CALL error_write_surf_lfi(hrec,nworkb)
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
kresp = nworkb
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFT1_LFI',1,zhook_handle)
!
END SUBROUTINE write_surft1_lfi
!
!     #############################################################
      SUBROUTINE write_surft2_lfi (&
                                   hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write a date
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
USE modd_surfex_omp, ONLY : lwork0, nworkb
!
USE modd_io_surf_lfi,        ONLY : cfileout_lfi, cluout_lfi
!
USE modi_io_buff
USE modi_fmwrit
USE modi_error_write_surf_lfi
!
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=12),    INTENT(IN)  :: hrec     ! name of the article to be read
INTEGER, DIMENSION(:,:), INTENT(IN) :: kyear    ! year
INTEGER, DIMENSION(:,:), INTENT(IN) :: kmonth   ! month
INTEGER, DIMENSION(:,:), INTENT(IN) :: kday     ! day
REAL,    DIMENSION(:,:), INTENT(IN) :: ptime    ! time
INTEGER,            INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: hcomment ! comment string

!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=12) :: yrec     ! Name of the article to be written
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFT2_LFI',0,zhook_handle)
!
!$OMP SINGLE
nworkb = 0
!
 CALL io_buff(&
                hrec,'W',lwork0)
!$OMP END SINGLE
!
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFT2_LFI',1,zhook_handle)
IF (lwork0) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !  
  kresp=0
  !
!$OMP SINGLE
  !    
  !
  yrec=trim(hrec)//'%YEAR'
  CALL fmwritn2(cfileout_lfi,yrec,cluout_lfi,SIZE(kyear),kyear,4,100,hcomment,nworkb)
  !
  yrec=trim(hrec)//'%MONTH'
  CALL fmwritn2(cfileout_lfi,yrec,cluout_lfi,SIZE(kmonth),kmonth,4,100,hcomment,nworkb)
  !
  yrec=trim(hrec)//'%DAY'
  CALL fmwritn2(cfileout_lfi,yrec,cluout_lfi,SIZE(kday),kday,4,100,hcomment,nworkb)  
  !
  yrec=trim(hrec)//'%TIME'
  CALL fmwritx2(cfileout_lfi,yrec,cluout_lfi,SIZE(ptime),ptime,4,100,hcomment,nworkb)
  !
!$OMP END SINGLE
  !   
  CALL error_write_surf_lfi(hrec,nworkb)
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
kresp = nworkb
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_LFI:WRITE_SURFT2_LFI',1,zhook_handle)
!
END SUBROUTINE write_surft2_lfi
!
#endif
!
END MODULE mode_write_surf_lfi
!