SUBROUTINE CASMSWI

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMCT0   , ONLY : LELAM    ,NPROC
USE YOMDIM   , ONLY : NDGLG    ,NDLON    ,NPROMA   ,NDGNH
USE YOMPHY1  , ONLY : GCONV
USE YOMGEM   , ONLY : NGPTOT   ,NGPTOTG  ,RSTRET   ,NLOENG
USE YOMLEG   , ONLY : RMU      ,RSQM2
USE YOMLUN   , ONLY : NULOUT
USE YOMMP    , ONLY : MYPROC
USE SURFACE_FIELDS_MIX, ONLY : &
 & SP_SB,  YSP_SB, &
 & SP_SG,  YSP_SG, &
 & SP_RR,  YSP_RR, &
 & SD_VV,  YSD_VV, &
 & SD_VF,  YSD_VF

USE QACVEG   , ONLY : NR_SM_WP ,RA_SM_WP
USE YOMGC    , ONLY : GM

!**** **  - Spatial smoothing of SWI (Soil Wetness Index) for changing Wp

!     Purpose.
!     --------
!           Spatial smoothing of SWI (Soil Wetness Index) then changing of Wp 
!           (Total soil water content) in Canari OI 

!**   Interface.
!     ----------
!        *CALL* *CASMSWI

!        Explicit arguments :  
!        ------------------

!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------
!        ACSOLW
!        DIWRGRID
!        LISLAP &(OR) ELISLAP
!        DISGRID

!     Reference.
!     ----------
!        HPOS, WRGRIDUA, WRGP2FA & INCLI1 CY24T1

!     Author.
!     -------
!        *Meteo-France*

!     Modifications.
!     --------------
!        Original : 27-09-02 S. Ivatek-Sahdan
!        Modified :
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Jul-2006 Revised surface fields
!        A. Trojakova : 30/05/2006 new argument for ELISLAP
!               due to Bf for map factor addressing on multiproc
!     Apr 2008  K. Yessad: use DISGRID instead of DISGRID_C + cleanings
!     ------------------------------------------------------------------

IMPLICIT NONE
REAL(KIND=JPRB) :: ZBO(NDGLG)
REAL(KIND=JPRB) :: ZD2(NGPTOT), ZDSW(NGPTOT), ZDSWN(NGPTOT)
REAL(KIND=JPRB) :: ZOCE(NGPTOT), ZSSW(NGPTOT), ZSWI(NGPTOT)
REAL(KIND=JPRB) :: ZVEG(NGPTOT), ZWFC(NGPTOT), ZWPMX(NGPTOT)
REAL(KIND=JPRB) :: ZWSAT(NGPTOT), ZWSMX(NGPTOT), ZWWILT(NGPTOT)
REAL(KIND=JPRB) :: ZEPW, ZFDSW, ZLSM, ZSD

REAL(KIND=JPRB), ALLOCATABLE :: ZGOCE(:), ZGSWI(:), ZGM(:)

INTEGER(KIND=JPIM) :: I, IEND, IIEND, IIST, INDICE, INSIGN, IBLK, IST 
INTEGER(KIND=JPIM) :: JFLD, JJ, JKGLO, JROF

LOGICAL :: LLHMT

CHARACTER (LEN = 7) ::  CLLOCK
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     ------------------------------------------------------------------

#include "acsolw.intfb.h"
#include "diwrgrid.intfb.h"
#include "disgrid.intfb.h"
#include "elislap.intfb.h"
#include "lislap.intfb.h"

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CASMSWI',0,ZHOOK_HANDLE)
!     ------------------------------------------------------------------

!     ------------------------------------------------------------------
!*       1.    READ BUFFER AND COMPUTATION OF SWI AND MASK FOR SMOOTHING
!              ---------------------------------------------------------

WRITE (NULOUT,*) ' #######  SUBROUTINE CASMSWI  ####### '
ZEPW = 1.E-3_JPRB
ZOCE(:)=1.0_JPRB
LLHMT=.TRUE.
CLLOCK='ACSOLW '
IST=1
DO JKGLO=1,NGPTOT,NPROMA
  IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
  IBLK=(JKGLO-1)/NPROMA+1
  DO JROF=IST,IEND
