SUBROUTINE INCLITC

!**** *INCLITC*

!     PURPOSE.
!     --------
!       Creation of an ARPEGE/ALADIN file containing the NESDIS sea surface temperature.

!**   INTERFACE.
!     ----------
!       CALL INCLITC

!     METHOD.
!     -------
!       The field is read on unit 3 (filled before from the BDAP).
!       It's interpolated on the gaussian grid for ARPEGE or on the specified ALADIN grid.
!       Finally it's written on the output file unit 15.

!     EXTERNALS.
!     ----------
!       FAITOU FANDAR FAUTIF FACILE FAIENC FAIRME FACIES LFIMST
!       INTER0 GEO923 INTER6

!     AUTHORS.
!     --------
!       F. TAILLEFER    JULY 99

!     MODIFICATIONS.
!     --------------
!       F. Taillefer 11/01 : moving input grid dimensionning from parameter to namelist
!       F. Taillefer 02/04 : changing INTER2 to INTER6 (use of land/sea mask)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!       F. Taillefer 01/08 : add LAM case

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

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

USE YOMDIM   , ONLY : NDGLG    ,NDLON    ,NDGUNG   ,NDGUXG   ,NDLUNG   ,NDLUXG
USE YOMLUN   , ONLY : NULOUT   ,NULNAM   ,NINISH
USE YOMOP    , ONLY : CNMCA
USE YOMCT0   , ONLY : CNMEXP   ,LELAM
USE YOMRIP   , ONLY : NINDAT   ,NSSSSS
USE YOMGEM   , ONLY : NLOENG   ,RSTRET
USE YOMCLTC  , ONLY : NLONTC   ,NLATTC
USE YEMGEO   , ONLY : EDELX    ,EDELY
USE YOMCLI   , ONLY : LGLOBE   ,NGLOBX   ,NGLOBY   ,NDATX    ,NDATY

IMPLICIT NONE

! JPBX/JPBY : number of extra longitudes/latitudes on each side of the data
!             grid required by interpolation (4 or 12 points -> 2/2)

INTEGER(KIND=JPIM) :: JPBX,JPBY
PARAMETER(JPBX=2,JPBY=2)

REAL(KIND=JPRB) :: ZBO(NDGLG+1),ZLONG(NDGLG),ZMU(NDGLG*NDLON)

INTEGER(KIND=JPIM) :: IDATEF(11)

REAL(KIND=JPRB),ALLOCATABLE :: ZFLD(:,:),ZLSM(:,:),ZSLA(:),ZSLO(:,:),ZCLO(:,:)
REAL(KIND=JPRB),ALLOCATABLE :: ZS(:),ZLS(:),ZEXT(:),ZS2(:)

CHARACTER :: CLNOMF*12, CLNOMF2*16

INTEGER(KIND=JPIM) :: INTLO, INTLA
INTEGER(KIND=JPIM),ALLOCATABLE :: ILIND(:)

INTEGER(KIND=JPIM) :: ICO, ILEN, INBARI, INBARP, INIMES, INIQ, INJQ, INS, &
 & IPNIV, IREP, ITOGOS, JI, JJ, IUNIT, IA1, IM1, IJ1, INPNPP, IL1, IL2

REAL(KIND=JPRB) :: ZLIMASK, ZSEUIL, ZVALAND, ZVALMSK
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "geo923.intfb.h"
#include "inter0.intfb.h"
#include "inter6.intfb.h"
#include "posnam.intfb.h"
#include "abor1.intfb.h"
#include "egeo923.intfb.h"
#include "einter0.intfb.h"
#include "einter6.intfb.h"
#include "eleci.intfb.h"

#include "namcltc.h"

!-------------------------------------------------------------------------------
!     1. READ NAMELIST.
!        -------------

IF (LHOOK) CALL DR_HOOK('INCLITC',0,ZHOOK_HANDLE)
NLONTC=360
NLATTC=180

CALL POSNAM (NULNAM,'NAMCLTC')
READ (NULNAM,NAMCLTC)

