mode_write_surf_nc.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_nc
!
INTERFACE write_surf0_nc
        MODULE PROCEDURE write_surfx0_nc
        MODULE PROCEDURE write_surfn0_nc
        MODULE PROCEDURE write_surfc0_nc
        MODULE PROCEDURE write_surfl0_nc
END INTERFACE
INTERFACE write_surfn_nc
        MODULE PROCEDURE write_surfx1_nc
        MODULE PROCEDURE write_surfn1_nc
        MODULE PROCEDURE write_surfn2_nc
        MODULE PROCEDURE write_surfl1_nc
        MODULE PROCEDURE write_surfx2_nc
END INTERFACE
INTERFACE write_surft_nc
        MODULE PROCEDURE write_surft0_nc
        MODULE PROCEDURE write_surft1_nc
        MODULE PROCEDURE write_surft2_nc
END INTERFACE
!
 CONTAINS
!
!     #############################################################
      SUBROUTINE write_surfx0_nc (DGU, &
                                  hrec,pfield,kresp,hcomment)
!     #############################################################
!
!!****  *WRITEX0* - routine to read a real scalar
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_io_surf_nc, ONLY : nid_nc, ldef
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modi_io_buff
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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), DIMENSION(1) :: yatt_title, yatt
INTEGER, DIMENSION(0) :: idims
INTEGER :: iret
INTEGER :: ivar_id,jret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX0_NC',0,zhook_handle)
!
kresp=0
iret=0
!
yatt_title(1) = "comment"
yatt(1) = hcomment
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX0_NC',1,zhook_handle)
IF (lwork0) RETURN
!
IF (nid_nc /= 0) THEN        
  ! 1. Define the variable
  !----------------------------
  IF (ldef) THEN
    !
    CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idims, yatt_title, yatt,  ivar_id, nf_double)
    !
  ELSE
    ! 2. Put variable
    !----------------------------
    iret = nf_inq_varid(nid_nc,hrec,ivar_id)
    iret = nf_put_var_double(nid_nc,ivar_id,pfield)
  ENDIF
ENDIF
!
! 3. Check for errors
!--------------------
IF (nid_nc==0 .OR. iret.NE.nf_noerr) kresp=1
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX0_NC',1,zhook_handle)
!
END SUBROUTINE write_surfx0_nc
!
!     #############################################################
      SUBROUTINE write_surfn0_nc (DGU, &
                                  hrec,kfield,kresp,hcomment)
!     #############################################################
!
!!****  *WRITEN0* - routine to read an integer
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_io_surf_nc, ONLY : nid_nc,ldef
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modi_io_buff
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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), DIMENSION(1) :: yatt_title, yatt
INTEGER, DIMENSION(0) :: idims
INTEGER              :: ivar_id, jret
INTEGER :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN0_NC',0,zhook_handle)
!
iret = 0
kresp= 0
!
yatt_title(1) = "comment"
yatt(1) = hcomment
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN0_NC',1,zhook_handle)
IF (lwork0) RETURN
!
! 0. find filename
! -----------------
!
IF (nid_nc /= 0) THEN    
  ! 1. Find id of the variable
  !----------------------------
  IF (ldef) THEN
    CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idims, yatt_title, yatt, ivar_id, nf_int)
    ! 
    ! 2. Get variable
    !----------------------------
  ELSE
    iret=nf_inq_varid(nid_nc,hrec,ivar_id)
    iret=nf_put_var_int(nid_nc,ivar_id,kfield)
  ENDIF
ENDIF
!
! 3. Check for errors
!--------------------
IF (nid_nc==0 .OR. iret.NE.nf_noerr) kresp=1
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN0_NC',1,zhook_handle)
!
END SUBROUTINE write_surfn0_nc
!
!     #############################################################
      SUBROUTINE write_surfc0_nc (DGU, &
                                  hrec,hfield,kresp,hcomment)
!     #############################################################
!
!!****  *WRITEC0* - routine to read a STRING
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_io_surf_nc, ONLY : nid_nc, ldef
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modi_io_buff
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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), DIMENSION(1) :: yatt_title, yatt
INTEGER, DIMENSION(1) :: idims
 CHARACTER(LEN=1), DIMENSION(:), ALLOCATABLE :: yfield
INTEGER :: ivar_id, jret
INTEGER :: iret, j
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFC0_NC',0,zhook_handle)
!
kresp=0
!
yatt_title(1) = "comment"
yatt(1) = hcomment
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFC0_NC',1,zhook_handle)
IF (lwork0) RETURN
!
IF (nid_nc /= 0) THEN 
  ! 1. Find id of the variable
  !----------------------------
  IF (ldef) THEN
    iret = nf_inq_dimid(nid_nc,'char_len',idims(1))
    !
    CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idims, yatt_title, yatt, ivar_id, nf_char,len_trim(hfield))
    !
  ELSE
    iret = nf_inq_varid(nid_nc,hrec,ivar_id)
    ! 2. Get variable
    !----------------------------
    ALLOCATE(yfield(len(hfield)))
    DO j=1,len(hfield)
      yfield(j) = hfield(j:j)
    ENDDO
    iret=nf_put_var_text(nid_nc,ivar_id,yfield)
  ENDIF
ENDIF
!
! 3. Check for errors
!--------------------
IF (nid_nc==0 .OR. iret.NE.nf_noerr) kresp=1
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFC0_NC',1,zhook_handle)
!
END SUBROUTINE write_surfc0_nc
!
!     #############################################################
      SUBROUTINE write_surfl0_nc (DGU, &
                                  hrec,ofield,kresp,hcomment)
