write_surf.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 modi_write_surf
!##################
!
!----------------------------------------------------
!!    MODIFICATIONS
!!    -------------
!!      Original       
!!      J.Escobar      10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
!----------------------------------------------------
!
  INTERFACE write_surf
!
     SUBROUTINE write_surfx0 (DGU, U, &
                              hprogram,hrec,pfield,kresp,hcomment)
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),  INTENT(IN) :: hprogram ! calling program
 CHARACTER(LEN=*),  INTENT(IN) :: hrec     ! name of the article to be written
REAL,              INTENT(IN) :: pfield   ! real scalar to be written
INTEGER,           INTENT(OUT):: kresp    ! KRESP  : return-code if a problem appears 
 CHARACTER(LEN=100),INTENT(IN) :: hcomment ! Comment string
!
END SUBROUTINE write_surfx0
!
     SUBROUTINE write_surfx1 (DGU, U, &
                              hprogram,hrec,pfield,kresp,hcomment,hdir,hnam_dim)
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
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),OPTIONAL,INTENT(IN)  :: hdir ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
 CHARACTER(LEN=16), OPTIONAL,  INTENT(IN) :: hnam_dim
END SUBROUTINE write_surfx1
!
     SUBROUTINE write_surfx2 (DGU, U, &
                              hprogram,hrec,pfield,kresp,hcomment,hdir,hnam_dim)
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),     INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),     INTENT(IN)  :: hrec     ! name of the article to be written
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),OPTIONAL,INTENT(IN)  :: hdir ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
 CHARACTER(LEN=16), OPTIONAL,  INTENT(IN) :: hnam_dim
END SUBROUTINE write_surfx2
!
!RJ: interface to WRITE_SURFX2COV moved out
!
     SUBROUTINE write_surfn0 (DGU, U, &
                              hprogram,hrec,kfield,kresp,hcomment)
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
INTEGER,            INTENT(IN)  :: kfield   ! integer to be written
INTEGER,            INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: hcomment ! Comment string
!
END SUBROUTINE write_surfn0
!
     SUBROUTINE write_surfn1 (DGU, U, &
                              hprogram,hrec,kfield,kresp,hcomment,hdir,hnam_dim)
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),      INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),      INTENT(IN)  :: hrec     ! name of the article to be written
INTEGER, DIMENSION(:), INTENT(IN)  :: kfield   ! integer to be written
INTEGER,               INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),    INTENT(IN)  :: hcomment ! Comment string
 CHARACTER(LEN=1),OPTIONAL,INTENT(IN)  :: hdir ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
 CHARACTER(LEN=16), OPTIONAL,  INTENT(IN) :: hnam_dim
END SUBROUTINE write_surfn1
!
     SUBROUTINE write_surfc0 (DGU, U, &
                              hprogram,hrec,hfield,kresp,hcomment)
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),    INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),    INTENT(IN)  :: hrec     ! name of the article to be written
 CHARACTER(LEN=*),    INTENT(IN)  :: hfield   ! caracter to be written
INTEGER,             INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),  INTENT(IN)  :: hcomment ! Comment string
!
END SUBROUTINE write_surfc0
!
      SUBROUTINE write_surfl0 (DGU, U, &
                               hprogram,hrec,ofield,kresp,hcomment)
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
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
!
END SUBROUTINE write_surfl0
!
      SUBROUTINE write_surfl1 (DGU, U, &
                               hprogram,hrec,ofield,kresp,hcomment,hdir)
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),      INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),      INTENT(IN)  :: hrec     ! name of the article to be written
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),OPTIONAL,INTENT(IN)  :: hdir ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
END SUBROUTINE write_surfl1
!
      SUBROUTINE write_surft0 (DGU, U, &
                               hprogram,hrec,tfield,kresp,hcomment)
!
USE modd_type_date_surf
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
TYPE (date_time),   INTENT(IN)  :: tfield   ! array containing the data field
INTEGER,            INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: hcomment ! Comment string
!
END SUBROUTINE write_surft0
!
      SUBROUTINE write_surft1 (DGU, U, &
                               hprogram,hrec,tfield,kresp,hcomment)
!
USE modd_type_date_surf
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
TYPE (date_time), DIMENSION(:), INTENT(IN)  :: tfield   ! array containing the data field
INTEGER,            INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: hcomment ! Comment string
!
END SUBROUTINE write_surft1
!
      SUBROUTINE write_surft2 (DGU, U, &
                               hprogram,hrec,tfield,kresp,hcomment)