!   Land/sea mask
    ZLSM=SD_VF(JROF,YSD_VF%YLSM%MP  ,IBLK)
!   Snow water content
    ZSD=SP_SG(JROF,YSP_SG%YF%MP0 ,IBLK)
!   Total soil frozen water content
    ZFDSW=SP_SB(JROF,2,YSP_SB%YQ%MP0,IBLK)
!   Fraction of vegetation
    ZVEG(JROF+JKGLO-1)=SD_VF(JROF,YSD_VF%YVEG%MP,IBLK)
!   Soil depth
    ZD2(JROF+JKGLO-1)=SD_VV(JROF,YSD_VV%YD2 %MP,IBLK)
!   Superficial soil liquid water content
    ZSSW(JROF+JKGLO-1)=SP_RR(JROF,YSP_RR%YW%MP0 ,IBLK)
!   Total soil liquid water content
    ZDSW(JROF+JKGLO-1)=SP_SB(JROF,1,YSP_SB%YQ%MP0,IBLK)
!   New mask, if it is land, without snow and no frozen soil
!   water content, input for (e)lislap is set to _ZERO_
    IF ((ZLSM == 1.0_JPRB) .AND. (ZSD == 0.0_JPRB) .AND. &
     & (ZFDSW == 0.0_JPRB)) ZOCE(JROF+JKGLO-1)=0.0_JPRB  
  ENDDO

! Calculation of soil water contents at wilting point and field capacity
  IIST=IST+JKGLO-1
  IIEND=IEND+JKGLO-1
  CALL ACSOLW(IST,IEND,IEND,SD_VV(IST:IEND,YSD_VV%YARG%MP,IBLK),&
   & SD_VV(IST:IEND,YSD_VV%YD2%MP,IBLK),SD_VF(IST:IEND,YSD_VF%YLSM%MP,IBLK),&
   & SD_VV(IST:IEND,YSD_VV%YIVEG%MP,IBLK),SD_VV(IST:IEND,YSD_VV%YSAB%MP,IBLK),&
   & LLHMT,ZWFC(IIST:IIEND),ZWPMX(IIST:IIEND),&
   & ZWSAT(IIST:IIEND),ZWSMX(IIST:IIEND),ZWWILT(IIST:IIEND),CLLOCK)  
  ZWFC(IIST:IIEND)=ZWFC(IIST:IIEND)*GCONV*SD_VV(IST:IEND,YSD_VV%YD2%MP,IBLK)
  ZWWILT(IIST:IIEND)=ZWWILT(IIST:IIEND)*GCONV*SD_VV(IST:IEND,YSD_VV%YD2%MP,IBLK)
ENDDO

! Calculation of soil wetness index (SWI)
ZSWI(1:NGPTOT)=(ZDSW(1:NGPTOT)-ZWWILT(1:NGPTOT))/(ZWFC(1:NGPTOT) &
 & -ZWWILT(1:NGPTOT))  

!     ------------------------------------------------------------------
!*       2.    DISTRIBUTE AND COLLECT GRID-POINT FIELDS
!              ----------------------------------------

IF (MYPROC /= 1) THEN

!*       2.1.  SEND FIELDS TO PE 1
!              -------------------

  JFLD=1
  CALL DIWRGRID(1,JFLD,0,NGPTOT,ZSWI(1:NGPTOT))
  JFLD=JFLD+1
  CALL DIWRGRID(1,JFLD,0,NGPTOT,ZOCE(1:NGPTOT))
  JFLD=JFLD+1
  CALL DIWRGRID(1,JFLD,0,NGPTOT,GM(1:NGPTOT))

ELSE

!*       2.2.  RECEIVE FIELDS ON PE 1 
!              ----------------------

  ALLOCATE(ZGSWI(NGPTOTG))
  ALLOCATE(ZGOCE(NGPTOTG))
  ALLOCATE(ZGM(NGPTOTG))

  JFLD=1
  ZGSWI(1:NGPTOT)=ZSWI(1:NGPTOT)
  IF (NPROC /= 1) CALL DIWRGRID(1,JFLD,1,NGPTOTG,ZGSWI(1:NGPTOTG))
  JFLD=JFLD+1
  ZGOCE(1:NGPTOT)=ZOCE(1:NGPTOT)
  IF (NPROC /= 1) CALL DIWRGRID(1,JFLD,1,NGPTOTG,ZGOCE(1:NGPTOTG))
  JFLD=JFLD+1
  ZGM(1:NGPTOT)=GM(1:NGPTOT)
  IF (NPROC /= 1) CALL DIWRGRID(1,JFLD,1,NGPTOTG,ZGM(1:NGPTOTG))

