SUBROUTINE INTER10 (KLAT,KLON,KLAT0,KLON0,KNCH,KPP,KNPT,&
 & KNCO,KNJQ,KNIQ,KNIP,KLEN,PZI,PZS,PZ0,PSLAC,PSLOC,PCLOC,&
 & PSEA0,PSEA1,PSEA2,PSEA3,PSPCM)  

!     PURPOSE.
!     --------

!       Iterpolation of a field from a finer grid :
!        fields with sea/land contrast and major/minor averages
!       As INTER7 but with 4 points interpolation instead of 12

!**   INTERFACE.
!     ----------

!     CALL INTER10 (KLAT,KLON,KLAT0,KLON0,KNCH,KPP,KNPT
!    $,KNCO,KNJQ,KNIQ,KNIP,KLEN,PZI,PZS,PZ0,PSLAC,PSLOC,PCLOC
!    $,PSEA0,PSEA1,PSEA2,PSEA3,PSPCM)
!        KLAT  = number of latitudes of the final grid
!        KLON  = number of longitudes of the final grid
!        KLAT0 = number of latitudes of the initial grid
!                  2  latitudes are added beyond each pole
!        KLON0 = number of longitudes of the initial grid
!                  4 longitudes are duplicated : 2 on each side
!        KPP   = size of the box (odd and at least KLAT0/KLAT)
!        KNCH  = number of field to interpolate
!        KNPT  = number of points of the final grid (KLAT*KLON if no reduction)
!        KLEN  = First length of the output field (may be different from KNPT)
!        KNCO  = KPP*KPP
!        KNJQ  = KLAT*KPP
!        KNIQ  = KLON*KPP
!        KNIP  = number of longitudes on a latitude circle (final grid)
!        PZI   = interpolated field (output)
!        PZS   = secondary interpolated field (output)
!        PSEA0 = mask of "sea" on the initial grid
!        PSEA1 = fraction of "sea" on the final grid (result of the 4 pt. inter.)
!        PSEA2 = fraction of "sea" on the final grid (reference value)
!        PSEA3 = PSEA1 (output)
!        PSPCM = threshold to define continents from PSEA2
!        PZ0   = initial field
!        PSLAC = sine of the latitude in the subgrid
!        PSLOC = sine of the longitude in the subgrid
!        PCLOC = cosine of the longitude in the subgrid
!        IXX,IYY = working arrays

!     METHOD.
!     -------

!       The field is first calculated on a subgrid of the final grid.
!       Each value is interpolated from the 4 nearest points of the initial gri
!       Then the values of the box (subgrid) are averaged (only for the points
!       which belong to the same "sea/land" category as the final point)
!       If there is not enough points in the neighbourhood to calculate 
!       the secondary average (area < 10%), an alternate (back and forth)
!       research is done to find out a value in this category among the further
!       neighbours in the target grid.

!     EXTERNALS.
!     ----------

!        TRACARE

!     AUTHORS.
!     --------

!          M. DEQUE  19 JUL 95.

!     MODIFICATION
!     ------------
!     E. Bazile  98-03-03: Some more tests and corrections in the
!                          alternate research !!!

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