!
USE modd_type_date_surf
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
TYPE (date_time), DIMENSION(:,:), INTENT(IN)  :: tfield   ! array containing the data field
INTEGER,            INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: hcomment ! Comment string
!
END SUBROUTINE write_surft2
!
END INTERFACE
!
END MODULE modi_write_surf
!
!     #############################################################
      SUBROUTINE write_surfx0 (DGU, U, &
                              hprogram,hrec,pfield,kresp,hcomment)
!     #############################################################
!
!!****  *WRITEX0* - routine to write a real scalar
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
!
#ifdef SFX_OL
USE mode_write_surf_ol, ONLY: write_surf0_ol, write_surf0_time_ol
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surf0_lfi
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surf0_nc
#endif
#ifdef SFX_TXT
USE mode_write_surf_txt, ONLY: write_surf0_txt
#endif
#ifdef SFX_BIN
USE mode_write_surf_bin, ONLY: write_surf0_bin
#endif
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surf0_asc
#endif
#ifdef SFX_FA
USE mode_write_surf_fa, ONLY: write_surf0_fa
#endif
#ifdef SFX_MNH
USE modi_write_surfx0_mnh
#endif
!
USE modi_test_record_len
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),  INTENT(IN) :: hprogram ! calling program
 CHARACTER(LEN=*),  INTENT(IN) :: hrec     ! name of the article to be written
REAL,              INTENT(IN) :: pfield   ! real scalar to be written
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
LOGICAL :: lnowrite
REAL   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX0',0,zhook_handle)
!
yrec = hrec
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX0',1,zhook_handle)
IF(lnowrite)RETURN
!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
  CALL write_surfx0_mnh(yrec,pfield,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='AROME ') THEN
#ifdef SFX_ARO
  CALL write_surfx0_aro(yrec,pfield,kresp,hcomment)
#endif
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE
  !
  IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
    CALL write_surf0_asc(&
                         yrec,pfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='FA    ') THEN
#ifdef SFX_FA
    CALL write_surf0_fa(&
                        yrec,pfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='OFFLIN') THEN
#ifdef SFX_OL
    IF (yrec=='time') THEN
      CALL write_surf0_time_ol(pfield,kresp,hcomment)
    ELSE
      CALL write_surf0_ol(yrec,pfield,kresp,hcomment)
    ENDIF
#endif
  ENDIF
  !
  IF (hprogram=='TEXTE ') THEN
#ifdef SFX_TXT
    CALL write_surf0_txt(yrec,pfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='BINARY') THEN
#ifdef SFX_BIN
    CALL write_surf0_bin(yrec,pfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
    CALL write_surf0_lfi(&
                         yrec,pfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='NC    ') THEN
#ifdef SFX_NC
    CALL write_surf0_nc(dgu, &
                        yrec,pfield,kresp,hcomment)
#endif
  ENDIF
  !
!$OMP END SINGLE
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX0',1,zhook_handle)
!
END SUBROUTINE write_surfx0
!
!     #############################################################
      SUBROUTINE write_surfx1 (DGU, U, &
                              hprogram,hrec,pfield,kresp,hcomment,hdir,hnam_dim)
!     #############################################################
!
!!****  *WRITEX1* - routine to fill a real 1D array for the externalised surface 
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surfex_mpi, ONLY : wlog_mpi
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
#ifdef SFX_OL
USE mode_write_surf_ol, ONLY: write_surfx1n1_ol
#endif
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surfn_asc
#endif
#ifdef SFX_TXT
USE mode_write_surf_txt, ONLY: write_surfx_txt
#endif
#ifdef SFX_BIN
USE mode_write_surf_bin, ONLY: write_surfx_bin
#endif
#ifdef SFX_FA
USE mode_write_surf_fa, ONLY: write_surfn_fa
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surfn_lfi
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surfn_nc
#endif
#ifdef SFX_MNH
USE modi_write_surfx1_mnh
#endif
!
USE modi_test_record_len
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
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),OPTIONAL,INTENT(IN)  :: hdir ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
 CHARACTER(LEN=16), OPTIONAL,  INTENT(IN) :: hnam_dim
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=12)  :: yrec
INTEGER            :: il
 CHARACTER(LEN=1)   :: ydir