!     #############################################################
!
!!****  *WRITEL0* - routine to read a logical
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_io_surf_nc, ONLY : nid_nc,ldef
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modi_io_buff
!
USE modi_def_var_netcdf
!
USE modi_handle_err
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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), DIMENSION(1) :: yatt_title, yatt
INTEGER, DIMENSION(0) :: idims
 CHARACTER(LEN=1)    :: yfield   ! work array read in the file
INTEGER              :: ivar_id
INTEGER :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFL0_NC',0,zhook_handle)
!
IF (ofield) THEN
  yfield = 'T'
ELSE
  yfield = 'F'
ENDIF
!
iret=0
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFL0_NC',1,zhook_handle)
IF (lwork0) RETURN
!
yatt_title(1) = "comment"
yatt(1) = hcomment
!
IF (nid_nc /= 0) THEN        
  !
  IF (ldef) THEN
    CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idims, yatt_title, yatt, ivar_id, nf_char)
    !
  ELSE
    iret = nf_inq_varid(nid_nc,hrec,ivar_id)
    ! 2. Put variable
    !----------------------------
    !
    iret=nf_put_var_text(nid_nc,ivar_id,yfield)
    !
    CALL handle_err(iret,hrec)
  ENDIF
  !
ENDIF
!
! 3. Check for errors
!--------------------
IF (nid_nc==0 .OR. iret.NE.nf_noerr) kresp=1
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFL0_NC',1,zhook_handle)
!
END SUBROUTINE write_surfl0_nc
!
!
!     #############################################################
      SUBROUTINE write_surfx1_nc (DGU, &
                                  hrec,pfield,kresp,hcomment,hdir,hnam_dim)
!     #############################################################
!
!!****  *WRITEX1* - routine to fill a real 1D array for the externalised surface 
! 
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_surfex_mpi, ONLY : nrank, npio, nproc, ncomm
!
USE modd_surfex_omp, ONLY : cwork0, nwork0, nworkvar, nworkb, nworkdims, &
                            nworkids, nworklen, lwork0, nblock
!
USE modd_io_surf_nc, ONLY : nid_nc, lmask, nmask, nmask_ign, cfileout_nc,ldef
!
USE modi_def_var_netcdf
!
USE modi_io_buff
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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=16), OPTIONAL,  INTENT(IN) :: hnam_dim                                           
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100), DIMENSION(1) :: yatt_title, yatt
INTEGER, DIMENSION(2) :: idimids
INTEGER, DIMENSION(2) :: idimlen
 CHARACTER(LEN=100)    :: yname
 CHARACTER(LEN=16)     :: ynam_dim
INTEGER               :: ivar_id, jdim, indims
INTEGER               :: jret
INTEGER               :: infompi
INTEGER,DIMENSION(5)  :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX1_NC',0,zhook_handle)
!
!$OMP BARRIER
!
kresp = 0
!
iret(:) = 0
!
yatt_title(1) = "comment"
yatt(1) = hcomment
!
IF (present(hnam_dim)) THEN
  ynam_dim = hnam_dim
ELSE
  ynam_dim = "Number_of_points"
ENDIF
!
!$OMP SINGLE
!
nworkdims = 0
nworklen(:) = 0
 cwork0 = ""
nworkb=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
!
!$OMP END SINGLE
!
IF (lwork0 .AND. lhook) CALL dr_hook("WRITE_SURF_NC:WRITE_SURFX1_NC",1,zhook_handle)
IF (lwork0) RETURN
!
IF (nrank==npio) THEN 
  !
  IF (nid_nc /= 0) THEN
    !
!$OMP SINGLE
    !
    ! 0. find filename
    ! -----------------
    !
    iret(1) = nf_inq_ndims(nid_nc,nworkdims)
    iret(2) = nf_inq_dimid(nid_nc,trim(ynam_dim),nworkids(1))
    IF (iret(2)/=0) THEN
      iret(2) = nf_inq_dimid(nid_nc,'lon',nworkids(1))
      IF (iret(2)/=0) THEN
        iret(2) = nf_inq_dimid(nid_nc,'xx',nworkids(1))
        iret(3) = nf_inq_dimid(nid_nc,'yy',nworkids(2))
      ELSE
        iret(3) = nf_inq_dimid(nid_nc,'lat',nworkids(2))
      ENDIF
      nwork0=nf_inq_dimlen(nid_nc,nworkids(2),nworklen(2))
    ENDIF
    nwork0=nf_inq_dimlen(nid_nc,nworkids(1),nworklen(1))
    !
    iret(4)=nf_inq_dimname(nid_nc,nworkids(1),cwork0)
    !
    DO jret=1,4
      IF (nwork0==0 .OR. iret(jret).NE.nf_noerr) nworkb=1
    ENDDO
    !
!$OMP END SINGLE
    !
    indims = nworkdims
    idimids = nworkids(1:2)
    idimlen = nworklen(1:2)
    yname = cwork0    
    !
  ELSE
    indims = 0
    idimids(:) = 0
    idimlen(:) = 0
    yname = ""    
  ENDIF
  !
ELSE
  indims = 0
  idimids(:) = 0
  idimlen(:) = 0
  yname = ""    
ENDIF
!
kresp = nworkb
!
!$OMP BARRIER
!
#ifdef SFX_MPI
IF (nproc>1) THEN
!$OMP SINGLE
  CALL mpi_bcast(yname,len(yname),mpi_character,npio,ncomm,infompi)
  CALL mpi_bcast(indims,kind(indims)/4,mpi_integer,npio,ncomm,infompi)
  CALL mpi_bcast(idimlen,kind(idimlen)*SIZE(idimlen)/4,mpi_integer,npio,ncomm,infompi)  
