SUBROUTINE CALINCW
!****--------------------------------------------------------------------------
!****   CALINCW : LECTURE DES INCREMENTS DE CONTENU EN EAU DU SOL
!****   ---------   
!****     Auteur :      D. GIARD 09/96
!****--------------------------------------------------------------------------

!  BUT : LECTURE DES INCREMENTS PRECEDENTS DE CONTENU EN EAU DU SOL
!  ---   

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

!  SOUS-PROGRAMME APPELE :  CHIEN et routines d'utilisation des fichiers LFI
!  ---------------------    SC2RDG  SC2WRG  DISGRID

!  MODIFICATIONS :
!  -------------
!     E. BAZILE   01/97  Lecture du biais moyen de temperature et d'humidite
!     F.Taillefer 02/98  Utilisation GPPBUF pour stocker les champs lus
!     F.Taillefer 02/98  Codage cas LMESSP=.T.
!     Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!      - LRPOLE removed from YOMCT0 and 'CALL CHIEN'.
!      - LLPOLE renamed into LLFICP.
!      - ZREAL can still contain or not polar values according to LLFICP
!        after reading the ARPEGE files, but these polar values are ignored
!        after.
!        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 : NDGLG    ,NDGSAG   ,NDGENG   ,NDLON    , &
 & NFLEVG   ,NSMAX    ,NPROMA  
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : CNMEXP   ,NQUAD    ,LELAM
USE YOMGEM   , ONLY : NLOENG   ,NMENG    ,VALH     ,VBH      ,NGPTOTG  , &
 & NSTTYP   ,NHTYP    ,RMUCEN   ,RLOCEN   ,RSTRET   , &
 & VP00     ,NGPTOT  
USE YOMDAG   , ONLY : NDATGU   ,NRESGU
USE YOMMP    , ONLY : MYPROC
USE YOMTAG   , ONLY : MTAGGSUM
USE QACVEG   , ONLY : NLISSEW
USE SURFACE_FIELDS_MIX, ONLY : SP_CI, YSP_CI, YSP_CID
USE MPL_MODULE

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IDATEF(11)
CHARACTER :: CLNOMF*16,CLMESS(3)*40
REAL(KIND=JPRB) :: ZREAL(NDLON*(NDGLG+2),5),ZGAUSS(NDGSAG:NDGENG)
REAL(KIND=JPRB) :: ZFIELD(NGPTOT,5),ZFIELDBUF(NGPTOTG)

INTEGER(KIND=JPIM) :: IARI, IARP, ICOD, IDATF, IEND, &
 & IFLD, ILEC, ILEN, INDEX, INDEX1, IINF, &
 & IBLK, IPOS, IPROLEC, IREP, IRESF, IROF, ISBA, &
 & IST, ITAG, ITAG2, IUNIT, J, &
 & JFLD, JGL, JL, JLON, JSTGLO  

LOGICAL :: LLFICP, LLFILE
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "cchien.intfb.h"
#include "chien.intfb.h"
#include "disgrid.intfb.h"

!**----------------------------------------------------------------------------
!**   0.    Test sur le processeur de lecture.
!**         ---------------------------------

!            nombre de champs pour ISBA
IF (LHOOK) CALL DR_HOOK('CALINCW',0,ZHOOK_HANDLE)
IFLD=5
!            position dans le buffer GPPBUF parmi les champs speciaux CANARI
ISBA=YSP_CID%NUMFLDS-IFLD+1

IPROLEC=1
ITAG=MTAGGSUM+128
ITAG2=MTAGGSUM+129

IF (MYPROC == IPROLEC) THEN

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

  IREP = 0
  IARP = 3
  ILEN = 0
  IPOS = 0
  IUNIT= 64
  ZREAL(:,:)=0.0_JPRB

  LLFILE=.FALSE.
  LLFICP=.FALSE.

  CLNOMF='ICMSH'//CNMEXP(1:4)//'LISSE  '
  CLMESS(1)=' CHAMP 1 MANQUANT - PAS DE LISSAGE'
  CLMESS(2)=' CHAMP 2 MANQUANT - PAS DE LISSAGE'
  CLMESS(3)=' CHAMP 3 MANQUANT - PAS DE LISSAGE'

