SUBROUTINE GRID_BICUBIC(KLAT_IN,KLON_IN,PLAT_IN,KIN,&
                      & KLAT_OUT,KLON_OUT,PLAT_OUT,KOUT,&
                      & PFLD_IN,PFLD_OUT)  

!    Purpose.
!    --------
!      Bicubic interpolation of grid field from model resolution
!      to grid defined by input parameter. Assumes the whole
!      field is in memory.

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

!    Input:
!      KLAT_IN  - number of latitude rows of the input grid
!      KLON_IN  - number of longitudes for each row of the input grid
!      PLAT_IN  - latitude (radians) of each row of the input grid
!      KOUT     - size of input array
!      KLAT_OUT - number of latitude rows of the output grid
!      KLON_OUT - number of longitudes for each row of the output grid
!      PLAT_OUT - latitude (radians) of each row of the output grid
!      KOUT     - size of output array
!      PFLD_IN  - array of grid values at input resolution

!    Output:
!      PFLD_OUT - array of interpolated values

!    Author.
!    -------
!      Y.Tremolet

!    Modifications.
!    --------------
!      Original: 24/04/01
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE YOMCST, ONLY : RPI
USE YOMLUN, ONLY : nulout

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLAT_IN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLON_IN(KLAT_IN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAT_IN(KLAT_IN) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLAT_OUT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLON_OUT(KLAT_OUT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAT_OUT(KLAT_OUT) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOUT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFLD_IN(KIN) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLD_OUT(KOUT)

INTEGER(KIND=JPIM) :: jlat, jlon, ilats(4), ilat, ii, jj, jin, j1, j2, j3, j4
REAL(KIND=JPRB) :: zlat, zout, zdlonout, zdlonin, zxi, zp0, zp1, zm1, zm2, &
 & z1,z2,z3,z4,zx1,zx2,zx3,zx4,zd1,zd2,zd3,zd4,zz1,zz2,zz3,zz4  
REAL(KIND=JPRB), ALLOCATABLE :: ztmp(:,:)
INTEGER(KIND=JPIM) :: ind(KLAT_IN)
REAL(KIND=JPRB) :: zz, zminh, zmaxh, zavgh, zminl, zmaxl, zavgl
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

IF (LHOOK) CALL DR_HOOK('GRID_BICUBIC',0,ZHOOK_HANDLE)

CALL GSTATS(1944,0)
ii=1
DO jlat=1,KLAT_IN
  ind(jlat)=ii
  ii=ii+KLON_IN(jlat)
ENDDO

ii=klon_out(1)
DO jlat=2,klat_out
  ii=MAX(ii,klon_out(jlat))
ENDDO
ALLOCATE(ztmp(ii,4))

ii=0
DO jlat=1,klat_out
  zlat=plat_out(jlat)
  ilat=1
  DO WHILE (ilat<KLAT_IN .AND. zlat<PLAT_IN(ilat))
    ilat=ilat+1
  ENDDO

! Check the bounds
! ... assuming nobody runs the IFS with less than 4 latitude rows !!!
  ilat=MIN(ilat,KLAT_IN-1)
  ilat=MAX(ilat,3)

  ilats(1)=ilat-2
  ilats(2)=ilat-1
  ilats(3)=ilat
  ilats(4)=ilat+1

  zdlonout=2.0*RPI/klon_out(jlat)
  DO jj=1,4
    zdlonin=2.0*RPI/KLON_IN(ilats(jj))
    DO jlon=1,klon_out(jlat)
      zout=(jlon-1)*zdlonout
      jin=INT(zout/zdlonin)
      j1=MOD(jin-1,KLON_IN(ilats(jj)))
      j2=MOD(jin  ,KLON_IN(ilats(jj)))
      j3=MOD(jin+1,KLON_IN(ilats(jj)))
      j4=MOD(jin+2,KLON_IN(ilats(jj)))
      zxi=(j2-1)*zdlonin
      zp0=(zout-zxi)/zdlonin
      zp1=zp0+1.0
      zm1=zp0-1.0
      zm2=zp0-2.0
      ztmp(jlon,jj)=-zp0*zm1*zm2*PFLD_IN(ind(ilats(jj))+j1)/6. &
       & +zp1*zm1*zm2*PFLD_IN(ind(ilats(jj))+j2)/2. &
       & -zp1*zp0*zm2*PFLD_IN(ind(ilats(jj))+j3)/2. &
       & +zp1*zp0*zm1*PFLD_IN(ind(ilats(jj))+j4)/6.  
    ENDDO
  ENDDO

! zi is x_i, zxi is (x-x_i)

  z1=PLAT_IN(ilats(1))
  z2=PLAT_IN(ilats(2))
  z3=PLAT_IN(ilats(3))
  z4=PLAT_IN(ilats(4))

  zx1=zlat-z1
  zx2=zlat-z2
  zx3=zlat-z3
  zx4=zlat-z4

  zd1=(z1-z2)*(z1-z3)*(z1-z4)
  zd2=(z2-z1)*(z2-z3)*(z2-z4)
  zd3=(z3-z1)*(z3-z2)*(z3-z4)
  zd4=(z4-z1)*(z4-z2)*(z4-z3)

  zz1=zx2*zx3*zx4/zd1
  zz2=zx1*zx3*zx4/zd2
  zz3=zx1*zx2*zx4/zd3
  zz4=zx1*zx2*zx3/zd4

  DO jlon=1,klon_out(jlat)
    ii=ii+1
    PFLD_OUT(ii)=zz1 * ztmp(jlon,1) &
     & + zz2 * ztmp(jlon,2) &
     & + zz3 * ztmp(jlon,3) &
     & + zz4 * ztmp(jlon,4)  
  ENDDO
ENDDO

IF (ALLOCATED(ZTMP)) DEALLOCATE(ZTMP)

! This check is too slow. Should be done only for
! fields which actually require it.

zminh=PFLD_IN(1)
zmaxh=PFLD_IN(1)
zavgh=PFLD_IN(1)
DO ii=2,KIN
  zz=PFLD_IN(ii)
  zminh=MIN(zz,zminh)
  zmaxh=MAX(zz,zmaxh)
  zavgh=zavgh+zz
ENDDO
zavgh=zavgh/ii

zminl=PFLD_OUT(1)
zmaxl=PFLD_OUT(1)
zavgl=PFLD_OUT(1)
DO ii=2,kout
  zz=PFLD_OUT(ii)
  zminl=MIN(zz,zminl)
  zmaxl=MAX(zz,zmaxl)
  zavgl=zavgl+zz
ENDDO
zavgl=zavgl/ii

IF (zminh>=0. .AND. zminl<=0.) THEN
  write(nulout,999)'IN =',zminh,zmaxh,zavgh
  write(nulout,999)'OUT=',zminl,zmaxl,zavgl

  DO ii=1,kout
    PFLD_OUT(ii)=MAX(PFLD_OUT(ii),zminh)
  ENDDO
ENDIF
CALL GSTATS(1944,1)

999 FORMAT('GREPTRAJ MIN,MAX,AVG ',A4,3(2X,ES11.4))

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