!$OMP END SINGLE
ENDIF
#endif
!
IF (yname.NE.'lon' .AND. yname.NE.'xx') THEN
  IF (ldef) THEN
    IF (nrank==npio) THEN
!$OMP SINGLE
      CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idimids(1:1), yatt_title, yatt, nworkb, nf_double,1)
!$OMP END SINGLE
      ivar_id = nworkb
    ENDIF
  ELSE
    jret = nf_inq_varid(nid_nc,hrec,ivar_id)
    CALL write_datax1_nc(idimlen(1),indims)
  ENDIF
ELSE
  IF (ldef) THEN
    IF (nrank==npio) THEN
!$OMP SINGLE          
      CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idimids(1:2), yatt_title, yatt, nworkb, nf_double)
!$OMP END SINGLE
      ivar_id = nworkb
    ENDIF 
  ELSE  
    jret = nf_inq_varid(nid_nc,hrec,ivar_id)
    CALL write_datax1_nc(idimlen(1)*idimlen(2),indims)
  ENDIF
ENDIF
!
!$OMP BARRIER
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX1_NC',1,zhook_handle)
!
 CONTAINS
!
SUBROUTINE write_datax1_nc(KDIM,KNDIMS)
!
USE modd_surf_par, ONLY : xundef
!
USE modi_gather_and_write_mpi
USE modi_unpack_same_rank
USE modi_handle_err
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: kdim
INTEGER, INTENT(IN) :: kndims
!
REAL, DIMENSION(KDIM) :: ztab1d
REAL, DIMENSION(KDIM) :: zwork_ign
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX1_NC:WRITE_DATAX1_NC',0,zhook_handle)
!
ztab1d(:) = xundef
!
IF (hdir=='-') THEN
  IF (nrank==npio) ztab1d(1:SIZE(pfield)) = pfield(:)
ELSEIF(.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 
!$OMP SINGLE
  iret(5)=nf_put_var_double(nid_nc,ivar_id,ztab1d)
  CALL handle_err(iret(5),hrec)  
!$OMP END SINGLE
ENDIF

!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX1_NC:WRITE_DATAX1_NC',1,zhook_handle)
!
END SUBROUTINE write_datax1_nc
!
END SUBROUTINE write_surfx1_nc
!
!     #############################################################
      SUBROUTINE write_surfx2_nc (DGU, &
                                  hrec,pfield,kresp,hcomment,hdir,hnam_dim)
!     #############################################################
!
!!****  *WRITEX2* - routine to fill a real 2D array for the externalised surface 
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_surfex_mpi, ONLY : nrank, npio, nproc, ncomm
!
USE modd_surfex_omp, ONLY : cwork0, nwork0, nworkvar, nworkb, nworkdims, &
                            nworkids, nworklen, nblock, lwork0
!
USE modd_io_surf_nc, ONLY : nid_nc, lmask, nmask, nmask_ign, ldef
!
USE modi_io_buff
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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=16), OPTIONAL,  INTENT(IN) :: hnam_dim                                              
!*      0.2   Declarations of local variables
!
 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               :: ivar_id, jdim, indims
INTEGER               :: jret
INTEGER               :: infompi
INTEGER, DIMENSION(5) :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX2_NC',0,zhook_handle)
!
kresp = 0
!
iret(:) = 0
!
!$OMP SINGLE
!
nworkdims = 0
nworklen(:) = 0
 cwork0 = ""
nworkb=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
!
!$OMP END SINGLE
!
yatt_title(1) = "comment"
yatt(1) = hcomment
!
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN2_NC',1,zhook_handle)
IF (lwork0) RETURN
!
IF (present(hnam_dim)) THEN
  ynam_dim = hnam_dim
ELSE
  ynam_dim = "Number_of_Tile"
ENDIF
!
IF (nrank==npio) THEN
  !
  IF (nid_nc /= 0) THEN 
    !    
    ! 0. find filename
    ! -----------------
    !
!$OMP SINGLE
    !
    iret(1) = nf_inq_ndims(nid_nc,nworkdims)
    IF ( trim(ynam_dim) == "Nemis_snap" ) THEN
      iret(2) = nf_inq_dimid(nid_nc,"Nsnap_temp",nworkids(1))
    ELSE
      iret(2) = nf_inq_dimid(nid_nc,"Number_of_points",nworkids(1))
    ENDIF
    IF (iret(2)==0) THEN
      iret(3) = nf_inq_dimid(nid_nc,trim(ynam_dim),nworkids(2))
    ELSE
      iret(2) = nf_inq_dimid(nid_nc,'lon',nworkids(1))
      IF (iret(2)/=0) THEN
        iret(2) = nf_inq_dimid(nid_nc,'xx',nworkids(1))
        iret(3) = nf_inq_dimid(nid_nc,'yy',nworkids(2))
      ELSE
        iret(3) = nf_inq_dimid(nid_nc,'lat',nworkids(2))
      ENDIF
      iret(4) = nf_inq_dimid(nid_nc,trim(ynam_dim),nworkids(3))
      nwork0=nf_inq_dimlen(nid_nc,nworkids(3),nworklen(3))
    ENDIF           
    DO jdim=1,2
      nwork0=nf_inq_dimlen(nid_nc,nworkids(jdim),nworklen(jdim))
    ENDDO
    !
    iret(5)=nf_inq_dimname(nid_nc,nworkids(1),cwork0)
    !
    DO jret=1,5
      IF (nwork0==0 .OR. iret(jret).NE.nf_noerr) nworkb=1
    ENDDO
    !