!**----------------------------------------------------------------------------
!**   2.    Ouverture du fichier.
!**         --------------------

!*    2.1.  Ouverture du fichier 

  WRITE(NULOUT,*) ' LISSAGE DES INCREMENTS DE CONTENU EN EAU DU SOL'
  INQUIRE(FILE=CLNOMF,EXIST=LLFILE)
  IF ( .NOT. LLFILE ) THEN
    WRITE(NULOUT,*) ' FICHIER INCREMENTS ABSENT - PAS DE LISSAGE'
    ICOD=1
    CALL MPL_BROADCAST(ICOD,KROOT=IPROLEC,KTAG=ITAG2,CDSTRING='CALINCW:')
    IF (LHOOK) CALL DR_HOOK('CALINCW',1,ZHOOK_HANDLE)
    RETURN
  ENDIF
  WRITE(NULOUT,*) ' OUVERTURE DU FICHIER D INCREMENTS'

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

!*    2.2.  Test de la geometrie 

  IF ( .NOT.LELAM )  THEN
    CALL CHIEN('CADRE ISBA      ',NSTTYP,RMUCEN,RLOCEN,RSTRET,NSMAX, &
     & NDGLG,NDLON,NLOENG,NMENG,ZGAUSS,NHTYP,NFLEVG,VP00,VALH, &
     & VBH,NQUAD,-1,NDGSAG,NDGENG,1.E-7_JPRB,LLFICP,NULOUT)  
  ELSE
    IINF=-1
    CALL CCHIEN('CADRE ISBA      ',IUNIT,IINF)
    LLFICP= .FALSE.
  ENDIF

  IF ( LLFICP ) THEN
    WRITE(NULOUT,*) ' POINTS AUX POLES PRESENTS DANS LE FICHIER '
    INDEX1=NLOENG(1)
  ELSE
    WRITE(NULOUT,*) ' POINTS AUX POLES ABSENTS DANS LE FICHIER !'
    INDEX1=0
  ENDIF

!*    2.3.  Test date

  CALL FADIES(IREP,IUNIT,IDATEF)
  IDATF = IDATEF(1)*10000 + IDATEF(2)*100 + IDATEF(3)
  IRESF = IDATEF(4)*100 + IDATEF(5)
  WRITE(NULOUT,*) '  DATE INCREMENTS : ',IDATF
  WRITE(NULOUT,*) '  DATE ANALYSE    : ',NDATGU
  WRITE(NULOUT,*) '  RESEAU INCREMENTS : ',IRESF
  WRITE(NULOUT,*) '  RESEAU ANALYSE    : ',NRESGU
  IF ( IDATF /= NDATGU .OR. IRESF /= NRESGU ) THEN
    WRITE(NULOUT,*) ' DATE DES INCREMENTS ERRONEE: PAS DE LISSAGE'
    CALL FAIRME(IREP,IUNIT,'UNKNOWN')
    ICOD=1
    CALL MPL_BROADCAST(ICOD,KROOT=IPROLEC,KTAG=ITAG2,CDSTRING='CALINCW:')
    IF (LHOOK) CALL DR_HOOK('CALINCW',1,ZHOOK_HANDLE)
    RETURN
  ENDIF

!**----------------------------------------------------------------------------
!**   3.    Lecture des increments.
!**         ----------------------

  WRITE(NULOUT,*) ' LECTURE DES INCREMENTS DE CONTENU EN EAU DU SOL'
  ICOD=0
  CALL MPL_BROADCAST(ICOD,KROOT=IPROLEC,KTAG=ITAG2,CDSTRING='CALINCW:')

  DO J = 1 , 3
    ILEC=ISBA-1+J
    CALL LFINFO(IREP,IUNIT,YSP_CI%YCI(ILEC)%CNAME,ILEN,IPOS)
    IF ( ILEN > 0 ) THEN
      NLISSEW=NLISSEW+1
      CALL FACILE(IREP,IUNIT,YSP_CI%YCI(ILEC)%CNAME(1:4),0,YSP_CI%YCI(ILEC)%CNAME(5:), &
       & ZREAL(1,J),.FALSE.)  
    ELSE
      WRITE(NULOUT,*) CLMESS(J)
    ENDIF
  ENDDO