WRITE (UNIT=NULOUT, &
 & FMT='(/,''  input BDAP grid : NLONTC = '',I4,''    NLATTC = '',I4)') &
 & NLONTC,NLATTC  

!-------------------------------------------------------------------------------
!     2. SET INITIAL VALUES.
!        ------------------

LGLOBE=.TRUE.

NGLOBX=NLONTC
NGLOBY=NLATTC

NDATX=NLONTC
NDATY=NLATTC

IF (LELAM) THEN
  CALL EINTER0 (NLONTC,NLATTC,INPNPP)
  INS=-1
  IL1=NLATTC+JPBY
  IL2=1+JPBY
ELSE
  CALL INTER0 (NDGLG,NDLON,NLATTC,NLONTC,RSTRET,INPNPP)
  INS=1
  IL1=1+JPBY
  IL2=NLATTC+JPBY
ENDIF

INTLO=NLONTC+2*JPBX
INTLA=NLATTC+2*JPBY

IREP=0
INBARI=0
INIMES=1
INBARP=1
IUNIT=15
CLNOMF='ICMSH'//CNMEXP(1:4)//'SST'
CLNOMF2='ICMSH'//CNMEXP(1:4)//'INIT'

IF (LELAM) THEN
  INJQ=NDGUXG-NDGUNG+1
  INIQ=NDLUXG-NDLUNG+1
  ILEN=INIQ*INJQ
ELSE
  ILEN=NDGLG*NDLON
ENDIF

!         Allocate temporary space

ALLOCATE(ZFLD(INTLO,INTLA))
ALLOCATE(ZLSM(INTLO,INTLA))

ALLOCATE(ZLS(ILEN))
ALLOCATE(ZS(ILEN))

ALLOCATE(ILIND(ILEN))

ZSEUIL=10000._JPRB
ZLIMASK=0.5_JPRB

!-------------------------------------------------------------------------------
!     3. OUTPUT GRID LAND/SEA MASK READING.
!        ---------------------------------

! This field is read in the initial conditions FA file (climatology)

CALL FAITOU (IREP,NINISH,.TRUE.,CLNOMF2,'UNKNOWN',.TRUE.,.TRUE., &
 & INIMES,INBARP,INBARI,'CADRE LECTURE   ')  
CALL LFIMST (IREP,NINISH,.FALSE.)
IF (LELAM) THEN
  CALL ELECI (IREP,NINISH,'SURF',0,'IND.TERREMER',ZLS,NULOUT)
ELSE
  CALL FACILE (IREP,NINISH,'SURF',0,'IND.TERREMER',ZLS,.FALSE.)
ENDIF
CALL FAIRME (IREP,NINISH,'UNKNOWN')

ZLS(:)=1.0_JPRB-ZLS(:)

!-------------------------------------------------------------------------------
!     4. INPUT DATA UPDATING.
!        -------------------

!     4.1  Input file reading

OPEN(UNIT=3,FILE='sst.nesdis.bdap',FORM='UNFORMATTED')
READ(3) IA1,IM1,IJ1
READ(3) ((ZFLD(JI,JJ),JI=1+JPBX,NLONTC+JPBX),JJ=IL1,IL2,INS)
CLOSE(3)

!     4.2  Input land/sea mask updating

ZLSM(:,:)=1.0_JPRB
DO JJ = 1+JPBY,NLATTC+JPBY
  DO JI = 1+JPBX,NLONTC+JPBX
    IF ( ZFLD(JI,JJ) > ZSEUIL ) THEN
      ZLSM(JI,JJ)=0.0_JPRB
    ELSE
      ZLSM(JI,JJ)=1.0_JPRB
    ENDIF
  ENDDO
ENDDO

ZVALMSK=MINVAL(ZLSM)
WRITE(NULOUT,*) '  '
IF ( ZVALMSK < ZLIMASK ) THEN
  WRITE(NULOUT,*) ' SST NESDIS fournie avec masque '
ELSE
  WRITE(NULOUT,*) ' SST NESDIS fournie sans masque '
ENDIF

!-------------------------------------------------------------------------------
!     5. OUTPUT FILE DEFINITION.
!        ----------------------

