mode_write_surf_fa.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_fa
!
INTERFACE write_surf0_fa
        MODULE PROCEDURE write_surfx0_fa
        MODULE PROCEDURE write_surfn0_fa
        MODULE PROCEDURE write_surfl0_fa
        MODULE PROCEDURE write_surfc0_fa
END INTERFACE
INTERFACE write_surfn_fa
        MODULE PROCEDURE write_surfx1_fa
        MODULE PROCEDURE write_surfn1_fa
        MODULE PROCEDURE write_surfl1_fa
        MODULE PROCEDURE write_surfx2_fa
        MODULE PROCEDURE write_surfx3_fa
END INTERFACE
INTERFACE write_surft_fa
        MODULE PROCEDURE write_surft0_fa
        MODULE PROCEDURE write_surft2_fa
END INTERFACE
!
CONTAINS
!
!     #############################################################
      SUBROUTINE write_surfx0_fa (&
                                  HREC,PFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  * - routine to write a real scalar
!
!
USE modd_io_surf_fa, ONLY : nunit_fa, cprefix1d, lfanocompact
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_write_surf_fa
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN) :: HREC     ! name of the article to be read
REAL,               INTENT(IN) :: PFIELD   ! the real scalar to be read
INTEGER,            INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string
!
!*      0.2   Declarations of local variables
!
LOGICAL :: GFOUND
 CHARACTER(LEN=18):: YNAME                  ! Field Name
