mode_write_surf_asc.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_write_surf_asc
!
INTERFACE write_surf0_asc
        MODULE PROCEDURE write_surfx0_asc
        MODULE PROCEDURE write_surfn0_asc
        MODULE PROCEDURE write_surfl0_asc
        MODULE PROCEDURE write_surfc0_asc
END INTERFACE
INTERFACE write_surfn_asc
        MODULE PROCEDURE write_surfx1_asc
        MODULE PROCEDURE write_surfn1_asc
        MODULE PROCEDURE write_surfl1_asc
        MODULE PROCEDURE write_surfx2_asc
END INTERFACE
INTERFACE write_surft_asc
        MODULE PROCEDURE write_surft0_asc
        MODULE PROCEDURE write_surft1_asc
        MODULE PROCEDURE write_surft2_asc
END INTERFACE
!
 CONTAINS
!
!     #############################################################
      SUBROUTINE write_surfx0_asc (&
                                   hrec,pfield,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write a real scalar
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_asc,        ONLY : nunit, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
!
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_ASC:WRITE_SURFX0_ASC',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
WRITE(nunit,fmt=*,err=100) '&'//cmask//' '//hrec
WRITE(nunit,fmt='(A50)',err=100) hcomment(1:50)
WRITE(nunit,fmt=*,err=100) pfield
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_write_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,zhook_handle)
!
END SUBROUTINE write_surfx0_asc
!
!     #############################################################
      SUBROUTINE write_surfn0_asc (&
                                   hrec,kfield,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write an integer
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_asc,        ONLY : nunit, nmask, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
!
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_ASC:WRITE_SURFN0_ASC',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
WRITE(nunit,fmt=*,err=100) '&'//cmask//' '//hrec
WRITE(nunit,fmt='(A50)',err=100) hcomment(1:50)
WRITE(nunit,fmt=*,err=100) kfield
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_write_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,zhook_handle)
!
END SUBROUTINE write_surfn0_asc
!
!     #############################################################
      SUBROUTINE write_surfl0_asc (&
                                   hrec,ofield,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write a logical
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_asc,        ONLY : nunit, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
!
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_ASC:WRITE_SURFL0_ASC',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
WRITE(nunit,fmt=*,err=100) '&'//cmask//' '//hrec
WRITE(nunit,fmt='(A50)',err=100) hcomment(1:50)
WRITE(nunit,fmt=*,err=100) ofield
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_write_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,zhook_handle)
!
END SUBROUTINE write_surfl0_asc
!
!     #############################################################
      SUBROUTINE write_surfc0_asc (&
                                   hrec,hfield,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write a character
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_asc,        ONLY : nunit, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
!
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_ASC:WRITE_SURFC0_ASC',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
WRITE(nunit,fmt=*,err=100) '&'//cmask//' '//hrec
WRITE(nunit,fmt='(A50)',err=100) hcomment(1:50)
WRITE(nunit,fmt='(A40)',err=100) hfield
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_write_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,zhook_handle)
!
END SUBROUTINE write_surfc0_asc
!
!     #############################################################
      SUBROUTINE write_surfx1_asc (&
                                   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, wlog_mpi
!
USE modd_surfex_omp, ONLY : lwork0, nworkb, nblock
!
USE modd_io_surf_asc,        ONLY : nunit, nmask, nfull, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
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
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
!
INTEGER :: isize, j
REAL   :: xtime0
REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD))) :: zwork   ! work array read in the file
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',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_ASC:WRITE_SURFX1_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
IF (hdir=='-') THEN
  isize = SIZE(pfield)
  zwork(1:isize) = pfield
ELSE
  isize = SIZE(zwork)
  CALL gather_and_write_mpi(pfield,zwork,nmask)
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE
  !
  WRITE(nunit,fmt=*,iostat=nworkb) '&'//cmask//' '//hrec
  WRITE(nunit,fmt='(A50)',iostat=nworkb) hcomment(1:50)
  WRITE(nunit,fmt='(50D20.8)',iostat=nworkb) zwork(1:isize)
  !