CALL FAITOU (IREP,IUNIT,.TRUE.,CLNOMF,'NEW',.TRUE.,.TRUE.,INIMES, &
 & INBARP,INBARI,CNMCA)  
CALL LFIMST (IREP,IUNIT,.FALSE.)
CALL FAUTIF (IREP,IUNIT,'NESDIS SST')

! Date control

WRITE(NULOUT,'(/,''  date of the model: '',I8,I8)') NINDAT,NSSSSS
WRITE(NULOUT,'(''  date of the data:  '',I4,I2.2,I2.2,/)') IA1,IM1,IJ1
IDATEF(1)= IA1
IDATEF(2)= IM1
IDATEF(3)= IJ1
IDATEF(4)=0
IDATEF(5)=0
IDATEF(6)=1
IDATEF(7:11)=0
CALL FANDAR (IREP,IUNIT,IDATEF)

!-------------------------------------------------------------------------------
!     6. DEFINITION OF THE SUBGRID (ARPEGE CASE MAINLY).
!        -------------------------

!     ZBO = Sine of the boundary latitudes of the NDGLG boxes.
!     ZSLA = Sine of the latitudes of the subgrid.
!     ZSLO = Sine of the longitudes of the subgrid.
!     ZCLO = Cosine of the longitudes of the subgrid.

IF (.NOT.LELAM) THEN
  ALLOCATE(ZSLA(NDGLG*INPNPP))
  ALLOCATE(ZSLO(NDLON*INPNPP,NDGLG))
  ALLOCATE(ZCLO(NDLON*INPNPP,NDGLG))
  ITOGOS=0
  CALL GEO923 (INPNPP,ITOGOS,ZBO,ZLONG,ZMU,ZSLA,ZSLO,ZCLO)
ELSE
  ITOGOS=(NDGUXG-NDGUNG+1)*(NDLUXG-NDLUNG+1)
  IF (ITOGOS /= ILEN) THEN
    WRITE(NULOUT,*) 'PB IN ALD ARRAYS : ITOGOS=',ITOGOS,'  ILEN=',ILEN
    CALL ABOR1 ('PB INCLITC')
  ENDIF
  CALL EGEO923
ENDIF

!-------------------------------------------------------------------------------
!     7. INPUT FIELD INTERPOLATION.
!        -------------------------

IPNIV=1
ICO=INPNPP*INPNPP
IF (LELAM) THEN
  CALL EINTER6 (ZFLD,INTLA,INTLO,IPNIV,ZS,INJQ,INIQ,ILEN,EDELX,EDELY,INPNPP, &
 & ICO,NULOUT,ZLSM,ZLS,ZLIMASK)
ELSE
  INJQ=NDGLG*INPNPP
  INIQ=NDLON*INPNPP
  CALL INTER6 (NDGLG,NDLON,INTLA,INTLO,IPNIV,INPNPP,ITOGOS,ICO,INJQ,INIQ, &
 & NLOENG(1),ILEN,ZS,ZFLD,ZSLA,ZSLO,ZCLO,ZLSM,ZLS,ZLIMASK)
  IF (ALLOCATED(ZSLA)) DEALLOCATE(ZSLA)
  IF (ALLOCATED(ZSLO)) DEALLOCATE(ZSLO)
  IF (ALLOCATED(ZCLO)) DEALLOCATE(ZCLO)
ENDIF

!-------------------------------------------------------------------------------
!     8. OUTPUT FILE CHECKING.
!        --------------------

!     8.1  First field checking

! Find land values over sea and replace them by ZVALMSK
! Replace masked values by ZVALAND to allow packing

ICO=0
INS=0

ZSEUIL=350._JPRB

ZVALMSK=271.15_JPRB
ZVALAND=288.15_JPRB

DO JI = 1,ITOGOS
  IF ( ZLS(JI) < ZLIMASK ) THEN
    ICO=ICO+1
    ZS(JI)=ZVALAND
  ELSE
    IF ( ZS(JI) > ZSEUIL ) THEN
      INS=INS+1
      ILIND(INS)=JI
    ENDIF
  ENDIF
