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
        MODULE PROCEDURE write_surfx3_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_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
!
LOGICAL :: GFOUND
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',gfound)
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,zhook_handle)
IF (gfound) 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_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
!
LOGICAL :: GFOUND
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',gfound)
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,zhook_handle)
IF (gfound) 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_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
!
LOGICAL :: GFOUND
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',gfound)
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,zhook_handle)
IF (gfound) 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_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
!
LOGICAL :: GFOUND
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',gfound)
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,zhook_handle)
IF (gfound) 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_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
!
LOGICAL :: GFOUND
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)
!
kresp=0
! 
 CALL io_buff(hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',1,zhook_handle)
IF (gfound) 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
  !
  WRITE(nunit,fmt=*,iostat=kresp) '&'//cmask//' '//hrec
  WRITE(nunit,fmt='(A50)',iostat=kresp) hcomment(1:50)
  WRITE(nunit,fmt='(50D20.8)',iostat=kresp) zwork(1:isize)
  !
  IF (kresp/=0) CALL error_write_surf_asc(hrec,kresp)
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
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_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
! 
LOGICAL :: GFOUND
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)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',1,zhook_handle)
IF (gfound) 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
  !
  WRITE(nunit,fmt=*,iostat=kresp) '&'//cmask//' '//hrec
  WRITE(nunit,fmt='(A50)',iostat=kresp) hcomment(1:50)
  WRITE(nunit,fmt='(50D20.8)',iostat=kresp) zwork(1:isize,:)
  !
  IF (kresp/=0) CALL error_write_surf_asc(hrec,kresp)
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',1,zhook_handle)
!
END SUBROUTINE write_surfx2_asc
!
!     #############################################################
      SUBROUTINE write_surfx3_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_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
! 
LOGICAL :: GFOUND
INTEGER :: ISIZE
REAL   :: XTIME0
REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2),SIZE(PFIELD,3)) :: ZWORK   ! work array read in the file
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX3_ASC',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX3_ASC',1,zhook_handle)
IF (gfound) 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
  !
  WRITE(nunit,fmt=*,iostat=kresp) '&'//cmask//' '//hrec
  WRITE(nunit,fmt='(A50)',iostat=kresp) hcomment(1:50)
  WRITE(nunit,fmt='(50D20.8)',iostat=kresp) zwork(1:isize,:,:)
  !
  IF (kresp/=0) CALL error_write_surf_asc(hrec,kresp)
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFX3_ASC',1,zhook_handle)
!
END SUBROUTINE write_surfx3_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_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
!
LOGICAL :: GFOUND
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)
!
kresp = 0
!
 CALL io_buff(&
                hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',1,zhook_handle)
IF (gfound) 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
  !
  WRITE(nunit,fmt=*,iostat=kresp) '&'//cmask//' '//hrec
  WRITE(nunit,fmt='(A50)',iostat=kresp) hcomment(1:50)
  WRITE(nunit,fmt='(100I8)',iostat=kresp) iwork(1:isize)
  !
  IF (kresp/=0) CALL error_write_surf_asc(hrec,kresp)
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
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_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
!
LOGICAL :: GFOUND
REAL   :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',0,zhook_handle)
!
kresp = 0
!
 CALL io_buff(&
                hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',1,zhook_handle)
IF (gfound) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  WRITE(nunit,fmt=*,iostat=kresp) '&'//cmask//' '//hrec
  WRITE(nunit,fmt='(A50)',iostat=kresp) hcomment(1:50)
  WRITE(nunit,fmt=*,iostat=kresp) ofield
  !
  IF (kresp/=0) CALL error_write_surf_asc(hrec,kresp)
  !  
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
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_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
!
LOGICAL :: GFOUND
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',gfound)
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,zhook_handle)
IF (gfound) 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_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
LOGICAL :: GFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',0,zhook_handle)
!
kresp = 0
!
 CALL io_buff(&
                hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',1,zhook_handle)
IF (gfound) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  itdate(1,:) = kyear(:)
  itdate(2,:) = kmonth(:)
  itdate(3,:) = kday(:)
  !
  WRITE(nunit,fmt=*,iostat=kresp) '&'//cmask//' '//trim(hrec)//'%TDATE'
  WRITE(nunit,fmt='(A50)',iostat=kresp) hcomment(1:50)
  WRITE(nunit,fmt=*,iostat=kresp) itdate(:,:)
  !
  WRITE(nunit,fmt=*,iostat=kresp) '&'//cmask//' '//trim(hrec)//'%TIME'
  WRITE(nunit,fmt='(A50)',iostat=kresp) hcomment(1:50)
  WRITE(nunit,fmt=*,iostat=kresp) ptime
  !
  IF (kresp/=0) CALL error_write_surf_asc(hrec,kresp)
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
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_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
LOGICAL :: GFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',0,zhook_handle)
!
kresp = 0
!
 CALL io_buff(&
                hrec,'W',gfound) 
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',1,zhook_handle)
IF (gfound) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  itdate(1,:,:) = kyear(:,:)
  itdate(2,:,:) = kmonth(:,:)
  itdate(3,:,:) = kday(:,:)
  !
  WRITE(nunit,fmt=*,iostat=kresp) '&'//cmask//' '//trim(hrec)//'%TDATE'
  WRITE(nunit,fmt='(A50)',iostat=kresp) hcomment(1:50)
  WRITE(nunit,fmt=*,iostat=kresp) itdate(:,:,:)
  !
  WRITE(nunit,fmt=*,iostat=kresp) '&'//cmask//' '//trim(hrec)//'%TIME'
  WRITE(nunit,fmt='(A50)',iostat=kresp) hcomment(1:50)
  WRITE(nunit,fmt=*,iostat=kresp) ptime
  !
  IF (kresp/=0) CALL error_write_surf_asc(hrec,kresp)
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
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