SUBROUTINE CAEINCW
!****--------------------------------------------------------------------------
!****  CAEINCW : ECRITURE DES INCREMENTS DE CONTENU EN EAU DU SOL
!****  --------- 
!****   Auteur :      D. GIARD    09/96
!****      Mod :      E. BAZILE   01/97 Ecriture du biais moyen de temperature
!****                                    et d'humidite
!****                 F.Taillefer 02/98 Utilisation GPPBUF
!****                 F.Taillefer 02/98 Codage cas LMESSP=.T.
!    R. El Khatib : 99-12-28 remove poles rows
!****--------------------------------------------------------------------------
!  BUT : ECRITURE DES INCREMENTS PRECEDENTS DE CONTENU EN EAU DU SOL
!  ---   

!  ROUTINE APPELANTE :    *CANARI*
!  -----------------

!  SOUS-PROGRAMME APPELE : routines d'utilisation des fichiers LFI
!  ---------------------   SC2RDG  DIWRGRID

!  ARGUMENT D'ENTREE :
!  -----------------
!  ARGUMENT DE SORTIE :
!  ------------------

!  MODIFICATIONS :
!  -------------
!    Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!      - removal of the last argument (.FALSE.) in 'CALL DIWRGRID'.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        M.Hamrud      01-Jul-2006 Revised surface fields
!--------------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NPROMA
USE YOMGEM   , ONLY : NGPTOT   ,NGPTOTG
USE YOMLUN   , ONLY : NULOUT
USE YOMMP    , ONLY : MYPROC
USE YOMRIP   , ONLY : NINDAT   ,NSSSSS
USE YOMCT0   , ONLY : CNMEXP
USE YOMOP    , ONLY : CNMCA
USE QACVEG   , ONLY : NLISSEW
USE SURFACE_FIELDS_MIX, ONLY : SP_CI, YSP_CI, YSP_CID

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IDATEF(11)
CHARACTER :: CLNOMF*16,CLMESS(3)*40
REAL(KIND=JPRB) :: ZREAL(NGPTOTG,5),ZFIELD(NGPTOT,5)

INTEGER(KIND=JPIM) :: IARI, IARP, IEND, IFLD, ILEC,&
 & IND, IBLK, IPROLEC, IREP, ISBA, IST, IUNIT, &
 & J, JD, JFLD, JL, JSTGLO  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "fcttim.h"

#include "abor1.intfb.h"
#include "diwrgrid.intfb.h"

!**----------------------------------------------------------------------------
!**   1.    Initialisations.
!**         ---------------

IF (LHOOK) CALL DR_HOOK('CAEINCW',0,ZHOOK_HANDLE)
IFLD=5
ISBA=YSP_CID%NUMFLDS-IFLD+1

IPROLEC=1

NLISSEW = MIN(NLISSEW+1,3)

WRITE(NULOUT,*) '   '
WRITE(NULOUT,*) 'ECRITURE DES INCREMENTS DE CONTENU EN EAU DU SOL'
WRITE(NULOUT,*) ' NOMBRE DE RESEAUX : ',NLISSEW

!**----------------------------------------------------------------------------
!**   2.    Recuperation des champs a ecrire.
!**         --------------------------------

IST=1
CALL ABOR1('SOMEONE SHOULD CHECK THE FOLLOWING ASIGNMENT/MH')
DO JSTGLO = 1 , NGPTOT , NPROMA
  IEND=MIN(NPROMA,NGPTOT-JSTGLO+1)
  IBLK=(JSTGLO-1)/NPROMA+1
  DO JFLD = 1 , IFLD
    DO JL = IST , IEND
      ZFIELD(JSTGLO+JL-1,JFLD)=SP_CI(JL,YSP_CI%YCI(ISBA+JFLD-1)%MP0,IBLK)
    ENDDO
  ENDDO
ENDDO

DO JFLD = 1 , IFLD
  IF ( MYPROC /= IPROLEC ) THEN
    CALL DIWRGRID(IPROLEC,JFLD,0,NGPTOT,ZFIELD(1,JFLD))
  ELSE
    ZREAL(1:NGPTOT,JFLD)=ZFIELD(1:NGPTOT,JFLD)
  ENDIF
ENDDO

!**----------------------------------------------------------------------------
!**   2.    Ecriture dans le fichier par le processeur 1.
!**         --------------------------------------------

IF ( MYPROC == IPROLEC ) THEN

!*    2.1.  initialisations

  IREP = 0
  IARP = 3
  IUNIT= 65

  CLNOMF= 'ICMSH'//CNMEXP(1:4)//'LISSEF '
  CLMESS(1)= ' INCREMENTS A  00h ECRITS'
  CLMESS(2)= ' INCREMENTS A -06h ECRITS'
  CLMESS(3)= ' INCREMENTS A -12h ECRITS'

!*    2.2.  ouverture du fichier 

  CALL FAITOU(IREP,IUNIT,.TRUE.,CLNOMF,'UNKNOWN',.TRUE.,.TRUE.,1,&
   & IARP,IARI,CNMCA)  

!*    2.3.  ecriture de la date

  IDATEF(1)= NCCAA(NINDAT)
  IDATEF(2)= NMM(NINDAT)
  IDATEF(3)= NDD(NINDAT)
  IDATEF(4)= NCTH(NSSSSS)
  IDATEF(5)= (NSSSSS-IDATEF(4)*3600)/60
  IDATEF(6)= 1
  DO JD = 7 , 11
    IDATEF(JD)= 0
  ENDDO
  CALL FANDAR(IREP,IUNIT,IDATEF)

!*    2.4.  attente champs globaux

  DO JFLD = 1 , IFLD
    CALL DIWRGRID(IPROLEC,JFLD,1,NGPTOTG,ZREAL(1,JFLD))
  ENDDO

!*    2.5.  boucle sur les reseaux

  DO J = 1 , NLISSEW
    ILEC=ISBA-1+J
    CALL FAIENC(IREP,IUNIT,YSP_CI%YCI(ILEC)%CNAME(1:4),0,YSP_CI%YCI(ILEC)%CNAME(5:),&
     & ZREAL(1,J),.FALSE.)  
    WRITE(NULOUT,*) CLMESS(J)
  ENDDO

!*    2.6.  increments de temperature utiles pour l'eau du sol

  IND=4
  ILEC=ISBA-1+IND
  CALL FAIENC(IREP,IUNIT,YSP_CI%YCI(ILEC)%CNAME(1:4),0,YSP_CI%YCI(ILEC)%CNAME(5:),&
   & ZREAL(1,IND),.FALSE.)  
  WRITE(NULOUT,*) YSP_CI%YCI(ILEC)%CNAME,' ECRIT DANS LE FICHIER'

!*    2.7.  increments d'humidite utiles pour l'eau du sol

  IND=5
  ILEC=ISBA-1+IND
  CALL FAIENC(IREP,IUNIT,YSP_CI%YCI(ILEC)%CNAME(1:4),0,YSP_CI%YCI(ILEC)%CNAME(5:),&
   & ZREAL(1,IND),.FALSE.)  
  WRITE(NULOUT,*) YSP_CI%YCI(ILEC)%CNAME,' ECRIT DANS LE FICHIER'

!*    2.8.  fin

  CALL FAIRME(IREP,IUNIT,'KEEP')

ENDIF

!**----------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CAEINCW',1,ZHOOK_HANDLE)
END SUBROUTINE CAEINCW