LOGICAL :: lnowrite
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX1',0,zhook_handle)
!
yrec = hrec
ydir = 'H'
IF (present(hdir)) ydir = hdir
il = SIZE(pfield)
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX1',1,zhook_handle)
IF(lnowrite)RETURN
!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
  CALL write_surfx1_mnh(yrec,il,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='AROME ') THEN
#ifdef SFX_ARO
  CALL write_surfx1_aro(yrec,il,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='OFFLIN') THEN
#ifdef SFX_OL
  CALL write_surfx1n1_ol(&
                         yrec,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='TEXTE ') THEN
#ifdef SFX_TXT
  CALL write_surfx_txt(dgu, &
                       yrec,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='BINARY') THEN
#ifdef SFX_BIN
  CALL write_surfx_bin(dgu, u, &
                       yrec,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
  CALL write_surfn_lfi(&
                       yrec,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='NC    ') THEN
#ifdef SFX_NC
  IF (present(hnam_dim)) THEN
    CALL write_surfn_nc(dgu, &
                        yrec,pfield,kresp,hcomment,ydir,hnam_dim)
  ELSE
    CALL write_surfn_nc(dgu, &
                        yrec,pfield,kresp,hcomment,ydir)
  ENDIF
#endif
ENDIF
!
IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
  CALL write_surfn_asc(&
                       yrec,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='FA    ') THEN
#ifdef SFX_FA
  CALL write_surfn_fa(&
                      yrec,il,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX1',1,zhook_handle)
!
END SUBROUTINE write_surfx1
!
!     #############################################################
      SUBROUTINE write_surfx2 (DGU, U, &
                              hprogram,hrec,pfield,kresp,hcomment,hdir,hnam_dim)
!     #############################################################
!
!!****  *WRITEX2* - routine to fill a real 2D array for the externalised surface 
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surfex_mpi, ONLY : wlog_mpi
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
#ifdef SFX_OL
USE mode_write_surf_ol, ONLY: write_surfl1x2_ol
#endif
#ifdef SFX_TXT
USE mode_write_surf_txt, ONLY: write_surfx_txt
#endif
#ifdef SFX_BIN
USE mode_write_surf_bin, ONLY: write_surfx_bin
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surfn_lfi
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surfn_nc
#endif
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surfn_asc
#endif
#ifdef SFX_FA
USE mode_write_surf_fa, ONLY: write_surfn_fa
#endif
#ifdef SFX_MNH
USE modi_write_surfx2_mnh
#endif
!
USE modi_test_record_len
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),     INTENT(IN)  :: hprogram ! calling program
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=*),     INTENT(IN)  :: hrec     ! name of the article to be written
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),OPTIONAL,INTENT(IN)  :: hdir ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
 CHARACTER(LEN=16), OPTIONAL,  INTENT(IN) :: hnam_dim
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=12)  :: yrec
INTEGER            :: il1
INTEGER            :: il2
 CHARACTER(LEN=1)   :: ydir
LOGICAL :: lnowrite
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX2',0,zhook_handle)
!
yrec = hrec
ydir = 'H'
IF (present(hdir)) ydir = hdir
il1  = SIZE(pfield,1)
il2  = SIZE(pfield,2)
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX2',1,zhook_handle)
IF(lnowrite)RETURN
!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
  CALL write_surfx2_mnh(yrec,il1,il2,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='AROME ') THEN
#ifdef SFX_ARO
  CALL write_surfx2_aro(yrec,il1,il2,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='OFFLIN') THEN
#ifdef SFX_OL
  CALL write_surfl1x2_ol(yrec,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='TEXTE ') THEN
#ifdef SFX_TXT
  CALL write_surfx_txt(dgu, &
                       yrec,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='BINARY') THEN