! Envoi de NLISSEW aux autres processeurs
  CALL MPL_BROADCAST(NLISSEW,KROOT=IPROLEC,KTAG=ITAG,CDSTRING='CALINCW:')

!**----------------------------------------------------------------------------
!**   4.    Lecture de l'increment moyen de temperature.
!**         -------------------------------------------

  WRITE(NULOUT,*) ' LECTURE DE INCREMENT MOYEN DE T2M'

  ILEC=ILEC+1
  CALL LFINFO(IREP,IUNIT,YSP_CI%YCI(ILEC)%CNAME,ILEN,IPOS)
  IF ( ILEN > 0 ) THEN
    CALL FACILE(IREP,IUNIT,YSP_CI%YCI(ILEC)%CNAME(1:4),0,YSP_CI%YCI(ILEC)%CNAME(5:), &
     & ZREAL(1,4),.FALSE.)  
  ELSE
    WRITE(NULOUT,*) 'PAS INCREMENT DE TEMPERATURE'
  ENDIF

!**----------------------------------------------------------------------------
!**   4.    Lecture de l'increment moyen d'humidite.
!**         ---------------------------------------

  WRITE(NULOUT,*) ' LECTURE DE INCREMENT MOYEN DE Hu2M'

  ILEC=ILEC+1
  CALL LFINFO(IREP,IUNIT,YSP_CI%YCI(ILEC)%CNAME,ILEN,IPOS)
  IF ( ILEN > 0 ) THEN
    CALL FACILE(IREP,IUNIT,YSP_CI%YCI(ILEC)%CNAME(1:4),0,YSP_CI%YCI(ILEC)%CNAME(5:), &
     & ZREAL(1,5),.FALSE.)  
  ELSE
    WRITE(NULOUT,*) 'PAS INCREMENT D HUMIDITE'
  ENDIF

!**----------------------------------------------------------------------------
!**   5.    Fin lecture physique du fichier.
!**         -------------------------------

  CALL FAIRME(IREP,IUNIT,'UNKNOWN')

!**----------------------------------------------------------------------------
!**   6.    Reception de NLISSEW par les processeurs concernes.
!**         --------------------------------------------------

ELSE
  CALL MPL_RECV(ICOD,KSOURCE=IPROLEC,KTAG=ITAG2,CDSTRING='CALINCW:')
  IF (ICOD == 0) THEN
    CALL MPL_RECV(NLISSEW,KSOURCE=1,KTAG=ITAG,CDSTRING='CALINCW:')
  ELSE
    WRITE(NULOUT,*)' FICHIER INCREMENTS INCORRECT - PAS DE LISSAGE'
    IF (LHOOK) CALL DR_HOOK('CALINCW',1,ZHOOK_HANDLE)
    RETURN
  ENDIF
ENDIF

!**----------------------------------------------------------------------------
!**   7.    Ecriture dans le buffer des champs point de grille.
!**         --------------------------------------------------

DO JFLD = 1 , IFLD
  IF ( MYPROC == IPROLEC ) THEN
    INDEX=INDEX1
    IROF=1
    DO JGL = 1 , NDGLG
      DO JLON = 1 , NLOENG(JGL)
        ZFIELDBUF(IROF)=ZREAL(INDEX+JLON,JFLD)
        IROF=IROF+1
      ENDDO
      INDEX=INDEX+NLOENG(JGL)
    ENDDO
    CALL DISGRID(1,0,NGPTOTG,ZFIELDBUF)
    ZFIELD(1:NGPTOT,JFLD)=ZFIELDBUF(1:NGPTOT)
  ELSE
    CALL DISGRID(1,1,NGPTOT,ZFIELD(1,JFLD))
  ENDIF
ENDDO

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
      SP_CI(JL,YSP_CI%YCI(ISBA+JFLD-1)%MP0,IBLK)=ZFIELD(JSTGLO+JL-1,JFLD)
    ENDDO
  ENDDO
ENDDO

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