!$OMP END SINGLE
    !
    indims = nworkdims
    idimids = nworkids(1:3)
    idimlen = nworklen(1:3)
    yname = cwork0
    !
  ELSE
    indims = 0
    idimids(:) = 0
    idimlen(:) = 0
    yname = ""
  ENDIF
  !
ELSE
  indims = 0
  idimids(:) = 0
  idimlen(:) = SIZE(pfield,2)
  yname = ""        
ENDIF
!
kresp = nworkb
!
!$OMP BARRIER
!
#ifdef SFX_MPI
IF (nproc>1) THEN
!$OMP SINGLE
  CALL mpi_bcast(yname,len(yname),mpi_character,npio,ncomm,infompi)
  CALL mpi_bcast(indims,kind(indims)/4,mpi_integer,npio,ncomm,infompi)
  CALL mpi_bcast(idimlen,kind(idimlen)*SIZE(idimlen)/4,mpi_integer,npio,ncomm,infompi)
!$OMP END SINGLE
ENDIF
#endif
!
IF (yname .NE. 'lon' .AND. yname .NE. 'xx') THEN
  IF (ldef) THEN
    IF (nrank==npio) THEN
!$OMP SINGLE
      CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idimids(1:2), yatt_title, yatt, nworkb, nf_double)
!$OMP END SINGLE
      ivar_id = nworkb
    ENDIF
  ELSE
    jret = nf_inq_varid(nid_nc,hrec,ivar_id)
    CALL write_datax2_nc(idimlen(1),idimlen(2),indims)
  ENDIF
ELSE
  IF (ldef) THEN
    IF (nrank==npio) THEN
!$OMP SINGLE      
      CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idimids(1:3), yatt_title, yatt, nworkb, nf_double)
!$OMP END SINGLE
      ivar_id = nworkb
    ENDIF
  ELSE
    jret = nf_inq_varid(nid_nc,hrec,ivar_id)
    CALL write_datax2_nc(idimlen(1)*idimlen(2),idimlen(3),indims)
  ENDIF
ENDIF
!
!$OMP BARRIER
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX2_NC',1,zhook_handle)
!
 CONTAINS
!
SUBROUTINE write_datax2_nc(KDIM1,KDIM2,KNDIMS)
!
USE modd_surf_par, ONLY : xundef
!
USE modi_gather_and_write_mpi
USE modi_unpack_same_rank
USE modi_handle_err
!
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
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX2_NC:WRITE_DATAX2_NC',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
!$OMP SINGLE
  iret(5)=nf_put_var_double(nid_nc,ivar_id,ztab2d)
  CALL handle_err(iret(5),hrec)  
!$OMP END SINGLE
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFX2_NC:WRITE_DATAX2_NC',1,zhook_handle)
!
END SUBROUTINE write_datax2_nc
!
END SUBROUTINE write_surfx2_nc

!     #############################################################
      SUBROUTINE write_surfn1_nc (DGU, &
                                  hrec,kfield,kresp,hcomment,hdir,hnam_dim)
!     #############################################################
!
!!****  *WRITEN0* - routine to read an integer
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_surfex_mpi, ONLY : nrank, npio, nproc, ncomm
!
USE modd_surfex_omp, ONLY : cwork0, nwork0, nworkvar, nworkb, nworkdims, &
                            nworkids, nworklen, lwork0
!
USE modd_io_surf_nc, ONLY : nid_nc, lmask, nmask, nmask_ign, cfileout_nc, ldef
!
USE modi_def_var_netcdf
!
USE modi_io_buff
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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=16), OPTIONAL,  INTENT(IN) :: hnam_dim  
! 
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100), DIMENSION(1) :: yatt_title, yatt
INTEGER, DIMENSION(2) :: idimids
INTEGER, DIMENSION(2) :: idimlen
 CHARACTER(LEN=100)    :: yname
 CHARACTER(LEN=16)     :: ynam_dim
INTEGER               :: ivar_id, jdim
INTEGER               :: jret
INTEGER               :: infompi
INTEGER,DIMENSION(5)  :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN1_NC',0,zhook_handle)
!
kresp = 0
!
iret(:) = 0
!
yatt_title(1) = "comment"
yatt(1) = hcomment
!
IF (present(hnam_dim)) THEN
  ynam_dim = hnam_dim
ELSE
  ynam_dim = "Number_of_points"
ENDIF
!
!$OMP SINGLE
!
nworklen(:) = 0
 cwork0 = ""
nworkb=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
!
!$OMP END SINGLE
!
IF (lwork0 .AND. lhook) CALL dr_hook("WRITE_SURF_NC:WRITE_SURFN1_NC",1,zhook_handle)
IF (lwork0) RETURN
!
IF (nrank==npio) THEN 
  !
  IF (nid_nc /= 0) THEN
    !
!$OMP SINGLE
    !
    ! 0. find filename
    ! -----------------
    !
    iret(2) = nf_inq_dimid(nid_nc,trim(ynam_dim),nworkids(1))
    IF (iret(2)/=0) THEN
      iret(2) = nf_inq_dimid(nid_nc,'lon',nworkids(1))
      IF (iret(2)/=0) THEN
        iret(2) = nf_inq_dimid(nid_nc,'xx',nworkids(1))
        iret(3) = nf_inq_dimid(nid_nc,'yy',nworkids(2))
      ELSE
        iret(3) = nf_inq_dimid(nid_nc,'lat',nworkids(2))
      ENDIF
      nwork0=nf_inq_dimlen(nid_nc,nworkids(2),nworklen(2))
    ENDIF
    nwork0=nf_inq_dimlen(nid_nc,nworkids(1),nworklen(1))
    !
    iret(4)=nf_inq_dimname(nid_nc,nworkids(1),cwork0)
    !
    DO jret=1,4
      IF (nwork0==0 .OR. iret(jret).NE.nf_noerr) nworkb=1
    ENDDO
    !