#ifdef SFX_BIN
  CALL write_surfx_bin(dgu, u, &
                       yrec,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
  CALL write_surfn_lfi(&
                       yrec,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='NC    ') THEN
#ifdef SFX_NC
  IF (present(hnam_dim)) THEN
    CALL write_surfn_nc(dgu, &
                        yrec,pfield,kresp,hcomment,ydir,hnam_dim)
  ELSE
    CALL write_surfn_nc(dgu, &
                        yrec,pfield,kresp,hcomment,ydir)
  ENDIF
#endif
ENDIF
!
IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
  CALL write_surfn_asc(&
                       yrec,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='FA    ') THEN
#ifdef SFX_FA
  CALL write_surfn_fa(&
                      yrec,il1,il2,pfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFX2',1,zhook_handle)
!
END SUBROUTINE write_surfx2
!
!     #############################################################
      SUBROUTINE write_surfn0 (DGU, U, &
                              hprogram,hrec,kfield,kresp,hcomment)
!     #############################################################
!
!!****  *WRITEN0* - routine to write an integer
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
!
#ifdef SFX_OL
USE mode_write_surf_ol, ONLY: write_surf0_ol
#endif
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surf0_asc
#endif
#ifdef SFX_TXT
USE mode_write_surf_txt, ONLY: write_surf0_txt
#endif
#ifdef SFX_BIN
USE mode_write_surf_bin, ONLY: write_surf0_bin
#endif
#ifdef SFX_FA
USE mode_write_surf_fa, ONLY: write_surf0_fa
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surf0_lfi
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surf0_nc
#endif
#ifdef SFX_MNH
USE modi_write_surfn0_mnh
#endif
!
USE modi_test_record_len
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
INTEGER,            INTENT(IN)  :: kfield   ! integer to be written
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
LOGICAL :: lnowrite
REAL   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN0',0,zhook_handle)
!
yrec = hrec
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN0',1,zhook_handle)
IF(lnowrite)RETURN

!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
  CALL write_surfn0_mnh(yrec,kfield,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='AROME ') THEN
#ifdef SFX_ARO
  CALL write_surfn0_aro(yrec,kfield,kresp,hcomment)
#endif
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE
!  
  IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
    CALL write_surf0_asc(&
                         yrec,kfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='FA    ') THEN
#ifdef SFX_FA
    CALL write_surf0_fa(&
                        yrec,kfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='OFFLIN') THEN
#ifdef SFX_OL
    CALL write_surf0_ol(yrec,kfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='TEXTE ') THEN
#ifdef SFX_TXT
    CALL write_surf0_txt(yrec,kfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='BINARY') THEN
#ifdef SFX_BIN
    CALL write_surf0_bin(yrec,kfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
    CALL write_surf0_lfi(&
                         yrec,kfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='NC    ') THEN
#ifdef SFX_NC
    CALL write_surf0_nc(dgu, &
                        yrec,kfield,kresp,hcomment)
#endif
  ENDIF  
  !
!$OMP END SINGLE 
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN0',1,zhook_handle)
!
END SUBROUTINE write_surfn0

!     #############################################################
      SUBROUTINE write_surfn1 (DGU, U, &
                              hprogram,hrec,kfield,kresp,hcomment,hdir,hnam_dim)
!     #############################################################
!
!!****  *WRITEN0* - routine to write an integer
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surfex_mpi, ONLY : wlog_mpi
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
#ifdef SFX_OL
USE mode_write_surf_ol, ONLY: write_surfx1n1_ol
#endif
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surfn_asc
#endif
#ifdef SFX_TXT
USE mode_write_surf_txt, ONLY: write_surfn_txt
#endif
#ifdef SFX_BIN
USE mode_write_surf_bin, ONLY: write_surfn_bin
#endif
#ifdef SFX_FA
USE mode_write_surf_fa, ONLY: write_surfn_fa
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surfn_lfi
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surfn_nc
#endif
#ifdef SFX_MNH
USE modi_write_surfn1_mnh
#endif
!
USE modi_test_record_len
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),      INTENT(IN)  :: hprogram ! calling program
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=*),      INTENT(IN)  :: hrec     ! name of the article to be written
INTEGER, DIMENSION(:), INTENT(IN)  :: kfield   ! integer to be written
INTEGER,               INTENT(OUT) :: kresp    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),    INTENT(IN)  :: hcomment ! Comment string
 CHARACTER(LEN=1),OPTIONAL,INTENT(IN)  :: hdir ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
 CHARACTER(LEN=16), OPTIONAL,  INTENT(IN) :: hnam_dim
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=12)  :: yrec
INTEGER            :: il
 CHARACTER(LEN=1)   :: ydir
LOGICAL :: lnowrite
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN1',0,zhook_handle)
!
yrec = hrec
ydir = 'H'
IF (present(hdir)) ydir = hdir
il = SIZE(kfield)
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN1',1,zhook_handle)
IF(lnowrite)RETURN
!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
  CALL write_surfn1_mnh(yrec,il,kfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='AROME ') THEN
#ifdef SFX_ARO
  CALL write_surfn1_aro(yrec,il,kfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='OFFLIN') THEN