ENDIF

!     ------------------------------------------------------------------
!*       3.    SMOOTHING ON PE 1
!              -----------------

IF (MYPROC == 1) THEN
  IF (.NOT.LELAM) THEN
    DO JJ=1,NDGLG
      INDICE=MIN(JJ,NDGLG+1-JJ)
      INSIGN=SIGN(1,NDGNH-JJ)
      ZBO(JJ)=REAL(INSIGN,JPRB)*ASIN(RMU(INDICE))
    ENDDO
    DO I=1,NR_SM_WP
      CALL LISLAP(ZGSWI(1:NGPTOTG),NLOENG(1:NDGLG),NDGLG,NDLON,NGPTOTG,&
       & RSQM2(1:NDGLG),ZBO(1:NDGLG),RSTRET,ZGOCE(1:NGPTOTG),0.5_JPRB,RA_SM_WP)  
    ENDDO
  ELSE
    DO I=1,NR_SM_WP
      CALL ELISLAP(ZGSWI(1:NGPTOTG),NDGLG,NDLON,NGPTOTG,&
       & ZGOCE(1:NGPTOTG),ZGM(1:NGPTOTG),0.5_JPRB,RA_SM_WP)  
    ENDDO
  ENDIF
ENDIF

!     ------------------------------------------------------------------
!*       4.    DISTRIBUTE AND COLLECT GRID-POINT FIELD
!              ---------------------------------------

IF (MYPROC == 1) THEN

!*       4.1.  PE 1 SEND FIELD TO PE /=1 
!              -------------------------

  JFLD=1
  ZSWI(1:NGPTOT)=ZGSWI(1:NGPTOT)
  IF (NPROC /= 1) CALL DISGRID(JFLD,0,NGPTOTG,ZGSWI(1:NGPTOTG),LDC=.TRUE.,KIOPROC=1)
  DEALLOCATE(ZGSWI)
  DEALLOCATE(ZGOCE)
  DEALLOCATE(ZGM)

ELSE

!*       4.2.  RECEIVE FIELDS ON PE /= 1 
!              -------------------------

  JFLD=1
  CALL DISGRID(JFLD,1,NGPTOT,ZSWI(1:NGPTOT),LDC=.TRUE.,KIOPROC=1)

ENDIF

!     ------------------------------------------------------------------
!*       5.    MODIFICATION OF TOTAL SOIL LIQUID WATER CONTENT
!              -----------------------------------------------

DO I=1,NGPTOT
  IF (ZOCE(I) == 0.0_JPRB) THEN
!   changes for points over the land, no frozen deep soil wetness 
!   and no snow
    ZDSWN(I)=ZSWI(I)*ZWFC(I)+(1.0_JPRB-ZSWI(I))*ZWWILT(I)
!   Test that new field is inside of limits like it is in ISBA
    IF (ZDSWN(I) <= ZVEG(I)*ZWWILT(I)) THEN
      ZDSW(I)=MAX(ZDSW(I),ZDSWN(I))
    ELSEIF (ZDSWN(I) >= ZWFC(I)) THEN
      ZDSW(I)=MIN(ZDSW(I),ZDSWN(I))
    ELSE
      ZDSW(I)=ZDSWN(I)
    ENDIF
    ZDSW(I)=MAX(ZDSW(I),MAX(ZSSW(I),ZEPW*ZD2(I)*GCONV))
  ENDIF
ENDDO

! Put the changed field ZDSW in GPPBUF on each PE
IST=1
DO JKGLO=1,NGPTOT,NPROMA
  IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
  IBLK=(JKGLO-1)/NPROMA+1
  DO JROF=IST,IEND
    SP_SB(JROF,1,YSP_SB%YQ%MP0,IBLK)=ZDSW(JROF+JKGLO-1)
  ENDDO
ENDDO

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