SUBROUTINE INTER8 (KLAT,KLON,KLAT0,KLON0,KNCH,KPP,KNPT,&
 & KNCO,KNJQ,KNIQ,KNIP,KLEN,PZI,PZ0,PSLAC,PSLOC,PCLOC)  

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

!       Iterpolation of a field from a finer grid.
!           (using 4 neighbouring points)

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

!     CALL INTER8 (KLAT,KLON,KLAT0,KLON0,KNCH,KPP,KNPT
!    $,KNCO,KNJQ,KNIQ,KNIP,KLEN,PZI,PZ0,PSLAC,PSLOC,PCLOC)
!        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)
!        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

!     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

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

!        TRACARE

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

!         M. DEQUE  18 JULY 1995

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)    :: 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)    :: KNPT 
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(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) ::ZWGT4(KNCO,4)&
 & ,ZSLAC(KNCO),ZSLOC(KNCO),ZCLOC(KNCO)&
 & ,ZSLAR(KNCO),ZSLOR(KNCO),ZCLOR(KNCO)  
INTEGER(KIND=JPIM) :: IXX(KNCO),IYY(KNCO)

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

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

#include "tracare.intfb.h"

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

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

IF (LHOOK) CALL DR_HOOK('INTER8',0,ZHOOK_HANDLE)
DO JCH=1,KNCH
  DO J=1,KNPT
    PZI(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

!     Loop in the box : linear interpolation for all fields

      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))  
      ENDDO
    ENDDO

  ENDDO

  ICOMPT=ICOMPT+KNIP(JJ)
ENDDO

!     1.3 Normalisation.

ZCONO2=1.0_JPRB/REAL(KNCO,JPRB)

DO JFL=1,KNCH
  DO J=1,KNPT
    PZI(J,JFL)=PZI(J,JFL)*ZCONO2
  ENDDO
ENDDO

IF (LHOOK) CALL DR_HOOK('INTER8',1,ZHOOK_HANDLE)
END SUBROUTINE INTER8