!$OMP END SINGLE
    !
    idimids = nworkids(1:2)
    idimlen = nworklen(1:2)
    yname = cwork0    
    !
  ELSE
    idimids(:) = 0
    idimlen(:) = 0
    yname = ""    
  ENDIF
  !
ELSE
  idimids(:) = 0
  idimlen(:) = 0
  yname = ""    
ENDIF
!
kresp = nworkb
!
!$OMP BARRIER
!
#ifdef SFX_MPI
IF (nproc>1) THEN
!$OMP SINGLE
  CALL mpi_bcast(yname,len(yname),mpi_character,npio,ncomm,infompi)
  CALL mpi_bcast(idimlen,kind(idimlen)*SIZE(idimlen)/4,mpi_integer,npio,ncomm,infompi)  
!$OMP END SINGLE
ENDIF
#endif
!
IF (yname.NE.'lon' .AND. yname.NE.'xx') THEN
  IF (ldef) THEN
    IF (nrank==npio) THEN
!$OMP SINGLE
      CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idimids(1:1), yatt_title, yatt, nworkb, nf_int)
!$OMP END SINGLE
      ivar_id = nworkb
    ENDIF
  ELSE
    jret = nf_inq_varid(nid_nc,hrec,ivar_id)
    CALL write_datan1_nc(idimlen(1))
  ENDIF
ELSE
  IF (ldef) THEN
    IF (nrank==npio) THEN
!$OMP SINGLE          
      CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idimids(1:2), yatt_title, yatt, nworkb, nf_int)
!$OMP END SINGLE
      ivar_id = nworkb
    ENDIF  
  ELSE
    jret = nf_inq_varid(nid_nc,hrec,ivar_id)    
    CALL write_datan1_nc(idimlen(1)*idimlen(2))
  ENDIF
ENDIF
!
!$OMP BARRIER
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN1_NC',1,zhook_handle)
!
 CONTAINS
!
SUBROUTINE write_datan1_nc(KDIM)
!
USE modd_surf_par, ONLY : nundef
!
USE modi_gather_and_write_mpi
USE modi_unpack_same_rank
USE modi_handle_err
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: kdim
!
INTEGER, DIMENSION(KDIM) :: itab1d
INTEGER, DIMENSION(KDIM) :: iwork_ign
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN1_NC:WRITE_DATAN1_NC',0,zhook_handle)
!
itab1d(:) = nundef
!
IF (hdir=='-') THEN
  IF ( nrank==npio ) itab1d(1:SIZE(kfield)) = kfield(:)
ELSEIF(.NOT.ALLOCATED(nmask_ign))THEN
  IF (lmask) THEN
    CALL gather_and_write_mpi(kfield,itab1d,nmask)
  ELSE 
    CALL gather_and_write_mpi(kfield,itab1d)
  ENDIF
ELSE
  !ign grid 
  IF (lmask) THEN
    CALL gather_and_write_mpi(kfield,iwork_ign(1:SIZE(nmask_ign)),nmask)
  ELSE 
    CALL gather_and_write_mpi(kfield,iwork_ign(1:SIZE(nmask_ign)))
  ENDIF
  CALL unpack_same_rank(nmask_ign,iwork_ign(1:SIZE(nmask_ign)),itab1d)
ENDIF
!
IF (nrank==npio) THEN 
!$OMP SINGLE
  iret(5)=nf_put_var_int(nid_nc,ivar_id,itab1d)
  CALL handle_err(iret(5),hrec)  
!$OMP END SINGLE
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN1_NC:WRITE_DATAN1_NC',1,zhook_handle)
!
END SUBROUTINE write_datan1_nc
!
END SUBROUTINE write_surfn1_nc
!

!     #############################################################
      SUBROUTINE write_surfn2_nc (DGU, &
                                  hrec,kfield,kresp,hcomment,hdir,hnam_dim)
!     #############################################################
!
!!****  *WRITEN0* - routine to read an integer
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_surfex_mpi, ONLY : nrank, npio, nproc, ncomm
!
USE modd_surfex_omp, ONLY : cwork0, nwork0, nworkvar, nworkb, nworkdims, &
                            nworkids, nworklen, nblock, lwork0
!
USE modd_io_surf_nc, ONLY : nid_nc, lmask, nmask, nmask_ign, ldef
!
USE modi_io_buff
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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=16), OPTIONAL,  INTENT(IN) :: hnam_dim                                                 
!*      0.2   Declarations of local variables
!
 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               :: ivar_id, jdim, indims
INTEGER               :: jret
INTEGER               :: infompi
INTEGER, DIMENSION(5) :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN2_NC',0,zhook_handle)
!
kresp = 0
!
iret(:) = 0
!
!$OMP SINGLE
!
nworkdims = 0
nworklen(:) = 0
 cwork0 = ""
nworkb=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
!
!$OMP END SINGLE
!
yatt_title(1) = "comment"
yatt(1) = hcomment
!
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN2_NC',1,zhook_handle)
IF (lwork0) RETURN
!
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 
    !    
    ! 0. find filename
    ! -----------------
    !
