mode_write_surf_ol.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_ol
!
INTERFACE get_comment
        MODULE PROCEDURE get_comment
END INTERFACE
INTERFACE write_surf0_ol
        MODULE PROCEDURE write_surfx0_ol
        MODULE PROCEDURE write_surfn0_ol
        MODULE PROCEDURE write_surfc0_ol
        MODULE PROCEDURE write_surfl0_ol
END INTERFACE
INTERFACE write_surf0_time_ol
        MODULE PROCEDURE write_surfx0_time_ol
END INTERFACE
INTERFACE write_surfx1n1_ol
        MODULE PROCEDURE write_surfx1_ol
        MODULE PROCEDURE write_surfn1_ol
END INTERFACE
INTERFACE write_surfl1x2_ol
        MODULE PROCEDURE write_surfl1_ol
        MODULE PROCEDURE write_surfx2_ol
        MODULE PROCEDURE write_surfx3_ol
END INTERFACE
INTERFACE write_surft_ol
        MODULE PROCEDURE write_surft0_ol
END INTERFACE
!
CONTAINS
!
SUBROUTINE get_comment(HCOMMENT_IN, HDIM_OUT, HCOMMENT_OUT)
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
 CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT_IN
 CHARACTER(LEN=*), INTENT(OUT) :: HCOMMENT_OUT
 CHARACTER(LEN=*), INTENT(OUT) :: HDIM_OUT
!
INTEGER :: ILEN, JSIZE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:GET_COMMENT',0,zhook_handle)
!
ilen = len_trim(hcomment_in)
IF (ilen/=0) THEN
  IF (hcomment_in(ilen:ilen)==")") THEN
    DO jsize = ilen,1,-1
      IF (hcomment_in(jsize:jsize)=="(") THEN
        hdim_out = hcomment_in(jsize+1:ilen-1)
        hcomment_out = hcomment_in(1:jsize-1)
      ENDIF
    ENDDO
  ELSE
    hdim_out = "-"
    hcomment_out = hcomment_in
  ENDIF