#ifdef SFX_OL
  CALL write_surfx1n1_ol(&
                         yrec,kfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='TEXTE ') THEN
#ifdef SFX_TXT
  CALL write_surfn_txt(yrec,kfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='BINARY') THEN
#ifdef SFX_BIN
  CALL write_surfn_bin(yrec,kfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
  CALL write_surfn_lfi(&
                       yrec,kfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='NC    ') THEN
#ifdef SFX_NC
  IF (present(hnam_dim)) THEN
    CALL write_surfn_nc(dgu, &
                        yrec,kfield,kresp,hcomment,ydir,hnam_dim)
  ELSE
    CALL write_surfn_nc(dgu, &
                        yrec,kfield,kresp,hcomment,ydir)
  ENDIF
#endif
ENDIF
!
IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
  CALL write_surfn_asc(&
                       yrec,kfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='FA    ') THEN
#ifdef SFX_FA
  CALL write_surfn_fa(&
                      yrec,il,kfield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFN1',1,zhook_handle)
!
END SUBROUTINE write_surfn1
!
!     #############################################################
      SUBROUTINE write_surfc0 (DGU, U, &
                              hprogram,hrec,hfield,kresp,hcomment)
!     #############################################################
!
!!****  *WRITEC0* - routine to write an integer
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
!
#ifdef SFX_OL
USE mode_write_surf_ol, ONLY: write_surf0_ol
#endif
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surf0_asc
#endif
#ifdef SFX_TXT
USE mode_write_surf_txt, ONLY: write_surf0_txt
#endif
#ifdef SFX_BIN
USE mode_write_surf_bin, ONLY: write_surf0_bin
#endif
#ifdef SFX_FA
USE mode_write_surf_fa, ONLY: write_surf0_fa
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surf0_lfi
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surf0_nc
#endif
#ifdef SFX_MNH
USE modi_write_surfc0_mnh
#endif
!
USE modi_test_record_len
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),    INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),    INTENT(IN)  :: hrec     ! name of the article to be written
 CHARACTER(LEN=*),    INTENT(IN)  :: hfield   ! caracter to be written
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
 CHARACTER(LEN=40)  :: yfield
LOGICAL :: lnowrite
REAL   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFC0',0,zhook_handle)
!
yrec = hrec
yfield = "                                        "
yfield(1:len(hfield)) = hfield
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFC0',1,zhook_handle)
IF(lnowrite)RETURN
!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
  CALL write_surfc0_mnh(yrec,yfield,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='AROME ') THEN
#ifdef SFX_ARO
  CALL write_surfc0_aro(yrec,yfield,kresp,hcomment)
#endif
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE  
  !
  IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
    CALL write_surf0_asc(&
                         yrec,yfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='FA    ') THEN
#ifdef SFX_FA
    CALL write_surf0_fa(&
                        yrec,yfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='OFFLIN') THEN
#ifdef SFX_OL
    CALL write_surf0_ol(yrec,yfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='TEXTE ') THEN
#ifdef SFX_TXT
    CALL write_surf0_txt(yrec,yfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='BINARY') THEN