!$OMP SINGLE
    !
    iret(1) = nf_inq_ndims(nid_nc,nworkdims)
    iret(2) = nf_inq_dimid(nid_nc,trim(ynam_dim),nworkids(1))
    IF (iret(2)==0) THEN
      iret(3) = nf_inq_dimid(nid_nc,'Number_of_Tile',nworkids(2))
    ELSE
      iret(2) = nf_inq_dimid(nid_nc,'lon',nworkids(1))
      IF (iret(2)/=0) THEN
        iret(2) = nf_inq_dimid(nid_nc,'xx',nworkids(1))
        iret(3) = nf_inq_dimid(nid_nc,'yy',nworkids(2))
      ELSE
        iret(3) = nf_inq_dimid(nid_nc,'lat',nworkids(2))
      ENDIF
      iret(4) = nf_inq_dimid(nid_nc,'Number_of_Tile',nworkids(3))
      nwork0=nf_inq_dimlen(nid_nc,nworkids(3),nworklen(3))
    ENDIF           
    DO jdim=1,2
      nwork0=nf_inq_dimlen(nid_nc,nworkids(jdim),nworklen(jdim))
    ENDDO
    !
    iret(5)=nf_inq_dimname(nid_nc,nworkids(1),cwork0)
    !
    DO jret=1,5
      IF (nwork0==0 .OR. iret(jret).NE.nf_noerr) nworkb=1
    ENDDO
    !
!$OMP END SINGLE
    !
    indims = nworkdims
    idimids = nworkids(1:3)
    idimlen = nworklen(1:3)
    yname = cwork0
    !
  ELSE
    indims = 0
    idimids(:) = 0
    idimlen(:) = 0
    yname = ""
  ENDIF
  !
ELSE
  indims = 0
  idimids(:) = 0
  idimlen(:) = SIZE(kfield,2)
  yname = ""        
ENDIF
!
kresp = nworkb
!
!$OMP BARRIER
!
#ifdef SFX_MPI
IF (nproc>1) THEN
!$OMP SINGLE
  CALL mpi_bcast(yname,len(yname),mpi_character,npio,ncomm,infompi)
  CALL mpi_bcast(indims,kind(indims)/4,mpi_integer,npio,ncomm,infompi)
  CALL mpi_bcast(idimlen,kind(idimlen)*SIZE(idimlen)/4,mpi_integer,npio,ncomm,infompi)  
!$OMP END SINGLE
ENDIF
#endif
!
IF (yname .NE. 'lon' .AND. yname .NE. 'xx') THEN
  IF (ldef) THEN
    IF (nrank==npio) THEN
!$OMP SINGLE
      CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idimids(1:2), yatt_title, yatt, nworkb, nf_int)
!$OMP END SINGLE
      ivar_id = nworkb
    ENDIF
  ELSE
    jret = nf_inq_varid(nid_nc,hrec,ivar_id)
    CALL write_datan2_nc(idimlen(1),idimlen(2),indims)
  ENDIF
ELSE
  IF (ldef) THEN
    IF (nrank==npio) THEN
!$OMP SINGLE          
      CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idimids(1:3), yatt_title, yatt, nworkb, nf_int)
!$OMP END SINGLE
      ivar_id = nworkb
    ENDIF 
  ELSE
    jret = nf_inq_varid(nid_nc,hrec,ivar_id)    
    CALL write_datan2_nc(idimlen(1)*idimlen(2),idimlen(3),indims)
  ENDIF
ENDIF
!
!$OMP BARRIER
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN2_NC',1,zhook_handle)
!
 CONTAINS
!
SUBROUTINE write_datan2_nc(KDIM1,KDIM2,KNDIMS)
!
USE modd_surf_par, ONLY : nundef
!
USE modi_gather_and_write_mpi
USE modi_unpack_same_rank
USE modi_handle_err
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: kdim1
INTEGER, INTENT(IN) :: kdim2
INTEGER, INTENT(IN) :: kndims
!
INTEGER, DIMENSION(KDIM1,KDIM2) :: itab2d    ! work array read in the file
INTEGER, DIMENSION(KDIM1,KDIM2) :: iwork_ign ! work array read in the file
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN2_NC:WRITE_DATAN2_NC',0,zhook_handle)
!
itab2d(:,:) = nundef
!
IF(.NOT.ALLOCATED(nmask_ign))THEN
  IF (lmask) THEN
    CALL gather_and_write_mpi(kfield,itab2d(:,1:SIZE(kfield,2)),nmask)
  ELSE 
    CALL gather_and_write_mpi(kfield,itab2d(:,1:SIZE(kfield,2)))
  ENDIF
ELSE
  !ign grid 
  IF (lmask) THEN
    CALL gather_and_write_mpi(kfield,iwork_ign(1:SIZE(nmask_ign),:),nmask)
  ELSE 
    CALL gather_and_write_mpi(kfield,iwork_ign(1:SIZE(nmask_ign),:))
  ENDIF
  CALL unpack_same_rank(nmask_ign,iwork_ign(1:SIZE(nmask_ign),:),itab2d(:,1:SIZE(kfield,2)))
ENDIF
!
IF (nrank==npio) THEN
!$OMP SINGLE
  iret(5)=nf_put_var_int(nid_nc,ivar_id,itab2d)
  CALL handle_err(iret(5),hrec)  
!$OMP END SINGLE
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFN2_NC:WRITE_DATAN2_NC',1,zhook_handle)
!
END SUBROUTINE write_datan2_nc
!
END SUBROUTINE write_surfn2_nc
!
!     #############################################################
      SUBROUTINE write_surfl1_nc (DGU, &
                                  hrec,ofield,kresp,hcomment,hdir)