USE YOMDIL   , ONLY : NPOTYP   ,SLAPO    ,GLAPO    ,SLOPO    ,GLOPO    ,FACDI
USE YOMCST   , ONLY : RPI

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLAT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLAT0 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLON0 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNCH 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNPT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNJQ 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNIQ 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM)               :: KLON ! Argument NOT used
INTEGER(KIND=JPIM),INTENT(IN)    :: KPP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNCO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNIP(KLAT) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZI(KLEN,KNCH) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZS(KLEN,KNCH) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PZ0(KLON0,KLAT0,KNCH) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLAC(KNJQ) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLOC(KNIQ,KLAT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLOC(KNIQ,KLAT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSEA0(KLON0,KLAT0) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSEA1(KNPT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSEA2(KNPT) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSEA3(KNPT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPCM 
REAL(KIND=JPRB) ::ZWGT4(KNCO,4),ZSLAC(KNCO),ZSLOC(KNCO),ZCLOC(KNCO)&
 & ,ZSLAR(KNCO),ZSLOR(KNCO),ZCLOR(KNCO),ZZQ(KLEN,KNCH)  
INTEGER(KIND=JPIM) :: IXX(KNCO),IYY(KNCO)

INTEGER(KIND=JPIM) :: ICOMPT, IDIF, INDICE, IPAUT, ISMAS, IXM,&
 & IYM, J, JCH, JFL, JI, JJ, JK, JL, JM, JX, &
 & JY  

REAL(KIND=JPRB) :: ZCONO2, ZCX, ZCY, ZSI, ZX, ZXX, ZY, ZYY
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "tracare.intfb.h"

!     ------------------------------------------------------------------
!*
!     1. PROCESSING.
!        -----------

!     1.1 Setting initial values to zero and extending the initial grid.

IF (LHOOK) CALL DR_HOOK('INTER10',0,ZHOOK_HANDLE)
DO JCH=1,KNCH
  DO J=1,KNPT
    PZI(J,JCH)=0.0_JPRB
    PZS(J,JCH)=0.0_JPRB
    ZZQ(J,JCH)=0.0_JPRB
  ENDDO
ENDDO
IPAUT=(KLON0-4)/2
DO JFL=1,KNCH
  DO JI=3,IPAUT+2
    PZ0(JI,1,JFL)=PZ0(JI+IPAUT,4,JFL)
    PZ0(JI+IPAUT,1,JFL)=PZ0(JI,4,JFL)
    PZ0(JI,2,JFL)=PZ0(JI+IPAUT,3,JFL)
    PZ0(JI+IPAUT,2,JFL)=PZ0(JI,3,JFL)
    PZ0(JI,KLAT0,JFL)=PZ0(JI+IPAUT,KLAT0-3,JFL)
    PZ0(JI+IPAUT,KLAT0,JFL)=PZ0(JI,KLAT0-3,JFL)
    PZ0(JI,KLAT0-1,JFL)=PZ0(JI+IPAUT,KLAT0-2,JFL)
    PZ0(JI+IPAUT,KLAT0-1,JFL)=PZ0(JI,KLAT0-2,JFL)
  ENDDO

  DO JJ=1,KLAT0
    PZ0(1,JJ,JFL)=PZ0(KLON0-3,JJ,JFL)
    PZ0(2,JJ,JFL)=PZ0(KLON0-2,JJ,JFL)
    PZ0(KLON0-1,JJ,JFL)=PZ0(3,JJ,JFL)
    PZ0(KLON0,JJ,JFL)=PZ0(4,JJ,JFL)
  ENDDO
ENDDO

!     1.2 Bulk summation.

!     Calculation of the coordinates of the points in the box

ICOMPT=0
DO JJ=1,KLAT

  DO JL=1,KPP
    DO JK=1,KPP
      ZSLAC((JL-1)*KPP+JK)=PSLAC((JJ-1)*KPP+JL)
    ENDDO
  ENDDO

  DO JI=1,KNIP(JJ)
    INDICE=ICOMPT+JI

    DO JL=1,KPP
      DO JK=1,KPP
        JM=(JL-1)*KPP+JK
        ZSLOC((JL-1)*KPP+JK)=PSLOC((JI-1)*KPP+JK,JJ)
        ZCLOC((JL-1)*KPP+JK)=PCLOC((JI-1)*KPP+JK,JJ)
      ENDDO
    ENDDO

!     Coordinate transform.

    CALL TRACARE (ZSLAC,ZSLOC,ZCLOC,ZSLAR,ZSLOR,ZCLOR,KNCO,&
     & SLAPO,GLAPO,SLOPO,GLOPO,FACDI,NPOTYP)  

    DO JM=1,KNCO

!     Loop in the box : the interpolation values are localised.

      ZSLAR(JM)=MIN(1.0_JPRB,MAX(-1.0_JPRB,ZSLAR(JM)))
      ZSI=MAX(0.0_JPRB,SIGN(1.0_JPRB,ZSLOR(JM)))
      ZCLOR(JM)=MIN(1.0_JPRB,MAX(-1.0_JPRB,ZCLOR(JM)))
      ZX=(ZSI*ACOS(ZCLOR(JM))+(1.0_JPRB-ZSI)*(2.0_JPRB*RPI-ACOS(ZCLOR(JM))))&
       & *REAL(KLON0-4,JPRB)/RPI/2.0_JPRB  
      ZX=MOD(ZX,REAL(KLON0-4,JPRB))
      IXX(JM)=INT(2.5_JPRB+ZX)
      ZXX=2.5_JPRB+ZX-IXX(JM)
      ZCX=1.0_JPRB-ZXX
      ZY=REAL(KLAT0-4,JPRB)*ACOS(ZSLAR(JM))/RPI
      IYY(JM)=INT(2.5_JPRB+ZY)
      ZYY=2.5_JPRB+ZY-IYY(JM)
      ZCY=1.0_JPRB-ZYY

!     Loop in the box : the linear interpolation weights are set

      ZWGT4(JM,1)=ZXX*ZYY
      ZWGT4(JM,2)=ZCX*ZYY
      ZWGT4(JM,3)=ZXX*ZCY
      ZWGT4(JM,4)=ZCX*ZCY
    ENDDO
    DO JM=1,KNCO

      IXM=IXX(JM)
      IYM=IYY(JM)

      DO JFL=1,KNCH
        PZI(INDICE,JFL)=PZI(INDICE,JFL)+&
         & (ZWGT4(JM, 1)*PZ0(IXM+1,IYM+1,JFL)&
         & +ZWGT4(JM, 2)*PZ0(IXM  ,IYM+1,JFL)&
         & +ZWGT4(JM, 3)*PZ0(IXM+1,IYM  ,JFL)&
         & +ZWGT4(JM, 4)*PZ0(IXM  ,IYM  ,JFL))  
        ZZQ(INDICE,JFL)=ZZQ(INDICE,JFL)+&
         & (ZWGT4(JM, 1)*PZ0(IXM+1,IYM+1,JFL)*PSEA0(IXM+1,IYM+1)&
         & +ZWGT4(JM, 2)*PZ0(IXM  ,IYM+1,JFL)*PSEA0(IXM  ,IYM+1)&
         & +ZWGT4(JM, 3)*PZ0(IXM+1,IYM  ,JFL)*PSEA0(IXM+1,IYM  )&
         & +ZWGT4(JM, 4)*PZ0(IXM  ,IYM  ,JFL)*PSEA0(IXM  ,IYM  ))  
      ENDDO
    ENDDO

  ENDDO

  ICOMPT=ICOMPT+KNIP(JJ)
ENDDO

!     1.3 Normalisation.

ZCONO2=1.0_JPRB/REAL(KNCO,JPRB)

!  securities
ISMAS=0
IDIF=0
DO J=1,KNPT
  IF((PSEA2(J) <= PSPCM.AND.PSEA1(J) > 0.9_JPRB).OR.&
     & (PSEA2(J) > PSPCM.AND.PSEA1(J) < 0.1_JPRB))THEN  
    IDIF=IDIF+1
  ENDIF
  IF(PSEA2(J) <= PSPCM)ISMAS=ISMAS+1
ENDDO
WRITE(6,'('' NUMBER OF CONFLICT POINT BETWEEN '',&
 & ''PSEA1 (Int. Mask) AND PSEA2 (Final Mask): I=''&
 & ,I7)')IDIF  
WRITE(6,'('' ISMAS='',I6,'' KNPT='',I6,'' PSPCM='',F5.2)')ISMAS,KNPT,PSPCM

IF(ISMAS == 0.OR.ISMAS == KNPT)THEN
  WRITE(6,'('' SORRY : NEVER SECONDARY TYPE'')')
  CALL ABOR1('INTER10: ABOR1 CALLED')
ENDIF

DO JFL=1,KNCH
  DO J=1,KNPT
    PZS(J,JFL)=-9999._JPRB
    IF(PSEA2(J) <= PSPCM) THEN
!           Land on the final grid
      IF (PSEA1(J) <= 0.9_JPRB) THEN
        PZI(J,JFL)=(PZI(J,JFL)-ZZQ(J,JFL))*ZCONO2/(1.0_JPRB-PSEA1(J))
      ELSE
        PZI(J,JFL)=-9999._JPRB
      ENDIF
      IF (PSEA1(J) >= 0.1_JPRB) THEN
        PZS(J,JFL)=ZZQ(J,JFL)*ZCONO2/PSEA1(J)
      ELSE
        PZS(J,JFL)=-9999._JPRB
      ENDIF
    ELSE
!           Sea on the final grid
      IF (PSEA1(J) <= 0.9_JPRB) THEN
        PZS(J,JFL)=(PZI(J,JFL)-ZZQ(J,JFL))*ZCONO2/(1.0_JPRB-PSEA1(J))
      ELSE
        PZS(J,JFL)=-9999._JPRB
      ENDIF
      IF (PSEA1(J) >= 0.1_JPRB) THEN
        PZI(J,JFL)=ZZQ(J,JFL)*ZCONO2/PSEA1(J)
      ELSE
        PZI(J,JFL)=-9999._JPRB
      ENDIF
    ENDIF
  ENDDO

  DO J=1,KNPT
    IF ((PZI(J,JFL) <= -9998).AND.(PSEA2(J) <= PSPCM)) THEN
!            Land on the final grid
      JY=J+1
      JY=MAX(1,MIN(KNPT,JY))
      IF (PSEA2(JY) <= PSPCM) THEN
        PZI(J,JFL)=PZI(JY,JFL)
      ELSE
        JY=J-1
        JY=MAX(1,MIN(KNPT,JY))
        IF (PSEA2(JY) <= PSPCM) THEN
          PZI(J,JFL)=PZI(JY,JFL)
        ENDIF
      ENDIF
    ENDIF
  ENDDO

  DO J=KNPT,1,-1
    IF ((PZI(J,JFL) <= -9998).AND.(PSEA2(J) <= PSPCM)) THEN
!            Land on the final grid
      JY=J-1
      JY=MAX(1,MIN(KNPT,JY))
      IF ((PSEA2(JY) <= PSPCM).AND.(PZI(JY,JFL) > -9998)) THEN
        PZI(J,JFL)=PZI(JY,JFL)
      ELSE
        JY=J+1
        JY=MAX(1,MIN(KNPT,JY))
        IF ((PSEA2(JY) <= PSPCM).AND.(PZI(JY,JFL) > -9998)) THEN
          PZI(J,JFL)=PZI(JY,JFL)
        ENDIF
      ENDIF
    ENDIF
  ENDDO

  DO J=1,KNPT
    IF (PZS(J,JFL) <= -9998) THEN
!             Alternate research of a neighbour for the secondary average
      JX=1
      JY=J+1
      JK=MAX(1,MIN(KNPT,JY))
!               beginning of the test
      135 CONTINUE
      IF(((PSEA2(J) <= PSPCM.AND.PSEA2(JK) > PSPCM).OR.&
       & (PSEA2(J) > PSPCM.AND.PSEA2(JK) <= PSPCM)).AND.&
       & (PZI(JK,JFL) >= -9998._JPRB)) GO TO 137  

      IF (PZS(JK,JFL) >= -9998) GO TO 136
!               next point to test
      JX=SIGN(IABS(JX)+1,-JX)
      JY=JY+JX
      JK=MAX(1,MIN(KNPT,JY))
      GOTO 135
!                The point is of the same category and PZS <> -9999
      136 CONTINUE
      IF (PZS(J,JFL) <= -9998.) PZS(J,JFL)=PZS(JK,JFL)
      IF (PZI(J,JFL) <= -9998._JPRB) PZI(J,JFL)=PZI(JK,JFL)
      GO TO 138
!                The point is of the opposite category
      137 CONTINUE
      PZS(J,JFL)=PZI(JK,JFL)
      138 CONTINUE
    ENDIF
  ENDDO

ENDDO

DO J=1,KNPT
  PSEA3(J)=PSEA1(J)
ENDDO
IF (LHOOK) CALL DR_HOOK('INTER10',1,ZHOOK_HANDLE)
END SUBROUTINE INTER10