ELSE
  hcomment_out = " "
  hdim_out = "-"
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:GET_COMMENT',1,zhook_handle)
!
END SUBROUTINE get_comment
!
!     #############################################################
      SUBROUTINE write_surfx0_ol(HSELECT,HREC,PFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *WRITEX0* - routine to read a real scalar
!
USE modd_io_surf_ol, ONLY : nid_nc, ldef
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
 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
!
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YCOMMENT
 CHARACTER(LEN=100), DIMENSION(1) :: YATT_TITLE, YATT
INTEGER, DIMENSION(0) :: IDIMS
INTEGER              :: IFILE_ID, IVAR_ID, JRET
INTEGER,DIMENSION(2) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX0_OL',0,zhook_handle)
!
IF (ldef) THEN
  !
  yatt_title(1) = "units"
  CALL get_comment(hcomment,yatt(1),ycomment)  
  !
  IF (nid_nc/=0) CALL def_var_netcdf(hselect,nid_nc,hrec,hcomment,idims,yatt_title,yatt,ivar_id,nf90_double)
  !
ELSE
  !
  kresp=0
  !
  ! 0. find filename
  ! -----------------
  ifile_id = nid_nc
  ! 
  IF (ifile_id /= 0) THEN        
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)  
    ! 2. Put variable
    !----------------------------
    iret(2)=nf90_put_var(ifile_id,ivar_id,pfield)
  ENDIF
  !
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,2
    IF (ifile_id==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
  ENDDO
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX0_OL',1,zhook_handle)
!
END SUBROUTINE write_surfx0_ol
!
!     #############################################################
      SUBROUTINE write_surfn0_ol(HSELECT,HREC,KFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *WRITEN0* - routine to read an integer
!
USE modd_io_surf_ol, ONLY : nid_nc, ldef
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
 CHARACTER(LEN=12),  INTENT(IN)  :: HREC     ! name of the article to be read
INTEGER,            INTENT(IN)  :: KFIELD   ! the integer scalar to be read
INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: HCOMMENT
!
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YCOMMENT
 CHARACTER(LEN=100), DIMENSION(1) :: YATT_TITLE, YATT
INTEGER, DIMENSION(0) :: IDIMS
INTEGER              :: IFILE_ID, IVAR_ID, JRET
INTEGER,DIMENSION(2) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFN0_OL',0,zhook_handle)
!
IF (ldef) THEN
  !
  yatt_title(1) = "units"
  CALL get_comment(hcomment,yatt(1),ycomment)  
  !
  IF (nid_nc/=0) CALL def_var_netcdf(hselect,nid_nc,hrec,hcomment,idims,yatt_title,yatt,ivar_id,nf90_int)
  !
ELSE
  !
  kresp=0
  !
  ! 0. find filename
  ! -----------------
  ifile_id = nid_nc
  !
  IF (ifile_id /= 0) THEN    
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)   
    ! 2. Get variable
    !----------------------------
    iret(2)=nf90_put_var(ifile_id,ivar_id,kfield)  
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,2
    IF (ifile_id==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
  ENDDO
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFN0_OL',1,zhook_handle)
!
END SUBROUTINE write_surfn0_ol
!
!     #############################################################
      SUBROUTINE write_surfc0_ol(HSELECT,HREC,HFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *WRITEC0* - routine to read a STRING
!
USE modd_io_surf_ol, ONLY : nid_nc, ldef
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
 CHARACTER(LEN=12),  INTENT(IN)  :: HREC     ! name of the article to be read
 CHARACTER(LEN=40),  INTENT(IN)  :: HFIELD   ! the integer scalar to be read
INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: HCOMMENT
!
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YCOMMENT
 CHARACTER(LEN=100), DIMENSION(1) :: YATT_TITLE, YATT
INTEGER, DIMENSION(0) :: IDIMS
 CHARACTER(LEN=100)   :: YFIELD
INTEGER              :: IFILE_ID, IVAR_ID, JRET
INTEGER,DIMENSION(2) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFC0_OL',0,zhook_handle)
!
IF (ldef) THEN
  !
  yatt_title(1) = "units"
  CALL get_comment(hcomment,yatt(1),ycomment)
  !
  IF (nid_nc/=0) CALL def_var_netcdf(hselect,nid_nc,hrec,hcomment,idims,yatt_title,yatt,&
                                     ivar_id,nf90_char,len_trim(hfield))
  !
ELSE
  !
  kresp=0
  !
  ! 0. find filename
  ! -----------------
  ifile_id = nid_nc
  !
  IF (ifile_id /= 0) THEN 
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
    ! 2. Get variable
    !----------------------------
    yfield=hfield(:len_trim(hfield))
    iret(2)=nf90_put_var(ifile_id,ivar_id,yfield)  
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,2
    IF (ifile_id==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
  ENDDO
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFC0_OL',1,zhook_handle)
!
END SUBROUTINE write_surfc0_ol
!
!     #############################################################
      SUBROUTINE write_surfl0_ol(HSELECT,HREC,OFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *WRITEL0* - routine to read a logical
!    
USE modd_io_surf_ol, ONLY : nid_nc, ldef
!
USE modi_def_var_netcdf
USE modi_handle_err
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
 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
!
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YCOMMENT
 CHARACTER(LEN=100), DIMENSION(1) :: YATT_TITLE, YATT
INTEGER, DIMENSION(0) :: IDIMS
 CHARACTER(LEN=1)     :: YFIELD   ! work array read in the file
INTEGER              :: IFILE_ID, IVAR_ID, JRET
INTEGER,DIMENSION(2) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFL0_OL',0,zhook_handle)
!
IF (ldef) THEN
  !
  yatt_title(1) = "units"
  CALL get_comment(hcomment,yatt(1),ycomment)  
  !
  IF (nid_nc/=0) CALL def_var_netcdf(hselect,nid_nc,hrec,hcomment,idims,yatt_title,yatt,ivar_id,nf90_char)
  !
ELSE
  !
  kresp=0
  !
  ! 0. find filename
  ! -----------------
  ifile_id = nid_nc
  ! 
  IF (ifile_id /= 0) THEN        
    ! 1. Find id of the variable
    !----------------------------
    iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
    IF (ofield) THEN
      yfield ='T'
    ELSE
      yfield ='F'
    ENDIF    
    ! 2. Put variable
    !----------------------------
    iret(2)=nf90_put_var(ifile_id,ivar_id,yfield)
    CALL handle_err(iret(1),hrec)
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,2
    IF (ifile_id==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
  ENDDO
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFL0_OL',1,zhook_handle)
!
END SUBROUTINE write_surfl0_ol
!
!     #############################################################
      SUBROUTINE write_surfx0_time_ol(PFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *WRITEX1* - routine to fill a real 1D array for the externalised surface 
!
USE modd_io_surf_ol, ONLY: xstartw
USE modd_ol_fileid,  ONLY: xnetcdf_fileid_out, xnetcdf_filename_out
!
USE modi_handle_err
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
REAL,                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
!
!*      0.2   Declarations of local variables
!
INTEGER, DIMENSION(1) :: ISTART
INTEGER :: IVAR_ID
INTEGER :: IFILE_ID, JFILE, JRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX0_TIME_OL',0,zhook_handle)
!
kresp = 0
!
istart(1) = xstartw
!
DO jfile = 1,SIZE(xnetcdf_fileid_out) 
  !
  ifile_id = xnetcdf_fileid_out(jfile)
  !
  IF (ifile_id/=0) THEN
    !
    jret = nf90_inq_varid(ifile_id,'time',ivar_id)
    IF (jret.EQ.nf90_noerr) THEN
      jret = nf90_put_var(ifile_id,ivar_id,pfield,istart)
      CALL handle_err(jret,'time')
    ENDIF
    !
  ENDIF
  !
ENDDO
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX0_TIME_OL',1,zhook_handle)
!
END SUBROUTINE write_surfx0_time_ol
!
!     #############################################################
      SUBROUTINE write_surfx1_ol(HSELECT,HREC,PFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
!     #############################################################
!
!!****  *WRITEX1* - routine to fill a real 1D array for the externalised surface 
!  
USE modd_surfex_mpi, ONLY : nrank, npio, ncomm, nproc, xtime_npio_write, &
                            xtime_comm_write, wlog_mpi
!
USE modd_io_surf_ol, ONLY: nid_nc, ldef, lmask, nmask, nmask_ign, xstart, &
                           xstride, lpartw, xstartw, xcountw
!
USE modi_def_var_netcdf
!
USE modi_io_buff
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
 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
 CHARACTER(LEN=1),    INTENT(IN) :: HDIR     ! type of field :
                                            ! 'H' : field with
                                            !       horizontal spatial dim.
                                            ! '-' : no horizontal dim.
 CHARACTER(LEN=*), OPTIONAL,  INTENT(IN) :: HNAM_DIM       
! 
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YCOMMENT
 CHARACTER(LEN=100), DIMENSION(1) :: YATT_TITLE, YATT
INTEGER, DIMENSION(3) :: IDIMIDS
INTEGER, DIMENSION(3) :: IDIMLEN
!
 CHARACTER(LEN=100)    :: YNAME
 CHARACTER(LEN=16)     :: YNAM_DIM
INTEGER,DIMENSION(5)  :: IRET 
INTEGER :: IFILE_ID, IVAR_ID, JDIM, INDIMS
!
INTEGER :: IRET0
LOGICAL :: GFOUND
INTEGER :: JRET
INTEGER :: INFOMPI
DOUBLE PRECISION   :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX1_OL',0,zhook_handle)
!
iret(:) = 0
!
indims = 0
idimlen(:) = 0
yname = ""
!
kresp = 0
!
 CALL io_buff(hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook("WRITE_SURF_OL:WRITE_SURFX1_OL",1,zhook_handle)
IF (gfound) RETURN
!
IF (ldef) THEN
  !
  yatt_title(1) = "units"
  CALL get_comment(hcomment,yatt(1),ycomment)  
  !
  IF (PRESENT(hnam_dim)) THEN
    ynam_dim = hnam_dim
  ELSE
    ynam_dim = "Number_of_points"
  ENDIF
  !
  IF (nrank==npio) THEN 
    !
    IF (nid_nc /= 0) THEN
      !
      indims = 1      
      iret(2) = nf90_inq_dimid(nid_nc,trim(ynam_dim),idimids(1))
      IF (iret(2)/=0) THEN
        indims = 2
        iret(2) = nf90_inq_dimid(nid_nc,'lon',idimids(1))
        IF (iret(2)/=0) THEN
          iret(2) = nf90_inq_dimid(nid_nc,'xx',idimids(1))
          iret(3) = nf90_inq_dimid(nid_nc,'yy',idimids(2))
        ELSE
          iret(3) = nf90_inq_dimid(nid_nc,'lat',idimids(2))
        ENDIF
        iret0 = nf90_inq_dimid(nid_nc,'time',idimids(3))
        IF (iret0==0) indims=3
      ELSEIF (.NOT.PRESENT(hnam_dim)) THEN
        iret0 = nf90_inq_dimid(nid_nc,'time',idimids(2))
        IF (iret0==0) indims=2
      ENDIF
      !
      iret(4)=nf90_inquire_dimension(nid_nc,idimids(1),name=yname)
      !
      DO jret=1,4
        IF (iret0==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
      ENDDO
      !
      IF (yname.NE.'lon' .AND. yname.NE.'xx') THEN
        CALL def_var_netcdf(hselect,nid_nc,hrec,ycomment,idimids(1:indims),&
                yatt_title,yatt,ivar_id,nf90_double,1)
      ELSE
        CALL def_var_netcdf(hselect,nid_nc,hrec,ycomment,idimids(1:indims),&
                yatt_title,yatt,ivar_id,nf90_double)
      ENDIF
      !
      jret = nf90_put_att(nid_nc,ivar_id,"grid_mapping","Projection_Type")
      !
    ENDIF
    !
  ENDIF
  !
ELSE
  !
  IF (nrank==npio) THEN 
    !
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    !
    ! 0. find filename
    ! -----------------
    !
    ifile_id = nid_nc
    !
    IF (ifile_id /= 0) THEN
      !
      ! 1. Find id of the variable
      !----------------------------
      iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
      iret(2)=nf90_inquire_variable(ifile_id,ivar_id,ndims=indims)
      iret(3)=nf90_inquire_variable(ifile_id,ivar_id,dimids=idimids(1:indims))
      DO jdim=1,2
        jret=nf90_inquire_dimension(ifile_id,idimids(jdim),len=idimlen(jdim))
      ENDDO
      !
      iret(4)=nf90_inquire_dimension(ifile_id,idimids(1),name=yname)
      !
      ! 3. Check for errors
      !--------------------
      DO jret=1,4
        IF (ifile_id==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
      ENDDO
      !
    ENDIF
    ! 
#ifdef SFX_MPI
    xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
    !
  ELSE
    ivar_id = 0
    indims = 0
    idimids(:) = 0
    idimlen(:) = 0
    yname = ""
  ENDIF
  !
  IF (nproc>1) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
    CALL mpi_bcast(ifile_id,kind(ifile_id)/4,mpi_integer,npio,ncomm,infompi)
    xtime_comm_write = xtime_comm_write + (mpi_wtime() - xtime0)
#endif
  ENDIF
  !
  IF (ifile_id/=0) THEN
    !
    IF (yname .EQ. 'Number_of_points') THEN
      CALL write_datax1_ol(idimlen(1),indims)
    ELSE
     CALL write_datax1_ol(idimlen(1)*idimlen(2),indims)
    ENDIF
    !
  ENDIF
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX1_OL',1,zhook_handle)
!
CONTAINS
!
SUBROUTINE write_datax1_ol(KDIM,KNDIMS)
!
USE modi_gather_and_write_mpi
USE modi_unpack_same_rank
USE modi_handle_err
!
USE netcdf
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KDIM
INTEGER, INTENT(IN) :: KNDIMS
!
REAL, DIMENSION(KDIM) :: ZTAB1D
REAL, DIMENSION(KDIM) :: ZWORK_IGN
!
INTEGER,   DIMENSION(KNDIMS) :: ISTART
INTEGER,   DIMENSION(KNDIMS) :: ICOUNT
INTEGER,   DIMENSION(KNDIMS) :: ISTRIDE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX1_OL:WRITE_DATAX1_OL',0,zhook_handle)
!
IF(.NOT.ALLOCATED(nmask_ign))THEN
  IF (lmask) THEN
    CALL gather_and_write_mpi(pfield,ztab1d,nmask)
  ELSE 
    CALL gather_and_write_mpi(pfield,ztab1d)
  ENDIF
ELSE
  !ign grid 
  IF (lmask) THEN
    CALL gather_and_write_mpi(pfield,zwork_ign(1:SIZE(nmask_ign)),nmask)
  ELSE 
    CALL gather_and_write_mpi(pfield,zwork_ign(1:SIZE(nmask_ign)))
  ENDIF
  CALL unpack_same_rank(nmask_ign,zwork_ign(1:SIZE(nmask_ign)),ztab1d)
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  IF  (lpartw) THEN
    ! write partially a time-matrix. 
    ! Have to find which of the dimension is the time dimension
    DO  jdim=1,kndims
      jret=nf90_inquire_dimension(ifile_id,idimids(jdim),name=yname)
      IF ((index(yname,'time') > 0).OR.(index(yname,'TIME') >0) &
            .OR.(index(yname,'Time')>0.)) THEN
        istart(jdim)=xstartw
        icount(jdim)=xcountw
        istride(jdim)=xstride
      ELSE
        istart(jdim)=1
        icount(jdim)=idimlen(jdim)
        istride(jdim)=1
      ENDIF
    ENDDO
    iret(5)=nf90_put_var(ifile_id,ivar_id,ztab1d,istart,icount,istride)
  ELSE
    iret(5)=nf90_put_var(ifile_id,ivar_id,ztab1d)
  ENDIF
  !
  CALL handle_err(iret(5),hrec)
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX1_OL:WRITE_DATAX1_OL',1,zhook_handle)
!
END SUBROUTINE write_datax1_ol
!
END SUBROUTINE write_surfx1_ol
!
!     #############################################################
      SUBROUTINE write_surfx2_ol(HSELECT,HREC,PFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
!     #############################################################
!
!!****  *WRITEX2* - routine to fill a real 2D array for the externalised surface 
!
USE modd_surfex_mpi, ONLY : nrank, npio, ncomm, nproc, xtime_npio_write, &
                            xtime_comm_write
!
USE modd_io_surf_ol, ONLY: lmask, nmask, nmask_ign, xstart, xstride, &
                           lpartw, xstartw, xcountw, nid_nc, ldef 
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
 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
 CHARACTER(LEN=1),     INTENT(IN) :: HDIR     ! type of field :
                                             ! 'H' : field with
                                             !       horizontal spatial dim.
                                             ! '-' : no horizontal dim.
 CHARACTER(LEN=*), OPTIONAL,  INTENT(IN) :: HNAM_DIM        
! 
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YCOMMENT
 CHARACTER(LEN=100), DIMENSION(1) :: YATT_TITLE, YATT
INTEGER, DIMENSION(4) :: IDIMIDS
INTEGER, DIMENSION(4) :: IDIMLEN
!
 CHARACTER(LEN=20)     :: YNAM_DIM
 CHARACTER(LEN=100)    :: YNAME
INTEGER,DIMENSION(5)  :: IRET 
INTEGER :: IFILE_ID, IVAR_ID, JDIM, INDIMS
!
INTEGER :: IRET0
LOGICAL :: GFOUND
INTEGER :: JRET
INTEGER :: INFOMPI
DOUBLE PRECISION      :: XTIME0
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX2_OL',0,zhook_handle)
!
!
iret(:) = 0
!
indims = 0
idimlen(:) = 0
yname = ""
!
kresp = 0
!
 CALL io_buff(hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook("WRITE_SURF_OL:WRITE_SURFX2_OL",1,zhook_handle)
IF (gfound) RETURN
!
IF (ldef) THEN
  !
  yatt_title(1) = "units"
  CALL get_comment(hcomment,yatt(1),ycomment)
  !
  IF (PRESENT(hnam_dim)) THEN
    ynam_dim = hnam_dim
  ELSE
    ynam_dim = "Number_of_Patches"
  ENDIF
  !
  IF (nrank==npio) THEN
    !
    IF (nid_nc /= 0) THEN 
      !    
      ! 0. find filename
      ! -----------------
      !
      indims = 2
      IF ( trim(ynam_dim) == "Nemis_snap" ) THEN
        iret(2) = nf90_inq_dimid(nid_nc,"Nsnap_temp",idimids(1))
      ELSE
        indims = 3
        iret(2) = nf90_inq_dimid(nid_nc,"Number_of_points",idimids(1))
      ENDIF
      IF (iret(2)==0) THEN
        iret(3) = nf90_inq_dimid(nid_nc,trim(ynam_dim),idimids(2))
        IF (indims==3) iret0 = nf90_inq_dimid(nid_nc,'time',idimids(3))
      ELSE
        indims = 3
        iret(2) = nf90_inq_dimid(nid_nc,'lon',idimids(1))
        IF (iret(2)/=0) THEN
          iret(2) = nf90_inq_dimid(nid_nc,'xx',idimids(1))
          iret(3) = nf90_inq_dimid(nid_nc,'yy',idimids(2))
        ELSE
          iret(3) = nf90_inq_dimid(nid_nc,'lat',idimids(2))
        ENDIF
        iret(4) = nf90_inq_dimid(nid_nc,trim(ynam_dim),idimids(3))
        iret0 = nf90_inq_dimid(nid_nc,'time',idimids(4))
        IF (iret0==0) indims = 4
      ENDIF           
      !
      iret(5)=nf90_inquire_dimension(nid_nc,idimids(1),name=yname)
      !
      DO jret=1,5
        IF (iret0==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
      ENDDO
      !
      IF (yname .NE. 'lon' .AND. yname .NE. 'xx') THEN
        CALL def_var_netcdf(hselect,nid_nc,hrec,ycomment,idimids(1:indims),&
                yatt_title,yatt,ivar_id,nf90_double)
      ELSE
        CALL def_var_netcdf(hselect,nid_nc,hrec,ycomment,idimids(1:indims), &
                yatt_title,yatt,ivar_id,nf90_double)
      ENDIF
      !
      jret = nf90_put_att(nid_nc,ivar_id,"grid_mapping","Projection_Type")
      !
    ENDIF
    !
  ENDIF
  !
ELSE
  !
  IF (nrank==npio) THEN
    !
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    !
    ! 0. find filename
    ! -----------------
    !
    ifile_id = nid_nc
    !
    IF ( ifile_id /= 0 ) THEN
      !
      ! 1. Find id of the variable
      !----------------------------
      !
      iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
      iret(2)=nf90_inquire_variable(ifile_id,ivar_id,ndims=indims) 
      iret(3)=nf90_inquire_variable(ifile_id,ivar_id,dimids=idimids(1:indims))  
      DO jdim=1,indims
        jret=nf90_inquire_dimension(ifile_id,idimids(jdim),len=idimlen(jdim))
        IF (jret.NE.nf90_noerr) kresp=1
      ENDDO
      !
      iret(4)=nf90_inquire_dimension(ifile_id,idimids(1),name=yname)
      !  
    ENDIF
    !
    DO jret=1,4
      IF (ifile_id==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
    ENDDO
    !
#ifdef SFX_MPI
    xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
    !
  ELSE
    ivar_id = 0
    indims = 0
    idimids(:) = 0
    idimlen(:) = SIZE(pfield,2)
    yname = "" 
  ENDIF
  !
  IF (nproc>1) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
    CALL mpi_bcast(ifile_id,kind(ifile_id)/4,mpi_integer,npio,ncomm,infompi)
    xtime_comm_write = xtime_comm_write + (mpi_wtime() - xtime0)  
#endif
  ENDIF
  !
  IF (ifile_id/=0) THEN
    !
    IF (yname .EQ. 'Number_of_points') THEN
      CALL write_datax2_ol(idimlen(1),idimlen(2),indims)
    ELSE
      CALL write_datax2_ol(idimlen(1)*idimlen(2),idimlen(3),indims)
    ENDIF
    !
  ENDIF
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX2_OL',1,zhook_handle)
!
CONTAINS
!
SUBROUTINE write_datax2_ol(KDIM1,KDIM2,KNDIMS)
!
USE modd_surf_par, ONLY : xundef
!
USE modi_gather_and_write_mpi
USE modi_unpack_same_rank
USE modi_handle_err
!
USE netcdf
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KDIM1
INTEGER, INTENT(IN) :: KDIM2
INTEGER, INTENT(IN) :: KNDIMS
!
REAL, DIMENSION(KDIM1,KDIM2) :: ZTAB2D    ! work array read in the file
REAL, DIMENSION(KDIM1,SIZE(PFIELD,2)) :: ZWORK_IGN ! work array read in the file
INTEGER,         DIMENSION(KNDIMS) :: ISTART
INTEGER,         DIMENSION(KNDIMS) :: ISTRIDE
INTEGER,         DIMENSION(KNDIMS) :: ICOUNT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX2_OL:WRITE_DATAX2_OL',0,zhook_handle)
!
ztab2d(:,:) = xundef
!
IF(.NOT.ALLOCATED(nmask_ign))THEN
  IF (lmask) THEN
    CALL gather_and_write_mpi(pfield,ztab2d(:,1:SIZE(pfield,2)),nmask)
  ELSE 
    CALL gather_and_write_mpi(pfield,ztab2d(:,1:SIZE(pfield,2)))
  ENDIF
ELSE
  !ign grid 
  IF (lmask) THEN
    CALL gather_and_write_mpi(pfield,zwork_ign(1:SIZE(nmask_ign),:),nmask)
  ELSE 
    CALL gather_and_write_mpi(pfield,zwork_ign(1:SIZE(nmask_ign),:))
  ENDIF
  CALL unpack_same_rank(nmask_ign,zwork_ign(1:SIZE(nmask_ign),:),ztab2d(:,1:SIZE(pfield,2)))
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  ! 2. Put variable
  !----------------------------
  IF (lpartw) THEN
    ! write partially a time-matrix. 
    ! Have to find which of the dimension is the time dimension
    DO  jdim=1,kndims
      jret=nf90_inquire_dimension(ifile_id,idimids(jdim),name=yname)
      IF ((index(yname,'time') > 0).OR.(index(yname,'TIME') >0) &
         .OR.(index(yname,'Time')>0.)) THEN  
        istart(jdim)=xstartw
        icount(jdim)=xcountw
        istride(jdim)=xstride
      ELSE
        istart(jdim)=1
        icount(jdim)=idimlen(jdim)
        istride(jdim)=1
      ENDIF
    ENDDO
    iret(5)=nf90_put_var(ifile_id,ivar_id,ztab2d,istart,icount,istride)
  ELSE
    iret(5)=nf90_put_var(ifile_id,ivar_id,ztab2d)
  ENDIF
  !    
  CALL handle_err(iret(5),hrec)  
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX2_OL:WRITE_DATAX2_OL',1,zhook_handle)
!
END SUBROUTINE write_datax2_ol
!
END SUBROUTINE write_surfx2_ol
!
!     #############################################################
      SUBROUTINE write_surfx3_ol(HSELECT,HREC,PFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
!     #############################################################
!
!!****  *WRITEX2* - routine to fill a real 2D array for the externalised surface 
!
USE modd_surfex_mpi, ONLY : nrank, npio, ncomm, nproc, xtime_npio_write, &
                            xtime_comm_write
!
USE modd_io_surf_ol, ONLY: lmask, nmask, nmask_ign, xstart, xstride, &
                           lpartw, xstartw, xcountw, nid_nc, ldef 
!
USE modi_def_var_netcdf
!
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
 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
 CHARACTER(LEN=1),     INTENT(IN) :: HDIR     ! type of field :
                                             ! 'H' : field with
                                             !       horizontal spatial dim.
                                             ! '-' : no horizontal dim.
 CHARACTER(LEN=*), OPTIONAL,  INTENT(IN) :: HNAM_DIM        
! 
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YCOMMENT
 CHARACTER(LEN=100), DIMENSION(1) :: YATT_TITLE, YATT
INTEGER, DIMENSION(5) :: IDIMIDS
INTEGER, DIMENSION(5) :: IDIMLEN
!
 CHARACTER(LEN=16)     :: YNAM_DIM
 CHARACTER(LEN=100)    :: YNAME
INTEGER,DIMENSION(5)  :: IRET 
INTEGER :: IFILE_ID, IVAR_ID, JDIM, INDIMS
!
INTEGER :: IRET0
LOGICAL :: GFOUND
INTEGER :: JRET
INTEGER :: INFOMPI
DOUBLE PRECISION      :: XTIME0
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX3_OL',0,zhook_handle)
!
iret(:) = 0
!
indims = 0
idimlen(:) = 0
yname = ""
!
kresp = 0
!
 CALL io_buff(hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook("WRITE_SURF_OL:WRITE_SURFX3_OL",1,zhook_handle)
IF (gfound) RETURN
!
IF (ldef) THEN
  !
  yatt_title(1) = "units"
  CALL get_comment(hcomment,yatt(1),ycomment)
  !
  IF (PRESENT(hnam_dim)) THEN
    ynam_dim = hnam_dim
  ELSE
    CALL abor1_sfx("WRITE_SURFX3_OL: TO WRITE A 3D FIELD, HNAM_DIM IS NEEDED")
  ENDIF
  !
  IF (nrank==npio) THEN
    !
    IF (nid_nc /= 0) THEN 
      !    
      ! 0. find filename
      ! -----------------
      !
      iret(2) = nf90_inq_dimid(nid_nc,"Number_of_points",idimids(1))
      IF (iret(2)==0) THEN
        indims = 4
        iret(3) = nf90_inq_dimid(nid_nc,trim(ynam_dim),idimids(2))
        iret(4) = nf90_inq_dimid(nid_nc,'Number_of_Patches',idimids(3))
        iret0 = nf90_inq_dimid(nid_nc,'time',idimids(4))
      ELSE
        indims = 4
        iret(2) = nf90_inq_dimid(nid_nc,'lon',idimids(1))
        IF (iret(2)/=0) THEN
          iret(2) = nf90_inq_dimid(nid_nc,'xx',idimids(1))
          iret(3) = nf90_inq_dimid(nid_nc,'yy',idimids(2))
        ELSE
          iret(3) = nf90_inq_dimid(nid_nc,'lat',idimids(2))
        ENDIF
        iret(4) = nf90_inq_dimid(nid_nc,trim(ynam_dim),idimids(3))
        iret(5) = nf90_inq_dimid(nid_nc,'Number_of_Patches',idimids(4))
        iret0 = nf90_inq_dimid(nid_nc,'time',idimids(5))
        IF (iret0==0) indims = 5
      ENDIF           
      !
      iret(5)=nf90_inquire_dimension(nid_nc,idimids(1),name=yname)
      !
      DO jret=1,5
        IF (iret0==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
      ENDDO
      !
      IF (yname .NE. 'lon' .AND. yname .NE. 'xx') THEN
        CALL def_var_netcdf(hselect,nid_nc,hrec,ycomment,idimids(1:indims),&
                yatt_title,yatt,ivar_id,nf90_double)
      ELSE
        CALL def_var_netcdf(hselect,nid_nc,hrec,ycomment,idimids(1:indims), &
                yatt_title,yatt,ivar_id,nf90_double)
      ENDIF
      !
      jret = nf90_put_att(nid_nc,ivar_id,"grid_mapping","Projection_Type")
      !
    ENDIF
    !
  ENDIF
  !
ELSE
  !
  IF (nrank==npio) THEN
    !
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    !
    ! 0. find filename
    ! -----------------
    !
    ifile_id = nid_nc
    !
    IF ( ifile_id /= 0 ) THEN
      !
      ! 1. Find id of the variable
      !----------------------------
      !
      iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
      iret(2)=nf90_inquire_variable(ifile_id,ivar_id,ndims=indims) 
      iret(3)=nf90_inquire_variable(ifile_id,ivar_id,dimids=idimids(1:indims))  
      DO jdim=1,indims
        jret=nf90_inquire_dimension(ifile_id,idimids(jdim),len=idimlen(jdim))
        IF (jret.NE.nf90_noerr) kresp=1
      ENDDO
      !
      iret(4)=nf90_inquire_dimension(ifile_id,idimids(1),name=yname)
      !  
    ENDIF
    !
    DO jret=1,4
      IF (ifile_id==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
    ENDDO
    !
#ifdef SFX_MPI
    xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
    !
  ELSE
    ivar_id = 0
    indims = 0
    idimids(:) = 0
    idimlen(:) = SIZE(pfield,2)
    yname = "" 
  ENDIF
  !
  IF (nproc>1) THEN
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
    CALL mpi_bcast(ifile_id,kind(ifile_id)/4,mpi_integer,npio,ncomm,infompi)
    xtime_comm_write = xtime_comm_write + (mpi_wtime() - xtime0)  
#endif
  ENDIF
  !
  IF (ifile_id/=0) THEN
    !
    IF (yname .EQ. 'Number_of_points') THEN
      CALL write_datax3_ol(idimlen(1),idimlen(2),idimlen(3),indims)
    ELSE
      CALL write_datax3_ol(idimlen(1)*idimlen(2),idimlen(3),idimlen(4),indims)
    ENDIF
    !
  ENDIF
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX3_OL',1,zhook_handle)
!
CONTAINS
!
SUBROUTINE write_datax3_ol(KDIM1,KDIM2,KDIM3,KNDIMS)
!
USE modd_surf_par, ONLY : xundef
!
USE modi_gather_and_write_mpi
USE modi_unpack_same_rank
USE modi_handle_err
!
USE netcdf
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KDIM1
INTEGER, INTENT(IN) :: KDIM2
INTEGER, INTENT(IN) :: KDIM3
INTEGER, INTENT(IN) :: KNDIMS
!
REAL, DIMENSION(KDIM1,KDIM2,KDIM3) :: ZTAB3D    ! work array read in the file
REAL, DIMENSION(KDIM1,SIZE(PFIELD,2),SIZE(PFIELD,3)) :: ZWORK_IGN ! work array read in the file
INTEGER,         DIMENSION(KNDIMS) :: ISTART
INTEGER,         DIMENSION(KNDIMS) :: ISTRIDE
INTEGER,         DIMENSION(KNDIMS) :: ICOUNT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX3_OL:WRITE_DATAX3_OL',0,zhook_handle)
!
ztab3d(:,:,:) = xundef
!
IF(.NOT.ALLOCATED(nmask_ign))THEN
  IF (lmask) THEN
    CALL gather_and_write_mpi(pfield,ztab3d(:,1:SIZE(pfield,2),1:SIZE(pfield,3)),nmask)
  ELSE 
    CALL gather_and_write_mpi(pfield,ztab3d(:,1:SIZE(pfield,2),1:SIZE(pfield,3)))
  ENDIF
ELSE
  !ign grid 
  IF (lmask) THEN
    CALL gather_and_write_mpi(pfield,zwork_ign(1:SIZE(nmask_ign),:,:),nmask)
  ELSE 
    CALL gather_and_write_mpi(pfield,zwork_ign(1:SIZE(nmask_ign),:,:))
  ENDIF
  CALL unpack_same_rank(nmask_ign,zwork_ign(1:SIZE(nmask_ign),:,:),ztab3d(:,1:SIZE(pfield,2),1:SIZE(pfield,3)))
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  ! 2. Put variable
  !----------------------------
  IF (lpartw) THEN
    ! write partially a time-matrix. 
    ! Have to find which of the dimension is the time dimension
    DO  jdim=1,kndims
      jret=nf90_inquire_dimension(ifile_id,idimids(jdim),name=yname)
      IF ((index(yname,'time') > 0).OR.(index(yname,'TIME') >0) &
         .OR.(index(yname,'Time')>0.)) THEN  
        istart(jdim)=xstartw
        icount(jdim)=xcountw
        istride(jdim)=xstride
      ELSE
        istart(jdim)=1
        icount(jdim)=idimlen(jdim)
        istride(jdim)=1
      ENDIF
    ENDDO
    iret(5)=nf90_put_var(ifile_id,ivar_id,ztab3d,istart,icount,istride)
  ELSE
    iret(5)=nf90_put_var(ifile_id,ivar_id,ztab3d)
  ENDIF
  !    
  CALL handle_err(iret(5),hrec)  
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFX3_OL:WRITE_DATAX3_OL',1,zhook_handle)
!
END SUBROUTINE write_datax3_ol
!
END SUBROUTINE write_surfx3_ol
!
!     #############################################################
      SUBROUTINE write_surfn1_ol (HSELECT,HREC,KFIELD,KRESP,HCOMMENT,HDIR,HNAM_DIM)
!     #############################################################
!
!!****  *WRITEN0* - routine to read an integer
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
 CHARACTER(LEN=12),      INTENT(IN)  :: HREC     ! name of the article to be read
INTEGER, DIMENSION(:),  INTENT(IN)  :: KFIELD   ! the integer scalar to be read
INTEGER,                INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),     INTENT(IN)  :: HCOMMENT
 CHARACTER(LEN=1),       INTENT(IN) :: HDIR     ! type of field :
                                               ! 'H' : field with
                                               !       horizontal spatial dim.
                                               ! '-' : no horizontal dim.
 CHARACTER(LEN=*), OPTIONAL,  INTENT(IN) :: HNAM_DIM
!
!*      0.2   Declarations of local variables
!
REAL, DIMENSION(SIZE(KFIELD)) :: ZFIELD 
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFN1_OL',0,zhook_handle)
!
zfield=float(kfield)
 CALL write_surfx1_ol(hselect,hrec,zfield,kresp,hcomment,hdir,hnam_dim)
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFN1_OL',1,zhook_handle)
!
END SUBROUTINE write_surfn1_ol
!
!     #############################################################
      SUBROUTINE write_surfl1_ol(HSELECT,HREC,OFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  *WRITEL1* - routine to read a logical array
!    
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
!
USE modd_io_surf_ol, ONLY: nid_nc, ldef
!
USE modi_io_buff
USE modi_def_var_netcdf
USE modi_handle_err
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
 CHARACTER(LEN=*),      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
 CHARACTER(LEN=1),      INTENT(IN) :: HDIR     ! type of field :
                                              ! 'H' : field with
                                              !       horizontal spatial dim.
                                              ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YCOMMENT
 CHARACTER(LEN=100), DIMENSION(1) :: YATT_TITLE, YATT
INTEGER, DIMENSION(2) :: IDIMIDS
INTEGER, DIMENSION(2) :: IDIMLEN
!
 CHARACTER(LEN=100)    :: YNAME
INTEGER,DIMENSION(4)  :: IRET 
INTEGER :: IFILE_ID, IVAR_ID, JDIM, INDIMS
!
LOGICAL :: GFOUND
INTEGER :: IRET0
INTEGER :: JRET
DOUBLE PRECISION :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFL1_OL',0,zhook_handle)
!
iret(:) = 0
!
kresp = 0
!
 CALL io_buff(hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook("WRITE_SURF_OL:WRITE_SURFL1_OL",1,zhook_handle)
IF (gfound) RETURN
!
IF (ldef) THEN
  !
  yatt_title(1) = "units"
  CALL get_comment(hcomment,yatt(1),ycomment)  
  !
  IF (nrank==npio) THEN 
    !
    IF (nid_nc /= 0) THEN
      !
      IF (hrec(1:2)=='L_') THEN
        iret(1) = nf90_inq_dimid(nid_nc,'Nb_of_input_data',idimids(1))
      ELSE
        iret(1) = nf90_inq_dimid(nid_nc,'Number_of_covers',idimids(1))
      ENDIF
      iret(2) = nf90_inquire_dimension(nid_nc,idimids(1),len=idimlen(1)) 
      !     
      CALL def_var_netcdf(hselect,nid_nc,hrec,ycomment,idimids(1:1),&
                          yatt_title,yatt,ivar_id,nf90_char,1)
      !
    ENDIF
    !
  ENDIF
  !
ELSE
  !
  IF ( nrank==npio ) THEN
    !
#ifdef SFX_MPI
    xtime0 = mpi_wtime()
#endif
    !
    ! 0. find filename
    ! -----------------
    ifile_id = nid_nc
    ! 
    IF (ifile_id /= 0) THEN
      !       
      ! 1. Find id of the variable
      !----------------------------
      iret(1)=nf90_inq_varid(ifile_id,hrec,ivar_id)
      iret(2)=nf90_inquire_variable(ifile_id,ivar_id,ndims=indims)
      iret(3)=nf90_inquire_variable(ifile_id,ivar_id,dimids=idimids(1:indims))
      DO jdim=1,1
        jret=nf90_inquire_dimension(ifile_id,idimids(jdim),len=idimlen(jdim))
      ENDDO  
      !
      CALL write_datal1_ol(idimlen(1))
      !
    ENDIF
    !
    ! 3. Check for errors
    !--------------------
    DO jret=1,4
      IF (ifile_id==0 .OR. iret(jret).NE.nf90_noerr) kresp=1
    ENDDO
    !
#ifdef SFX_MPI
    xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
    !
  ENDIF
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFL1_OL',1,zhook_handle)
!
CONTAINS
!
SUBROUTINE write_datal1_ol(KDIM)
!
INTEGER, INTENT(IN) :: KDIM
!
 CHARACTER(LEN=1), DIMENSION(KDIM) :: YTAB1D  ! work array read in the file
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFL1_OL:WRITE_DATAL1_OL',0,zhook_handle)
!
DO jret=1,kdim
  IF (ofield(jret)) THEN
    ytab1d(jret) ='T'
  ELSE
    ytab1d(jret) ='F'
  ENDIF
ENDDO  
!
! 2. Put variable
!-----------------
iret(4)=nf90_put_var(ifile_id,ivar_id,ytab1d)
!
 CALL handle_err(iret(4),hrec)
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFL1_OL:WRITE_DATAL1_OL',1,zhook_handle)
END SUBROUTINE write_datal1_ol
!
END SUBROUTINE write_surfl1_ol
!
!
!     #############################################################
      SUBROUTINE write_surft0_ol(HSELECT,HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  *WRITET0* - routine to read a NETCDF  date_time scalar
!
USE modd_type_date_surf
!
USE modd_io_surf_ol, ONLY : nid_nc, ldef
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
 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
!
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100) :: YCOMMENT
 CHARACTER(LEN=100), DIMENSION(1) :: YATT_TITLE, YATT
INTEGER, DIMENSION(0) :: IDIMS
!
 CHARACTER(LEN=12) :: YRECFM    ! Name of the article to be written
INTEGER :: IFILE_ID, IVAR_ID, JRET, JWRK
INTEGER,DIMENSION(8) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFT0_OL',0,zhook_handle)
!
IF (ldef) THEN
  !
  yatt_title(1) = "units"
  CALL get_comment(hcomment,yatt(1),ycomment)  
  !
  DO jwrk=1,4
    !
    IF (jwrk==1) THEN 
      yrecfm = trim(hrec)//'-YEAR'
    ELSEIF (jwrk==2) THEN
      yrecfm = trim(hrec)//'-MONTH'
    ELSEIF (jwrk==3) THEN
      yrecfm = trim(hrec)//'-DAY'
    ELSEIF (jwrk==4) THEN
      yrecfm=trim(hrec)//'-TIME'
    ENDIF  
    !
    IF (nid_nc/=0) THEN
      IF (jwrk<4) THEN
        CALL def_var_netcdf(hselect,nid_nc,yrecfm,hcomment,idims,yatt_title,yatt,ivar_id,nf90_int)
      ELSE
        CALL def_var_netcdf(hselect,nid_nc,yrecfm,hcomment,idims,yatt_title,yatt,ivar_id,nf90_double)
      ENDIF
    ENDIF      
    !
  ENDDO
  !
ELSE
  !
  kresp=0
  !
  ! 0. find filename
  ! -----------------
  ifile_id = nid_nc
  !
  IF (ifile_id /= 0) THEN
    !
    DO jwrk = 1,4
      !
      IF (jwrk==1) THEN 
        yrecfm = trim(hrec)//'-YEAR'
      ELSEIF (jwrk==2) THEN
        yrecfm = trim(hrec)//'-MONTH'
      ELSEIF (jwrk==3) THEN
        yrecfm = trim(hrec)//'-DAY'
      ELSEIF (jwrk==4) THEN
        yrecfm=trim(hrec)//'-TIME'
      ENDIF     
      !   
      ! 1. Find id of the variable
      !----------------------------
      iret((jwrk-1)*2+1)=nf90_inq_varid(ifile_id,yrecfm,ivar_id)
      !
      IF (jwrk==1) THEN 
        iret((jwrk-1)*2+2)=nf90_put_var(ifile_id,ivar_id,kyear)
      ELSEIF (jwrk==2) THEN 
        iret((jwrk-1)*2+2)=nf90_put_var(ifile_id,ivar_id,kmonth)
      ELSEIF (jwrk==3) THEN 
        iret((jwrk-1)*2+2)=nf90_put_var(ifile_id,ivar_id,kday)        
      ELSE
        iret((jwrk-1)*2+2)=nf90_put_var(ifile_id,ivar_id,ptime)
      ENDIF
      !
    ENDDO
    !
  ENDIF
  !
  ! 3. Check for errors
  !--------------------
  DO jret=1,4
    IF (ifile_id==0.OR.iret(jret).NE.nf90_noerr) kresp=1
  ENDDO
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_OL:WRITE_SURFT0_OL',1,zhook_handle)
!
END SUBROUTINE write_surft0_ol

END MODULE mode_write_surf_ol