!     #############################################################
!
!!****  *WRITEL1* - routine to read a logical array
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_surfex_mpi, ONLY : nrank, npio
!
USE modd_io_surf_nc, ONLY : nid_nc, lmask, nmask, nmask_ign, ldef
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modi_io_buff
!
USE modi_def_var_netcdf
!
USE modi_handle_err
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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), DIMENSION(1) :: yatt_title, yatt
INTEGER, DIMENSION(1) :: idimids
INTEGER, DIMENSION(1) :: idimlen
INTEGER               :: ivar_id, jdim, indims
INTEGER               :: jret
INTEGER, DIMENSION(3) :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFL1_NC',0,zhook_handle)
!
iret(:) = 0
!
yatt_title(1) = "comment"
yatt(1) = hcomment
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFL1_NC',1,zhook_handle)
IF (lwork0) RETURN
!
IF (nid_nc /= 0) THEN 
  !
  IF (nrank==npio) THEN
    !
!$OMP SINGLE
    !
    ! 0. find filename
    ! -----------------
    !
    iret(1) = nf_inq_dimid(nid_nc,'Number_of_covers',idimids(1))
    iret(2) = nf_inq_dimlen(nid_nc,idimids(1),idimlen(1))
    !
    IF (ldef) THEN
      CALL def_var_netcdf(dgu, &
                        nid_nc, hrec, hrec, idimids(1:1), yatt_title, yatt, ivar_id, nf_char, 1)
    !
    ELSE
      jret = nf_inq_varid(nid_nc, hrec, ivar_id)
      CALL write_datal1_nc(idimlen(1))
    ENDIF
    !
!$OMP END SINGLE
    !
  ENDIF
  !
ENDIF
!
!$OMP BARRIER
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFL1_NC',1,zhook_handle)
!
 CONTAINS