!$OMP END SINGLE
  !  
  IF (nworkb/=0) CALL error_write_surf_asc(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_ASC:WRITE_SURFX1_ASC',1,zhook_handle)
!
END SUBROUTINE write_surfx1_asc
!
!     #############################################################
      SUBROUTINE write_surfx2_asc (&
                                   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, wlog_mpi
!
USE modd_surfex_omp, ONLY : lwork0, nworkb
!
USE modd_io_surf_asc,        ONLY : nunit, nmask, nfull, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
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
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
! 
INTEGER :: isize
REAL   :: xtime0
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_ASC:WRITE_SURFX2_ASC',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_ASC:WRITE_SURFX2_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
IF (hdir=='-') THEN
  isize = SIZE(pfield,1)
  zwork(1:isize,:) = pfield(:,:)
ELSE
  isize = SIZE(zwork,1)
  CALL gather_and_write_mpi(pfield,zwork,nmask)
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE
  !
  WRITE(nunit,fmt=*,iostat=nworkb) '&'//cmask//' '//hrec
  WRITE(nunit,fmt='(A50)',iostat=nworkb) hcomment(1:50)
  WRITE(nunit,fmt='(50D20.8)',iostat=nworkb) zwork(1:isize,:)
  !
!$OMP END SINGLE
  !  
  IF (nworkb/=0) CALL error_write_surf_asc(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_ASC:WRITE_SURFX2_ASC',1,zhook_handle)
!
END SUBROUTINE write_surfx2_asc
!
!     #############################################################
      SUBROUTINE write_surfn1_asc (&
                                   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_asc,        ONLY : nunit, nmask, nfull, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
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 :: isize
INTEGER, DIMENSION(MAX(NFULL,SIZE(KFIELD))) :: iwork  ! work array read in the file
REAL   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',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_ASC:WRITE_SURFN1_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
IF (hdir=='-' .OR. hrec=='-') THEN
  isize = SIZE(kfield)
  iwork(1:isize) = kfield
ELSE
  isize = SIZE(iwork)
  CALL gather_and_write_mpi(kfield,iwork,nmask)
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE
  !   
  WRITE(nunit,fmt=*,iostat=nworkb) '&'//cmask//' '//hrec
  WRITE(nunit,fmt='(A50)',iostat=nworkb) hcomment(1:50)
  WRITE(nunit,fmt='(100I8)',iostat=nworkb) iwork(1:isize)
  !
!$OMP END SINGLE
  !
  IF (nworkb/=0) CALL error_write_surf_asc(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_ASC:WRITE_SURFN1_ASC',1,zhook_handle)
!
END SUBROUTINE write_surfn1_asc
!
!     #############################################################
      SUBROUTINE write_surfl1_asc (&
                                   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_asc,        ONLY : nunit, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
!
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
!
REAL   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',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_ASC:WRITE_SURFL1_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE
  !  
  WRITE(nunit,fmt=*,iostat=nworkb) '&'//cmask//' '//hrec
  WRITE(nunit,fmt='(A50)',iostat=nworkb) hcomment(1:50)
  WRITE(nunit,fmt=*,iostat=nworkb) ofield
  !
!$OMP END SINGLE
  !
  IF (nworkb/=0) CALL error_write_surf_asc(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_ASC:WRITE_SURFL1_ASC',1,zhook_handle)
!
END SUBROUTINE write_surfl1_asc
!
!     #############################################################
      SUBROUTINE write_surft0_asc (&
                                   hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
!     #############################################################
!
!!****  * - routine to write a date
!
!
!
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modd_io_surf_asc,        ONLY : nunit, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
!
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
!
INTEGER, DIMENSION(3) :: itdate
REAL(KIND=JPRB)       :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
itdate(1) = kyear
itdate(2) = kmonth
itdate(3) = kday
!
WRITE(nunit,fmt=*,err=100) '&'//cmask//' '//trim(hrec)//'%TDATE'
WRITE(nunit,fmt='(A50)',err=100) hcomment(1:50)
WRITE(nunit,fmt=*,err=100) itdate(:)
!
WRITE(nunit,fmt=*,err=100) '&'//cmask//' '//trim(hrec)//'%TIME'
WRITE(nunit,fmt='(A50)',err=100) hcomment(1:50)
WRITE(nunit,fmt=*,err=100) ptime
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,zhook_handle)
RETURN
!
100 CONTINUE
 CALL error_write_surf_asc(hrec,kresp)
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,zhook_handle)
!
END SUBROUTINE write_surft0_asc
!
!     #############################################################
      SUBROUTINE write_surft1_asc (&
                                   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_asc,        ONLY : nunit, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
!
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
!
INTEGER, DIMENSION(3,SIZE(KYEAR)) :: itdate
REAL   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',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_ASC:WRITE_SURFT1_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE
  !
  itdate(1,:) = kyear(:)
  itdate(2,:) = kmonth(:)
  itdate(3,:) = kday(:)
  !
  WRITE(nunit,fmt=*,iostat=nworkb) '&'//cmask//' '//trim(hrec)//'%TDATE'
  WRITE(nunit,fmt='(A50)',iostat=nworkb) hcomment(1:50)
  WRITE(nunit,fmt=*,iostat=nworkb) itdate(:,:)
  !
  WRITE(nunit,fmt=*,iostat=nworkb) '&'//cmask//' '//trim(hrec)//'%TIME'
  WRITE(nunit,fmt='(A50)',iostat=nworkb) hcomment(1:50)
  WRITE(nunit,fmt=*,iostat=nworkb) ptime
  !
!$OMP END SINGLE
  !   
  IF (nworkb/=0) CALL error_write_surf_asc(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_ASC:WRITE_SURFT1_ASC',1,zhook_handle)
!
END SUBROUTINE write_surft1_asc
!
!     #############################################################
      SUBROUTINE write_surft2_asc (&
                                   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_asc,        ONLY : nunit, cmask
!
USE modi_io_buff
USE modi_error_write_surf_asc
!
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
!
INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: itdate
REAL   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',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_ASC:WRITE_SURFT2_ASC',1,zhook_handle)
IF (lwork0) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
!$OMP SINGLE
  !    
  itdate(1,:,:) = kyear(:,:)
  itdate(2,:,:) = kmonth(:,:)
  itdate(3,:,:) = kday(:,:)
  !
  WRITE(nunit,fmt=*,iostat=nworkb) '&'//cmask//' '//trim(hrec)//'%TDATE'
  WRITE(nunit,fmt='(A50)',iostat=nworkb) hcomment(1:50)
  WRITE(nunit,fmt=*,iostat=nworkb) itdate(:,:,:)
  !
  WRITE(nunit,fmt=*,iostat=nworkb) '&'//cmask//' '//trim(hrec)//'%TIME'
  WRITE(nunit,fmt='(A50)',iostat=nworkb) hcomment(1:50)
  WRITE(nunit,fmt=*,iostat=nworkb) ptime
  !
!$OMP END SINGLE
  !
  IF (nworkb/=0) CALL error_write_surf_asc(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_ASC:WRITE_SURFT2_ASC',1,zhook_handle)
!
END SUBROUTINE write_surft2_asc
!
END MODULE mode_write_surf_asc