SUBROUTINE INTICE

!**** *INTICE*  - Computes a sea-ice concentration field over the model grid

!**   Purpose.
!     -------
!       Interpolates the sea-ice concentration field from satellite data to
!       the ARPEGE grid.

!**   Interface.
!     ---------
!        *CALL* *INTICE

!**   Method.
!     ------
!       For each sea grid point, the nearest satellite data are averaged to
!       obtain the final point value. The data used are selected in a band of
!       latitude, and the weight function used is such that the data far over
!       an appropriate radius (according to the local stretching factor) are
!       0-significant.

!**   Externals.
!     ---------

!**   Author.
!     ------
!        Francoise TAILLEFER  *METEO-FRANCE*

!**   Modifications.
!     -------------
!        ORIGINAL :  2002-10-10

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

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

USE YOMMP    , ONLY : MYPROC
USE YOMGEM   , ONLY : NGPTOTG  ,NGPTOT
USE YOMGC    , ONLY : GELAT    ,GM       ,GEMU     ,GELAM
USE YOMICE   , ONLY : RFICE    ,ROBMASK  ,RIALPHA  ,RIPORT   ,NREAOBS  , &
 & RSATLAT  ,RSATLON  ,RSATICE  
USE YOMCST   , ONLY : RPI      ,RA

IMPLICIT NONE

REAL(KIND=JPRB) :: ZMASK(NGPTOT), ZICE(NGPTOT), ZOBMASQ(NGPTOT)
REAL(KIND=JPRB) :: ZEPS, Z2PI, ZGM, ZRD2, ZFIV, ZTW, ZCLAT2, ZMAX
REAL(KIND=JPRB) :: ZLATSUP, ZLATINF, ZDLAT, ZDLONI, ZDLON, ZH2, ZMH2, ZW
INTEGER(KIND=JPIM) :: JSD, JROF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "disgrid.intfb.h"
#include "diwrgrid.intfb.h"

!**---------------------------------------------------------------------
!**      1.    MASQUE TERRE/MER.
!**            ----------------

IF (LHOOK) CALL DR_HOOK('INTICE',0,ZHOOK_HANDLE)
IF (MYPROC == 1) THEN
  CALL DISGRID(1,0,NGPTOTG,RFICE)
  ZMASK(1:NGPTOT)=RFICE(1:NGPTOT)
ELSE
  CALL DISGRID(1,1,NGPTOT,ZMASK)
ENDIF

!**---------------------------------------------------------------------
!**      2.    DATA INTERPOLATION.
!**            ------------------

ZICE(:)=0.0_JPRB
ZOBMASQ(:)=0.0_JPRB
ZEPS=1.E-13_JPRB
ZMAX=100._JPRB
Z2PI=2.0_JPRB*RPI

! Loop over all the grid points
DO JROF = 1,NGPTOT

!  No interpolation over land
  IF (ZMASK(JROF) > 0.5_JPRB) CYCLE

!  Local "influence radius"
  ZGM=EXP(RIALPHA*(1./GM(JROF)-GM(JROF)))
  ZRD2=(RA*RA)/(RIPORT*RIPORT*ZGM*ZGM)

  ZCLAT2=1.-GEMU(JROF)*GEMU(JROF)
  ZFIV=0.0_JPRB
  ZTW=0.0_JPRB

!  Latitude band for data research (lat +/- 1.2*dist.)
  ZLATSUP=GELAT(JROF)+1.2*RIPORT*ZGM/RA
  ZLATINF=GELAT(JROF)-1.2*RIPORT*ZGM/RA

!  Loop over all the satellite data
  DO JSD = 1 , NREAOBS

    IF (RSATLAT(JSD) >= ZLATSUP) CYCLE
    IF (RSATLAT(JSD) <= ZLATINF) CYCLE

!  Observation weight calculation
    ZDLAT=GELAT(JROF)-RSATLAT(JSD)
    ZDLONI=ABS(GELAM(JROF)-RSATLON(JSD))
    ZDLON=MIN(ZDLONI,Z2PI-ZDLONI)
    ZH2=(ZDLAT*ZDLAT+ZCLAT2*ZDLON*ZDLON)*ZRD2
    ZMH2=MIN(1.0_JPRB,ZH2)
    ZW=(1.0_JPRB-ZMH2*ZMH2)*EXP(-ZH2)

!  Sum computation
    ZFIV=ZFIV+ZW*RSATICE(JSD)
    ZTW=ZTW+ZW
  ENDDO

  IF (ZTW < ZEPS) THEN
    ZICE(JROF)=-999._JPRB
    ZOBMASQ(JROF)=0.0_JPRB
  ELSE
    ZICE(JROF)=MAX(0.0_JPRB,MIN(ZMAX,ZFIV/ZTW))
    ZOBMASQ(JROF)=1.0_JPRB
  ENDIF

ENDDO

IF (ALLOCATED(RSATLON)) DEALLOCATE(RSATLON)
IF (ALLOCATED(RSATLAT)) DEALLOCATE(RSATLAT)
IF (ALLOCATED(RSATICE)) DEALLOCATE(RSATICE)

ALLOCATE(ROBMASK(NGPTOTG))

IF (MYPROC == 1) THEN
  RFICE(1:NGPTOT)=ZICE(1:NGPTOT)
  ROBMASK(1:NGPTOT)=ZOBMASQ(1:NGPTOT)
ELSE
  CALL DIWRGRID(1,1,0,NGPTOT,ZICE)
  CALL DIWRGRID(1,2,0,NGPTOT,ZOBMASQ)
ENDIF

IF (MYPROC == 1) THEN
  CALL DIWRGRID(1,1,1,NGPTOTG,RFICE)
  CALL DIWRGRID(1,2,1,NGPTOTG,ROBMASK)
ENDIF

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