#ifdef SFX_BIN
    CALL write_surf0_bin(yrec,yfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
    CALL write_surf0_lfi(&
                         yrec,yfield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='NC   ') THEN
#ifdef SFX_NC
    CALL write_surf0_nc(dgu, &
                        yrec,yfield,kresp,hcomment)
#endif
  ENDIF  
  !
!$OMP END SINGLE 
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFC0',1,zhook_handle)
!
END SUBROUTINE write_surfc0
!
!     #############################################################
      SUBROUTINE write_surfl0 (DGU, U, &
                               hprogram,hrec,ofield,kresp,hcomment)
!     #############################################################
!
!!****  *WRITEL0* - routine to write a logical
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
!
#ifdef SFX_OL
USE mode_write_surf_ol, ONLY: write_surf0_ol
#endif
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surf0_asc
#endif
#ifdef SFX_TXT
USE mode_write_surf_txt, ONLY: write_surf0_txt
#endif
#ifdef SFX_BIN
USE mode_write_surf_bin, ONLY: write_surf0_bin
#endif
#ifdef SFX_FA
USE mode_write_surf_fa, ONLY: write_surf0_fa
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surf0_lfi
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surf0_nc
#endif
#ifdef SFX_MNH
USE modi_write_surfl0_mnh
#endif
!
USE modi_test_record_len
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
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
!
 CHARACTER(LEN=12)  :: yrec
LOGICAL :: lnowrite
REAL   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL0',0,zhook_handle)
!
yrec = hrec
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL0',1,zhook_handle)
IF(lnowrite)RETURN
!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
  CALL write_surfl0_mnh(yrec,ofield,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='AROME ') THEN
#ifdef SFX_ARO
  CALL write_surfl0_aro(yrec,ofield,kresp,hcomment)
#endif
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime() 
#endif
  !
!$OMP SINGLE
  !
  IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
    CALL write_surf0_asc(&
                         yrec,ofield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='FA    ') THEN
#ifdef SFX_FA
    CALL write_surf0_fa(&
                        yrec,ofield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='OFFLIN') THEN
#ifdef SFX_OL
    CALL write_surf0_ol(yrec,ofield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='TEXTE ') THEN
#ifdef SFX_TXT
    CALL write_surf0_txt(yrec,ofield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='BINARY') THEN
#ifdef SFX_BIN
    CALL write_surf0_bin(yrec,ofield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
    CALL write_surf0_lfi(&
                         yrec,ofield,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='NC    ') THEN
#ifdef SFX_NC
    CALL write_surf0_nc(dgu, &
                        yrec,ofield,kresp,hcomment)
#endif
  ENDIF  
  !
!$OMP END SINGLE 
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL0',1,zhook_handle)
!
END SUBROUTINE write_surfl0
!
!     #############################################################
      SUBROUTINE write_surfl1 (DGU, U, &
                               hprogram,hrec,ofield,kresp,hcomment,hdir)
!     #############################################################
!
!!****  *WRITEL1* - routine to write a logical array
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surfex_mpi, ONLY : wlog_mpi
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
#ifdef SFX_OL
USE mode_write_surf_ol, ONLY: write_surfl1x2_ol
#endif
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surfn_asc
#endif
#ifdef SFX_TXT
USE mode_write_surf_txt, ONLY: write_surfn_txt
#endif
#ifdef SFX_BIN
USE mode_write_surf_bin, ONLY: write_surfn_bin
#endif
#ifdef SFX_FA
USE mode_write_surf_fa, ONLY: write_surfn_fa
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surfn_lfi
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surfn_nc
#endif
#ifdef SFX_MNH
USE modi_write_surfl1_mnh
#endif
!
USE modi_test_record_len
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),      INTENT(IN)  :: hprogram ! calling program
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=*),      INTENT(IN)  :: hrec     ! name of the article to be written
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),OPTIONAL,INTENT(IN)  :: hdir ! type of field :
!                                             ! 'H' : field with
!                                             !       horizontal spatial dim.
!                                             ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=12)  :: yrec
INTEGER            :: il
 CHARACTER(LEN=1)   :: ydir
LOGICAL :: lnowrite
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL1',0,zhook_handle)
!
yrec = hrec
ydir = 'H'
IF (present(hdir)) ydir = hdir
il   = SIZE(ofield)
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL1',1,zhook_handle)
IF(lnowrite)RETURN
!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
  CALL write_surfl1_mnh(yrec,il,ofield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='AROME ') THEN
#ifdef SFX_ARO
  CALL write_surfl1_aro(yrec,il,ofield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='OFFLIN') THEN
#ifdef SFX_OL
  CALL write_surfl1x2_ol(yrec,ofield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='TEXTE ') THEN
#ifdef SFX_TXT
  CALL write_surfn_txt(yrec,ofield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='BINARY') THEN