ENDDO
WRITE(NULOUT,*) ' resultat interpolation : '
WRITE(NULOUT,*) '    ',ICO,' points sur continent forces a 15 degres Celsius '
WRITE(NULOUT,*) '    ',INS,' points indefinis sur mer '

!     8.2  Second loop with a bigger INPNPP

IF (INS /= 0) THEN
  INPNPP=INPNPP*4+1
  ICO=INPNPP*INPNPP
  IPNIV=1
  ALLOCATE(ZS2(ILEN))
  IF (LELAM) THEN
    CALL EINTER6 (ZFLD,INTLA,INTLO,IPNIV,ZS2,INJQ,INIQ,ILEN,EDELX,EDELY,INPNPP, &
   & ICO,NULOUT,ZLSM,ZLS,ZLIMASK)
  ELSE
    INJQ=NDGLG*INPNPP
    INIQ=NDLON*INPNPP
    ALLOCATE(ZSLA(NDGLG*INPNPP))
    ALLOCATE(ZSLO(NDLON*INPNPP,NDGLG))
    ALLOCATE(ZCLO(NDLON*INPNPP,NDGLG))
    ITOGOS=0
    CALL GEO923 (INPNPP,ITOGOS,ZBO,ZLONG,ZMU,ZSLA,ZSLO,ZCLO)
    CALL INTER6 (NDGLG,NDLON,INTLA,INTLO,IPNIV,INPNPP,ITOGOS,ICO,INJQ,INIQ, &
   & NLOENG(1),ILEN,ZS2,ZFLD,ZSLA,ZSLO,ZCLO,ZLSM,ZLS,ZLIMASK)
  ENDIF
  ILEN=0
  DO JI = 1,INS
    ZS(ILIND(JI))=ZS2(ILIND(JI))
  ENDDO
  DO JI = 1,ITOGOS
    IF ( ZS(JI) > ZSEUIL ) THEN
      ILEN=ILEN+1
      ZS(JI)=ZVALMSK
    ENDIF
  ENDDO
  WRITE(NULOUT,*) '    ',ILEN,' points indefinis sur mer forces a -2 deg C '
ENDIF

!     8.3  Deallocate temporary space

IF (ALLOCATED(ZFLD)) DEALLOCATE(ZFLD)
IF (ALLOCATED(ZSLA)) DEALLOCATE(ZSLA)
IF (ALLOCATED(ZSLO)) DEALLOCATE(ZSLO)
IF (ALLOCATED(ZCLO)) DEALLOCATE(ZCLO)
IF (ALLOCATED(ZS2)) DEALLOCATE(ZS2)

!-------------------------------------------------------------------------------
!     9. OUTPUT FILE WRITING.
!        -------------------

IF (LELAM) THEN
  IA1=0
  IM1=0
  ALLOCATE(ZEXT(NDLON*NDGLG))
  DO JJ=1,NDGUXG
    ZSEUIL=0._JPRB
    DO JI=1,NDLUXG
      IA1=IA1+1
      IM1=IM1+1
      ZEXT(IA1)=ZS(IM1)
      ZSEUIL=ZSEUIL+ZS(IM1)
    ENDDO
    ZSEUIL=ZSEUIL/FLOAT(NDLUXG)
    DO JI=NDLUXG+1,NDLON
      IA1=IA1+1
      ZEXT(IA1)=ZSEUIL
    ENDDO
  ENDDO
  DO JJ=NDGUXG+1,NDGLG
    DO JI=1,NDLON
      IA1=IA1+1
      ZEXT(IA1)=ZSEUIL
    ENDDO
  ENDDO
  CALL FAIENC (IREP,IUNIT,'SURF',0,'SST.CLIM.',ZEXT,.FALSE.)
ELSE
  CALL FAIENC (IREP,IUNIT,'SURF',0,'SST.CLIM.',ZS,.FALSE.)
ENDIF

CALL FAIRME (IREP,IUNIT,'UNKNOWN')
WRITE(NULOUT,*) '    '
WRITE(NULOUT,*) 'END of configuration 931 '
WRITE(NULOUT,*) '    '

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