INTEGER          :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL(KIND=JPRB)  :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:ERROR_WRITE_SURF_FA:WRITE_SURFX0_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',gfound)
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX0_FA',1,zhook_handle)
IF (gfound) RETURN
!
IF(lfanocompact)THEN
  CALL faveur(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
  ! -- Pour ecrire sans compactage
  CALL fagote(kresp,nunit_fa,-1,inbpdg,inbcsp,istron,ipuila,idmopl)
ENDIF
!
yname=trim(cprefix1d)//trim(hrec)
 CALL  faecr_r(kresp,nunit_fa,yname,pfield)
IF (kresp/=0) THEN
  CALL error_write_surf_fa(hrec,kresp)
ENDIF
!
IF(lfanocompact)THEN
  ! On remet la valeur par defaut 
  CALL fagote(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX0_FA',1,zhook_handle)
!
END SUBROUTINE write_surfx0_fa
!
!     #############################################################
      SUBROUTINE write_surfn0_fa (&
                                  HREC,KFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  * - routine to write an integer
!
USE modd_io_surf_fa, ONLY : nunit_fa, nmask, cprefix1d, lfanocompact
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_write_surf_fa
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN) :: HREC     ! name of the article to be read
INTEGER,            INTENT(IN) :: KFIELD   ! the integer to be read
INTEGER,            INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string
!
!*      0.2   Declarations of local variables
!
LOGICAL :: GFOUND
 CHARACTER(LEN=18):: YNAME                  ! Field Name
INTEGER          :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL(KIND=JPRB)  :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFN0_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',gfound)
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFN0_FA',1,zhook_handle)
IF (gfound) RETURN
!
IF(lfanocompact)THEN
  CALL faveur(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
  ! -- Pour ecrire sans compactage
  CALL fagote(kresp,nunit_fa,-1,inbpdg,inbcsp,istron,ipuila,idmopl)
ENDIF
!
yname=trim(cprefix1d)//trim(hrec)
 CALL  faecr_i(kresp,nunit_fa,yname,kfield)
IF (kresp/=0) THEN
  CALL error_write_surf_fa(hrec,kresp)
ENDIF
!
IF(lfanocompact)THEN
  ! On remet la valeur par defaut 
  CALL fagote(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFN0_FA',1,zhook_handle)
!
END SUBROUTINE write_surfn0_fa
!
!     #############################################################
      SUBROUTINE write_surfl0_fa (&
                                  HREC,OFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  * - routine to write a logical
!
USE modd_io_surf_fa, ONLY : nunit_fa, cprefix1d, lfanocompact
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_write_surf_fa
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN) :: HREC     ! name of the article to be read
LOGICAL,            INTENT(IN) :: OFIELD   ! array containing the data field
INTEGER,            INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string
!
!*      0.2   Declarations of local variables
!
LOGICAL :: GFOUND
 CHARACTER(LEN=18):: YNAME ! Field Name
INTEGER          :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL(KIND=JPRB)  :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFL0_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',gfound)
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFL0_FA',1,zhook_handle)
IF (gfound) RETURN
!
IF(lfanocompact)THEN
  CALL faveur(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
  ! -- Pour ecrire sans compactage
  CALL fagote(kresp,nunit_fa,-1,inbpdg,inbcsp,istron,ipuila,idmopl)
ENDIF
!
yname=trim(cprefix1d)//trim(hrec)
 CALL  faecr_l(kresp,nunit_fa,yname,ofield)
IF (kresp/=0) THEN
  CALL error_write_surf_fa(hrec,kresp)
ENDIF
!
IF(lfanocompact)THEN
  ! On remet la valeur par defaut 
  CALL fagote(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFL0_FA',1,zhook_handle)
!
END SUBROUTINE write_surfl0_fa
!
!     #############################################################
      SUBROUTINE write_surfc0_fa (&
                                  HREC,HFIELD,KRESP,HCOMMENT)
!     #############################################################
!
!!****  * - routine to write a character
!
!
USE modd_io_surf_fa, ONLY : nunit_fa, cprefix1d, lfanocompact
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_write_surf_fa
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN)  :: HREC      ! name of the article to be read
 CHARACTER(LEN=40),  INTENT(IN)  :: HFIELD    ! the integer to be read
INTEGER,            INTENT(OUT) :: KRESP     ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: HCOMMENT  ! comment string
!
!*      0.2   Declarations of local variables
!
LOGICAL :: GFOUND
 CHARACTER,DIMENSION(40)  :: YFIELD
 CHARACTER(LEN=18)        :: YNAME ! Field Name
INTEGER                  :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL(KIND=JPRB)          :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFC0_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',gfound)
IF (gfound.AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFC0_FA',1,zhook_handle)
IF (gfound) RETURN
!
IF(lfanocompact)THEN
  CALL faveur(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
  ! -- Pour ecrire sans compactage
  CALL fagote(kresp,nunit_fa,-1,inbpdg,inbcsp,istron,ipuila,idmopl)
ENDIF
!
READ(hfield,'(40A1)') yfield
yname=trim(cprefix1d)//trim(hrec)
 CALL  faecr_c(kresp,nunit_fa,yname,40,yfield)
IF (kresp/=0) THEN
  CALL error_write_surf_fa(hrec,kresp)
ENDIF
!
IF(lfanocompact)THEN
  ! On remet la valeur par defaut 
  CALL fagote(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFC0_FA',1,zhook_handle)
!
END SUBROUTINE write_surfc0_fa
!
!     #############################################################
      SUBROUTINE write_surfx1_fa (&
                                  HREC,KL,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  * - routine to fill a write 1D array for the externalised surface 
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write, wlog_mpi
!
USE modd_io_surf_fa, ONLY : nunit_fa, nmask, nfull, cprefix1d, &
                            lfanocompact 
USE modd_surf_par,   ONLY : xundef
!
USE modi_io_buff
USE modi_error_write_surf_fa
USE modi_gather_and_write_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),   INTENT(IN) :: HREC     ! name of the article to be read
INTEGER,             INTENT(IN) :: KL       ! number of points
REAL, DIMENSION(KL), INTENT(IN) :: PFIELD   ! array containing the data field
INTEGER,             INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),  INTENT(IN) :: HCOMMENT ! comment string
 CHARACTER(LEN=1),    INTENT(IN) :: HDIR     ! type of field :
                                            ! 'H' : field with
                                            !       horizontal spatial dim.
                                            ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
!
LOGICAL :: GFOUND
INTEGER                :: I,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL                   :: ZMEAN, ZCOUNT
REAL       :: XTIME0
REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD))) :: ZWORK   ! work array read in the file
REAL(KIND=JPRB)        :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX1_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX1_FA',1,zhook_handle)
IF (gfound) RETURN
!
IF(hdir=='H')THEN
  CALL gather_and_write_mpi(pfield,zwork,nmask)
ELSE !no horizontal dim. case (not masked)
  zwork(1:kl)=pfield(1:kl)
  zwork(kl+1:nfull)=sum(pfield(1:kl))/REAL(kl)
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  IF(lfanocompact)THEN
    CALL faveur(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
    ! -- Pour ecrire sans compactage
    CALL fagote(kresp,nunit_fa,-1,inbpdg,inbcsp,istron,ipuila,idmopl)
    CALL faienc(kresp,nunit_fa,cprefix1d,0,hrec,zwork,.false.)
    IF (kresp/=0) CALL error_write_surf_fa(hrec,kresp)
    ! On remet la valeur par defaut 
    CALL fagote(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
  ELSE
    zmean =0.0
    zcount=0.0
    DO i=1,nfull
      IF(zwork(i)/=xundef)THEN
        zmean =zmean+zwork(i)
        zcount=zcount+1.0
      ENDIF
    ENDDO
    IF (zcount.GT.0.0) zmean=zmean/zcount
    WHERE(zwork(:)==xundef)zwork(:)=zmean
    CALL faienc(kresp,nunit_fa,cprefix1d,0,hrec,zwork,.false.)
    IF (kresp/=0) CALL error_write_surf_fa(hrec,kresp)
  ENDIF
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX1_FA',1,zhook_handle)
!
END SUBROUTINE write_surfx1_fa
!
!     #############################################################
      SUBROUTINE write_surfx2_fa (HREC,KL1,KL2,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  * - routine to fill a write 2D array for the externalised surface 
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
!
USE modd_io_surf_fa, ONLY : nunit_fa, nmask, nfull, &
                            cprefix2d, lfanocompact
USE modd_surf_par,   ONLY : xundef
!
USE modi_io_buff
USE modi_error_write_surf_fa
USE modi_gather_and_write_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),        INTENT(IN) :: HREC     ! name of the article to be read
INTEGER,                  INTENT(IN) :: KL1      ! number of points
INTEGER,                  INTENT(IN) :: KL2      ! 2nd dimension
REAL, DIMENSION(KL1,KL2), INTENT(IN) :: PFIELD   ! array containing the data field
INTEGER,                  INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),       INTENT(IN) :: HCOMMENT ! comment string
 CHARACTER(LEN=1),         INTENT(IN) :: HDIR     ! type of field :
                                                 ! 'H' : field with
                                                 !       horizontal spatial dim.
                                                 ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
! 
LOGICAL :: GFOUND
 CHARACTER(LEN=4)  :: YPREFIX
 CHARACTER(LEN=3)  :: YPATCH
INTEGER           :: I, JL ! loop counter
INTEGER           :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL  :: XTIME0
REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2)) :: ZWORK   ! work array read in the file
REAL, DIMENSION(SIZE(PFIELD,2))       :: ZMEAN, ZCOUNT
REAL(KIND=JPRB)   :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',1,zhook_handle)
IF (gfound) RETURN
!
 CALL gather_and_write_mpi(pfield,zwork,nmask)
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !    
  IF(lfanocompact)THEN
    CALL faveur(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
    ! -- Pour ecrire sans compactage
    CALL fagote(kresp,nunit_fa,-1,inbpdg,inbcsp,istron,ipuila,idmopl)
    DO jl=1,SIZE(zwork,2)
      WRITE(ypatch,'(I3.3)')jl
      yprefix=cprefix2d//ypatch//'_'
      CALL faienc(kresp,nunit_fa,yprefix,0,hrec,zwork(:,jl),.false.)
      IF (kresp/=0) CALL error_write_surf_fa(hrec,kresp)
    END DO
    ! On remet la valeur par defaut 
    CALL fagote(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
  ELSE
    zmean(:)=0.0
    zcount(:)=0.0
    DO i=1,nfull
      DO jl=1,SIZE(zwork,2)
        IF(zwork(i,jl)/=xundef) THEN
          zmean(jl)=zmean(jl)+zwork(i,jl)
          zcount(jl)=zcount(jl)+1.0
        ENDIF
      ENDDO
    ENDDO
    WHERE(zcount(:)>0.0)zmean(:)=zmean(:)/zcount(:)        
    DO jl=1,SIZE(zwork,2)
      WHERE(zwork(:,jl)==xundef)zwork(:,jl)=zmean(jl)
      WRITE(ypatch,'(I3.3)')jl
      yprefix=cprefix2d//ypatch//'_'
      CALL faienc(kresp,nunit_fa,yprefix,0,hrec,zwork(:,jl),.false.)
      IF (kresp/=0) CALL error_write_surf_fa(hrec,kresp)
    END DO
  ENDIF
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',1,zhook_handle)
!
END SUBROUTINE write_surfx2_fa
!
!     #############################################################
      SUBROUTINE write_surfx3_fa (HREC,KL1,KL2,KL3,PFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  * - routine to fill a write 2D array for the externalised surface 
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
!
USE modd_io_surf_fa, ONLY : nunit_fa, nmask, nfull, &
                            cprefix2d, lfanocompact
USE modd_surf_par,   ONLY : xundef
!
USE modi_io_buff
USE modi_error_write_surf_fa
USE modi_gather_and_write_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),        INTENT(IN) :: HREC     ! name of the article to be read
INTEGER,                  INTENT(IN) :: KL1      ! number of points
INTEGER,                  INTENT(IN) :: KL2      ! 2nd dimension
INTEGER,                  INTENT(IN) :: KL3      ! 2nd dimension
REAL, DIMENSION(KL1,KL2,KL3), INTENT(IN) :: PFIELD   ! array containing the data field
INTEGER,                  INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),       INTENT(IN) :: HCOMMENT ! comment string
 CHARACTER(LEN=1),         INTENT(IN) :: HDIR     ! type of field :
                                                 ! 'H' : field with
                                                 !       horizontal spatial dim.
                                                 ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
! 
LOGICAL :: GFOUND
 CHARACTER(LEN=4)  :: YPREFIX
 CHARACTER(LEN=3)  :: YPATCH
INTEGER           :: I, JL, JP ! loop counter
INTEGER           :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL  :: XTIME0
REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2),SIZE(PFIELD,3)) :: ZWORK   ! work array read in the file
REAL, DIMENSION(SIZE(PFIELD,2),SIZE(PFIELD,3))       :: ZMEAN, ZCOUNT
REAL(KIND=JPRB)   :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',1,zhook_handle)
IF (gfound) RETURN
!
 CALL gather_and_write_mpi(pfield,zwork,nmask)
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !    
  IF(lfanocompact)THEN
    CALL faveur(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
    ! -- Pour ecrire sans compactage
    CALL fagote(kresp,nunit_fa,-1,inbpdg,inbcsp,istron,ipuila,idmopl)
    DO jp=1,SIZE(zwork,3)
      DO jl=1,SIZE(zwork,2)
        WRITE(ypatch,'(I3.3)')jl
        yprefix=cprefix2d//ypatch//'_'
        CALL faienc(kresp,nunit_fa,yprefix,0,hrec,zwork(:,jl,jp),.false.)
        IF (kresp/=0) CALL error_write_surf_fa(hrec,kresp)
      ENDDO
    END DO
    ! On remet la valeur par defaut 
    CALL fagote(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
  ELSE
    zmean(:,:)=0.0
    zcount(:,:)=0.0
    DO i=1,nfull
      DO jp=1,SIZE(zwork,3)
        DO jl=1,SIZE(zwork,2)
          IF(zwork(i,jl,jp)/=xundef) THEN
            zmean(jl,jp)=zmean(jl,jp)+zwork(i,jl,jp)
            zcount(jl,jp)=zcount(jl,jp)+1.0
          ENDIF
        ENDDO
      ENDDO
    ENDDO
    WHERE(zcount(:,:)>0.0)zmean(:,:)=zmean(:,:)/zcount(:,:)
    DO jp=1,SIZE(zwork,3)        
      DO jl=1,SIZE(zwork,2)
        WHERE(zwork(:,jl,jp)==xundef)zwork(:,jl,jp)=zmean(jl,jp)
        WRITE(ypatch,'(I3.3)')jl
        yprefix=cprefix2d//ypatch//'_'
        CALL faienc(kresp,nunit_fa,yprefix,0,hrec,zwork(:,jl,jp),.false.)
        IF (kresp/=0) CALL error_write_surf_fa(hrec,kresp)
      ENDDO
    END DO
  ENDIF
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFX3_FA',1,zhook_handle)
!
END SUBROUTINE write_surfx3_fa
!
!     #############################################################
      SUBROUTINE write_surfn1_fa (&
                                  HREC,KL,KFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  * - routine to write an integer array
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
!
USE modd_io_surf_fa, ONLY : nunit_fa, nmask, nfull, cprefix1d, lfanocompact
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_write_surf_fa
USE modi_gather_and_write_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),      INTENT(IN) :: HREC     ! name of the article to be read
INTEGER,                INTENT(IN) :: KL       ! number of points
INTEGER, DIMENSION(KL), INTENT(IN) :: KFIELD   ! array containing the data field
INTEGER,                INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),     INTENT(IN) :: HCOMMENT ! comment string
 CHARACTER(LEN=1),       INTENT(IN) :: HDIR     ! type of field :
                                               ! 'H' : field with
                                               !       horizontal spatial dim.
                                               ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
! 
LOGICAL :: GFOUND
 CHARACTER(LEN=18)         :: YNAME! Field Nam
INTEGER                   :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
INTEGER, DIMENSION(MAX(NFULL,SIZE(KFIELD))) :: IWORK  ! work array read in the file
REAL   :: XTIME0
REAL(KIND=JPRB)           :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFN1_FA',0,zhook_handle)
!
kresp = 0
!
 CALL io_buff(&
                hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFN1_FA',1,zhook_handle)
IF (gfound) RETURN
!
IF (hdir/='H' .OR. hrec=="-") THEN
  iwork(1:kl) = kfield
ELSE
  CALL gather_and_write_mpi(kfield,iwork,nmask)
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !    
  IF(lfanocompact)THEN
    CALL faveur(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
    ! -- Pour ecrire sans compactage
    CALL fagote(kresp,nunit_fa,-1,inbpdg,inbcsp,istron,ipuila,idmopl)
  ENDIF
  !
  yname=trim(cprefix1d)//trim(hrec)
  !
  CALL  faecr_i_d(kresp,nunit_fa,yname,kl,iwork(1:kl))
  IF (kresp/=0) CALL error_write_surf_fa(hrec,kresp)
  !
  IF(lfanocompact)THEN
    ! On remet la valeur par defaut 
    CALL fagote(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
  ENDIF
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFN1_FA',1,zhook_handle)
RETURN
!
END SUBROUTINE write_surfn1_fa
!
!     #############################################################
      SUBROUTINE write_surfl1_fa (&
                                  HREC,KL,OFIELD,KRESP,HCOMMENT,HDIR)
!     #############################################################
!
!!****  * - routine to write a logical array
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
!
USE modd_io_surf_fa, ONLY : nunit_fa, cprefix1d, lfanocompact
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_write_surf_fa
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),      INTENT(IN) :: HREC     ! name of the article to be read
INTEGER,             INTENT(IN) :: KL       ! number of points
LOGICAL, DIMENSION(KL), INTENT(IN) :: OFIELD   ! array containing the data field
INTEGER,                INTENT(OUT):: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100),     INTENT(IN) :: HCOMMENT ! comment string
 CHARACTER(LEN=1),       INTENT(IN) :: HDIR     ! type of field :
                                               ! 'H' : field with
                                               !       horizontal spatial dim.
                                               ! '-' : no horizontal dim.
!*      0.2   Declarations of local variables
!
LOGICAL :: GFOUND
 CHARACTER(LEN=18):: YNAME ! Field Name
INTEGER          :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL :: XTIME0
REAL(KIND=JPRB)  :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFL1_FA',0,zhook_handle)
!
kresp=0
!
 CALL io_buff(&
                hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFL1_FA',1,zhook_handle)
IF (gfound) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !  
  IF(lfanocompact)THEN
    CALL faveur(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
    ! -- Pour ecrire sans compactage
    CALL fagote(kresp,nunit_fa,-1,inbpdg,inbcsp,istron,ipuila,idmopl)
  ENDIF
  !
  yname=trim(cprefix1d)//trim(hrec)
  CALL  faecr_l_d(kresp,nunit_fa,yname,kl,ofield)
  IF (kresp/=0) CALL error_write_surf_fa(hrec,kresp)
  !
  IF(lfanocompact)THEN
    ! On remet la valeur par defaut 
    CALL fagote(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
  ENDIF
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFL1_FA',1,zhook_handle)
!
END SUBROUTINE write_surfl1_fa
!
!     #############################################################
      SUBROUTINE write_surft0_fa (&
                                  HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  * - routine to write a date
!
!
USE modd_io_surf_fa, ONLY : cprefix1d, nunit_fa, lfanocompact
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_error_write_surf_fa
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN)  :: HREC     ! name of the article to be read
INTEGER,            INTENT(IN)  :: KYEAR    ! year
INTEGER,            INTENT(IN)  :: KMONTH   ! month
INTEGER,            INTENT(IN)  :: KDAY     ! day
REAL,               INTENT(IN)  :: PTIME    ! time
INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: HCOMMENT ! comment string

!*      0.2   Declarations of local variables
!
LOGICAL :: GFOUND
 CHARACTER(LEN=18)     :: YNAME ! Field Name
INTEGER               :: IRET
INTEGER               :: IHOUR, IMIN, ISEC
INTEGER               :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
INTEGER, DIMENSION(3) :: ITDATE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFT0_FA',0,zhook_handle)
!
kresp=0
!
IF (hrec=='DTCUR') THEN
!        
  ihour = floor(ptime)/3600
  imin  = floor(ptime)/60 - ihour * 60
  isec  = nint(ptime) - ihour * 3600 - imin * 60
  CALL fandar(iret,nunit_fa,(/ kyear, kmonth, kday, ihour, imin, isec, 0, 0, 0, 0, 0 /))
!
ELSE
!
  CALL io_buff(&
                hrec,'W',gfound)
  IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFT0_FA',1,zhook_handle)
  IF (gfound) RETURN
!
END IF
!
itdate(1) = kyear
itdate(2) = kmonth
itdate(3) = kday
!
IF(lfanocompact)THEN
  CALL faveur(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
  ! -- Pour ecrire sans compactage
  CALL fagote(kresp,nunit_fa,-1,inbpdg,inbcsp,istron,ipuila,idmopl)
ENDIF
!
yname=trim(cprefix1d)//trim(hrec)//'%TDATE'
 CALL  faecr_i_d(kresp,nunit_fa,yname,3,itdate)
IF (kresp/=0) THEN
  CALL error_write_surf_fa(hrec,kresp)
ENDIF
!
yname=trim(cprefix1d)//trim(hrec)//'%TIME'
 CALL  faecr_r(kresp,nunit_fa,yname,ptime)
IF (kresp/=0) THEN
  CALL error_write_surf_fa(hrec,kresp)
ENDIF
!
IF(lfanocompact)THEN
  ! On remet la valeur par defaut 
  CALL fagote(kresp,nunit_fa,ingrib,inbpdg,inbcsp,istron,ipuila,idmopl)
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFT0_FA',1,zhook_handle)
!
END SUBROUTINE write_surft0_fa
!
!     #############################################################
      SUBROUTINE write_surft2_fa (&
                                  HREC,KL1,KL2,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
!     #############################################################
!
!!****  * - routine to write a date
!
!
!
!
USE modd_surfex_mpi, ONLY : nrank, npio, xtime_npio_write
!
USE modd_io_surf_fa, ONLY : nunit_fa, cprefix1d, nluout
!
USE mode_fasurfex
!
USE modi_io_buff
USE modi_abor1_sfx
USE modi_error_write_surf_fa
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*      0.1   Declarations of arguments
!
!
!
 CHARACTER(LEN=12),  INTENT(IN)  :: HREC     ! name of the article to be read
INTEGER,                      INTENT(IN) :: KL1      ! number of points
INTEGER,                      INTENT(IN) :: KL2      ! 2nd dimension
INTEGER, DIMENSION(KL1,KL2), INTENT(IN)  :: KYEAR    ! year
INTEGER, DIMENSION(KL1,KL2), INTENT(IN)  :: KMONTH   ! month
INTEGER, DIMENSION(KL1,KL2), INTENT(IN)  :: KDAY     ! day
REAL,    DIMENSION(KL1,KL2), INTENT(IN)  :: PTIME    ! time
INTEGER,            INTENT(OUT) :: KRESP    ! KRESP  : return-code if a problem appears
 CHARACTER(LEN=100), INTENT(IN)  :: HCOMMENT ! comment string

!*      0.2   Declarations of local variables
!
LOGICAL :: GFOUND
 CHARACTER(LEN=18):: YNAME ! Field Name
INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: ITDATE
REAL :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFT2_FA',0,zhook_handle)
!
kresp = 0
!
 CALL io_buff(&
                hrec,'W',gfound)
!
IF (gfound .AND. lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFT2_FA',1,zhook_handle)
IF (gfound) RETURN
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !  
  itdate(1,:,:) = kyear(:,:)
  itdate(2,:,:) = kmonth(:,:)
  itdate(3,:,:) = kday(:,:)
  !
  yname=trim(cprefix1d)//trim(hrec)
  WRITE(nluout,*) ' WRITE_SURFT2_FA : time in 2 dimensions not yet implemented : YNAME=',yname,'ITDATE=',itdate
  CALL abor1_sfx('MODE_WRITE_SURF_FA:WRITE_SURFT2_FA: time in 2 dimensions not yet implemented')
  !
#ifdef SFX_MPI
  xtime_npio_write = xtime_npio_write + (mpi_wtime() - xtime0)
#endif
  !  
ENDIF
!
IF (lhook) CALL dr_hook('MODE_WRITE_SURF_FA:WRITE_SURFT2_FA',1,zhook_handle)
!
END SUBROUTINE write_surft2_fa
!
END MODULE mode_write_surf_fa