#ifdef SFX_BIN
  CALL write_surfn_bin(yrec,ofield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
  CALL write_surfn_lfi(&
                       yrec,ofield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='NC    ') THEN
#ifdef SFX_NC
  CALL write_surfn_nc(dgu, &
                        yrec,ofield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
  CALL write_surfn_asc(&
                       yrec,ofield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (hprogram=='FA    ') THEN
#ifdef SFX_FA
  CALL write_surfn_fa(&
                      yrec,il,ofield,kresp,hcomment,ydir)
#endif
ENDIF
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFL1',1,zhook_handle)
!
END SUBROUTINE write_surfl1
!
!     #############################################################
      SUBROUTINE write_surft0 (DGU, U, &
                               hprogram,hrec,tfield,kresp,hcomment)
!     #############################################################
!
!!****  *WRITET0* - routine to write a MESO-NH date_time scalar
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_type_date_surf
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
#ifdef SFX_OL
USE mode_write_surf_ol, ONLY: write_surft_ol
#endif
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surft_asc
#endif
#ifdef SFX_TXT
USE mode_write_surf_txt, ONLY: write_surft_txt
#endif
#ifdef SFX_BIN
USE mode_write_surf_bin, ONLY: write_surft_bin
#endif
#ifdef SFX_FA
USE mode_write_surf_fa, ONLY: write_surft_fa
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surft_lfi
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surft_nc
#endif
#ifdef SFX_MNH
USE modi_write_surft0_mnh
#endif
!
USE modi_test_record_len
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
TYPE (date_time),   INTENT(IN)  :: tfield   ! 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
!
 CHARACTER(LEN=12)  :: yrec
REAL    :: ztime
REAL   :: xtime0
INTEGER :: iday
INTEGER :: imonth
INTEGER :: iyear
LOGICAL :: lnowrite
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT0',0,zhook_handle)
!
yrec = hrec
!
iyear  = tfield%TDATE%YEAR
imonth = tfield%TDATE%MONTH
iday   = tfield%TDATE%DAY
ztime  = tfield%TIME
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT0',1,zhook_handle)
IF(lnowrite)RETURN
!
IF (hprogram=='MESONH') THEN
#ifdef SFX_MNH
  CALL write_surft0_mnh(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='AROME ') THEN
#ifdef SFX_ARO
  CALL write_surft0_aro(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE
  !  
  IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
    CALL write_surft_asc(&
                         yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='FA    ') THEN
#ifdef SFX_FA
    CALL write_surft_fa(&
                        yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='OFFLIN') THEN
#ifdef SFX_OL
    CALL write_surft_ol(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='TEXTE ') THEN
#ifdef SFX_TXT
    CALL write_surft_txt(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='BINARY') THEN
#ifdef SFX_BIN
    CALL write_surft_bin(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
    CALL write_surft_lfi(&
                         yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
  ENDIF
  !
  IF (hprogram=='NC    ') THEN
#ifdef SFX_NC
    CALL write_surft_nc(dgu, &
                        yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
  ENDIF  
  !
!$OMP END SINGLE 
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT0',1,zhook_handle)
!
END SUBROUTINE write_surft0
!
!     #############################################################
      SUBROUTINE write_surft1 (DGU, U, &
                               hprogram,hrec,tfield,kresp,hcomment)
!     #############################################################
!
!!****  *READT2* - routine to read a MESO-NH date_time array
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surfex_mpi, ONLY : wlog_mpi
USE modd_type_date_surf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surft_asc
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surft_lfi
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surft_nc
#endif
#ifdef SFX_MNH
USE modi_write_surft1_mnh
#endif
!
USE modi_abor1_sfx
USE modi_test_record_len
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
TYPE (date_time), DIMENSION(:), INTENT(IN)  :: tfield   ! 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
!
 CHARACTER(LEN=12)  :: yrec
INTEGER :: il1
REAL ,   DIMENSION(SIZE(TFIELD,1)) :: ztime
INTEGER, DIMENSION(SIZE(TFIELD,1)) :: iday
INTEGER, DIMENSION(SIZE(TFIELD,1)) :: imonth
INTEGER, DIMENSION(SIZE(TFIELD,1)) :: iyear
LOGICAL :: lnowrite
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT1',0,zhook_handle)
!
yrec = hrec
il1  = SIZE(tfield,1)
!
iyear(:) = tfield(:)%TDATE%YEAR
imonth(:) = tfield(:)%TDATE%MONTH
iday(:) = tfield(:)%TDATE%DAY
ztime(:) = tfield(:)%TIME
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT1',1,zhook_handle)
IF(lnowrite)RETURN
!
IF (hprogram=='MESONH') THEN
   !G .TANGUY 03/2009
   !CALL ABOR1_SFX('WRITE_SURFT1: NOT AVAILABLE FOR MESONH')
#ifdef SFX_MNH
   CALL write_surft1_mnh(yrec,il1,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='AROME ') THEN
#ifdef SFX_ARO
  CALL write_surft1_aro(yrec,il1,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
!IF (HPROGRAM=='OFFLIN') THEN
!  CALL ABOR1_SFX('WRITE_SURFT1: NOT AVAILABLE FOR OFFLIN')
!ENDIF
!
!plm IF (HPROGRAM=='TEXTE ') THEN
!plm   CALL WRITE_SURFT1_TXT(YREC,IL1,IYEAR,IMONTH,IDAY,ZTIME,KRESP,HCOMMENT)
!plm ENDIF
!
IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
  CALL write_surft_lfi(&
                         yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='NC    ') THEN
#ifdef SFX_NC
  CALL write_surft_nc(dgu, &
                        yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
  CALL write_surft_asc(&
                         yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='FA    ') THEN
  CALL abor1_sfx('WRITE_SURFT1: NOT AVAILABLE FOR FA')
ENDIF
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT1',1,zhook_handle)
!
END SUBROUTINE write_surft1
!
!     #############################################################
      SUBROUTINE write_surft2 (DGU, U, &
                               hprogram,hrec,tfield,kresp,hcomment)
!     #############################################################
!
!!****  *WRITET2* - routine to write a MESO-NH date_time array
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surfex_mpi, ONLY : wlog_mpi
USE modd_type_date_surf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
#ifdef SFX_ASC
USE mode_write_surf_asc, ONLY: write_surft_asc
#endif
#ifdef SFX_TXT
USE mode_write_surf_txt, ONLY: write_surft_txt
#endif
#ifdef SFX_BIN
USE mode_write_surf_bin, ONLY: write_surft_bin
#endif
#ifdef SFX_FA
USE mode_write_surf_fa, ONLY: write_surft_fa
#endif
#ifdef SFX_NC
USE mode_write_surf_nc, ONLY: write_surft_nc
#endif
#ifdef SFX_LFI
USE mode_write_surf_lfi, ONLY: write_surft_lfi
#endif
!
USE modi_abor1_sfx
USE modi_test_record_len
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram ! calling program
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=*),   INTENT(IN)  :: hrec     ! name of the article to be written
TYPE (date_time), DIMENSION(:,:), INTENT(IN)  :: tfield   ! 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
!
 CHARACTER(LEN=12)  :: yrec
INTEGER :: il1, il2
REAL ,   DIMENSION(SIZE(TFIELD,1),SIZE(TFIELD,2)) :: ztime
INTEGER, DIMENSION(SIZE(TFIELD,1),SIZE(TFIELD,2)) :: iday
INTEGER, DIMENSION(SIZE(TFIELD,1),SIZE(TFIELD,2)) :: imonth
INTEGER, DIMENSION(SIZE(TFIELD,1),SIZE(TFIELD,2)) :: iyear
LOGICAL :: lnowrite
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT2',0,zhook_handle)
!
yrec = hrec
il1  = SIZE(tfield,1)
il2  = SIZE(tfield,2)
!
iyear(:,:) = tfield(:,:)%TDATE%YEAR
imonth(:,:) = tfield(:,:)%TDATE%MONTH
iday(:,:) = tfield(:,:)%TDATE%DAY
ztime(:,:) = tfield(:,:)%TIME
!
 CALL test_record_len(dgu, &
                      hprogram,yrec,lnowrite)
IF(lnowrite .AND. lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT2',1,zhook_handle)
IF(lnowrite)RETURN
!
IF (hprogram=='MESONH') THEN
  CALL abor1_sfx('WRITE_SURFT2: NOT AVAILABLE FOR MESONH')
ENDIF
!
IF (hprogram=='AROME ') THEN
  CALL abor1_sfx('WRITE_SURFT2: NOT AVAILABLE FOR AROME')
ENDIF
!
!IF (HPROGRAM=='OFFLIN') THEN
!  CALL ABOR1_SFX('WRITE_SURFT2: NOT AVAILABLE FOR OFFLIN')
!ENDIF
!
IF (hprogram=='LFI   ') THEN
#ifdef SFX_LFI
  CALL write_surft_lfi(&
                         yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='TEXTE ') THEN
#ifdef SFX_TXT
  CALL write_surft_txt(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='BINARY') THEN
#ifdef SFX_BIN
  CALL write_surft_bin(yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='ASCII ') THEN
#ifdef SFX_ASC
  CALL write_surft_asc(&
                         yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='FA    ') THEN
#ifdef SFX_FA
  CALL write_surft_fa(&
                        yrec,il1,il2,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (hprogram=='NC    ') THEN
#ifdef SFX_NC
  CALL write_surft_nc(dgu, &
                        yrec,iyear,imonth,iday,ztime,kresp,hcomment)
#endif
ENDIF
!
IF (lhook) CALL dr_hook('MODI_WRITE_SURF:WRITE_SURFT2',1,zhook_handle)
!
END SUBROUTINE write_surft2