!
SUBROUTINE write_datal1_nc(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_NC:WRITE_SURFL1_NC:WRITE_DATAL1_NC',0,zhook_handle)
!
ytab1d(:) = ""
!
DO jret=1,SIZE(ofield)
  IF (ofield(jret)) THEN
    ytab1d(jret) ='T'
  ELSE
    ytab1d(jret) ='F'
  ENDIF
ENDDO  
!
! 2. Put variable
!-----------------
iret(3)=nf_put_var_text(nid_nc,ivar_id,ytab1d)
!
 CALL handle_err(iret(3),hrec)
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFL1_NC:WRITE_DATAL1_NC',1,zhook_handle)
END SUBROUTINE write_datal1_nc
!
END SUBROUTINE write_surfl1_nc
!
!
!     #############################################################
      SUBROUTINE write_surft0_nc (DGU, &
                                  hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
!     #############################################################
!
!!****  *WRITET0* - routine to read a NETCDF  date_time scalar
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_io_surf_nc, ONLY : nid_nc, lmask, nmask, nmask_ign, ldef
!
USE modd_surfex_omp, ONLY : lwork0
!
USE modi_io_buff
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      0.1   Declarations of arguments
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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), DIMENSION(1) :: yatt_title, yatt
INTEGER, DIMENSION(0) :: idimids
 CHARACTER(LEN=12) :: yrecfm    ! Name of the article to be written
INTEGER :: ivar_id, jret, jwrk
INTEGER :: jlen
INTEGER,DIMENSION(4) :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFT0_NC',0,zhook_handle)
!
kresp=0
!
yatt_title(1) = "comment"
yatt(1) = hcomment
!
 CALL io_buff(&
                hrec,'W',lwork0)
IF (lwork0 .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFT0_NC',1,zhook_handle)
IF (lwork0) RETURN
!
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
  ! 0. find filename
  ! -----------------
  !
  IF (nid_nc /= 0) THEN
    !
    !
    IF (jwrk==1) THEN
      IF (ldef) THEN
        CALL def_var_netcdf(dgu, &
                        nid_nc, yrecfm, yrecfm, idimids, yatt_title, yatt, ivar_id,nf_int)
      ELSE
        jret = nf_inq_varid(nid_nc,yrecfm,ivar_id)
        iret(jwrk)=nf_put_var_int(nid_nc,ivar_id,kyear)
      ENDIF
    ELSEIF (jwrk==2) THEN
      IF (ldef) THEN    
        CALL def_var_netcdf(dgu, &
                        nid_nc, yrecfm, yrecfm, idimids, yatt_title, yatt, ivar_id,nf_int)
      ELSE
        jret = nf_inq_varid(nid_nc,yrecfm,ivar_id)        
        iret(jwrk)=nf_put_var_int(nid_nc,ivar_id,kmonth)
      ENDIF        
    ELSEIF (jwrk==3) THEN
      IF (ldef) THEN    
        CALL def_var_netcdf(dgu, &
                        nid_nc, yrecfm, yrecfm, idimids, yatt_title, yatt, ivar_id,nf_int)
      ELSE
        jret = nf_inq_varid(nid_nc,yrecfm,ivar_id)        
        iret(jwrk)=nf_put_var_int(nid_nc,ivar_id,kday)
      ENDIF        
    ELSEIF (jwrk==4) THEN
      IF (ldef) THEN    
        CALL def_var_netcdf(dgu, &
                        nid_nc, yrecfm, yrecfm, idimids, yatt_title, yatt, ivar_id,nf_double)
      ELSE
        jret = nf_inq_varid(nid_nc,yrecfm,ivar_id)        
        iret(jwrk)=nf_put_var_double(nid_nc,ivar_id,ptime)
      ENDIF        
    ENDIF
  ENDIF
ENDDO
!
! 3. Check for errors
!--------------------
DO jret=1,4
  IF (nid_nc==0.OR.iret(jret).NE.nf_noerr) kresp=1
ENDDO
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFT0_NC',1,zhook_handle)
!
END SUBROUTINE write_surft0_nc
!
!     #############################################################
      SUBROUTINE    write_surft1_nc (DGU, &
                                     hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
!     #############################################################
!
!!****  *WRITET0* - routine to read a NETCDF  date_time scalar
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_io_surf_nc, ONLY : nid_nc, lmask, nmask, nmask_ign
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      0.1   Declarations of arguments
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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
!
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100)    :: yname
 CHARACTER(LEN=12) :: yrecfm    ! Name of the article to be written
INTEGER :: jret, jwrk, idimid
INTEGER,DIMENSION(4) :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFT1_NC',0,zhook_handle)
!
kresp=0
!
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
  !
  jret = nf_inq_dimid(nid_nc,'Number_of_dates ',idimid)
  !
  IF (jret==0) THEN
    IF (jwrk==1) THEN
      CALL write_surfn1_nc(dgu, &
                           yrecfm,kyear,iret(jwrk),hcomment,'-','Number_of_dates ')
    ELSEIF (jwrk==2) THEN
      CALL write_surfn1_nc(dgu, &
                           yrecfm,kmonth,iret(jwrk),hcomment,'-','Number_of_dates ')
    ELSEIF (jwrk==3) THEN
      CALL write_surfn1_nc(dgu, &
                           yrecfm,kday,iret(jwrk),hcomment,'-','Number_of_dates ')
    ELSEIF (jwrk==4) THEN
      CALL write_surfx1_nc(dgu, &
                           yrecfm,ptime,iret(jwrk),hcomment,'-','Number_of_dates ')
    ENDIF
  ELSE
    IF (jwrk==1) THEN
      CALL write_surfn1_nc(dgu, &
                           yrecfm,kyear,iret(jwrk),hcomment,'-')
    ELSEIF (jwrk==2) THEN
      CALL write_surfn1_nc(dgu, &
                           yrecfm,kmonth,iret(jwrk),hcomment,'-')
    ELSEIF (jwrk==3) THEN
      CALL write_surfn1_nc(dgu, &
                           yrecfm,kday,iret(jwrk),hcomment,'-')
    ELSEIF (jwrk==4) THEN
      CALL write_surfx1_nc(dgu, &
                           yrecfm,ptime,iret(jwrk),hcomment,'-')
    ENDIF
  ENDIF    
  !
ENDDO
!
! 3. Check for errors
!--------------------
DO jret=1,4
  IF (nid_nc==0.OR.iret(jret).NE.nf_noerr) kresp=1
ENDDO
!
!$OMP BARRIER
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFT1_NC',1,zhook_handle)
!
END SUBROUTINE write_surft1_nc
!
!     #############################################################
      SUBROUTINE    write_surft2_nc (DGU, &
                                     hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
!     #############################################################
!
!!****  *WRITET0* - routine to read a NETCDF  date_time scalar
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_io_surf_nc, ONLY : nid_nc, lmask, nmask, nmask_ign
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!*      0.1   Declarations of arguments
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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
!
!*      0.2   Declarations of local variables
!
 CHARACTER(LEN=100)    :: yname
 CHARACTER(LEN=12) :: yrecfm    ! Name of the article to be written
INTEGER :: jret, jwrk, idimid
INTEGER,DIMENSION(4) :: iret
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFT2_NC',0,zhook_handle)
!
kresp=0
!
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
  !
  jret = nf_inq_dimid(nid_nc,'Number_of_dates ',idimid)
  !
  IF (jret==0) THEN
    IF (jwrk==1) THEN
      CALL write_surfn2_nc(dgu, &
                           yrecfm,kyear,iret(jwrk),hcomment,'-','Number_of_dates ')
    ELSEIF (jwrk==2) THEN
      CALL write_surfn2_nc(dgu, &
                           yrecfm,kmonth,iret(jwrk),hcomment,'-','Number_of_dates ')
    ELSEIF (jwrk==3) THEN
      CALL write_surfn2_nc(dgu, &
                           yrecfm,kday,iret(jwrk),hcomment,'-','Number_of_dates ')
    ELSEIF (jwrk==4) THEN
      CALL write_surfx2_nc(dgu, &
                           yrecfm,ptime,iret(jwrk),hcomment,'-','Number_of_dates ')
    ENDIF
  ELSE
    IF (jwrk==1) THEN
      CALL write_surfn2_nc(dgu, &
                           yrecfm,kyear,iret(jwrk),hcomment,'-')
    ELSEIF (jwrk==2) THEN
      CALL write_surfn2_nc(dgu, &
                           yrecfm,kmonth,iret(jwrk),hcomment,'-')
    ELSEIF (jwrk==3) THEN
      CALL write_surfn2_nc(dgu, &
                           yrecfm,kday,iret(jwrk),hcomment,'-')
    ELSEIF (jwrk==4) THEN
      CALL write_surfx2_nc(dgu, &
                           yrecfm,ptime,iret(jwrk),hcomment,'-')
    ENDIF
  ENDIF          
  !
ENDDO
!
! 3. Check for errors
!--------------------
DO jret=1,4
  IF (nid_nc==0.OR.iret(jret).NE.nf_noerr) kresp=1
ENDDO
!
!$OMP BARRIER
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_NC:WRITE_SURFT2_NC',1,zhook_handle)
!
END SUBROUTINE write_surft2_nc
!
END MODULE mode_write_surf_nc