SUBROUTINE SUHIFCE(PLON0E,PDLONE,PLATE,KLATE,KLONE,&
 & PLONM,PLATM,KNPTS,KNDIM1,KNFLDS,PFER,PFLDM,LDNG,KMASK)  

!**** *SUHIFCE*  - ROUTINE FOR HORIZONTAL INTERPOLATION OF FORECAST
!****              ERRORS FROM THE ERROR GRID

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

!        TO PRODUCE FIELDS OF FORECAST ERRORS ON THE MODEL GRID.

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

!        *CALL* *SUHIFCE(PLON0E,PLATE,KLATE,KLONE,
!                        PLON0M,PLATM,KLATM,KLONM,PFER,PFLDM)

!        INPUT:
!           *PLON0E* - ARRAY CONTAINING LONGITUDE (RADIANS) OF THE FIRST
!                      POINT OF EACH ROW OF THE ERROR GRID
!           *PDLONE* - ARRAY CONTAINING LONGITUDINAL GRID SPACING (ASSUMED
!                      CONSTANT FOR EACH ROW)
!           *PLATE*  - ARRAY CONTAINING LATITUDES OF THE ERROR GRID
!           *KLATE*  - NUMBER OF LATITUDE ROWS ON THE ERROR GRID
!           *KLONE*  - ARRAY CONTAINING NUMBER OF LONGITUDE POINTS
!                      ALONG EACH LATITUDE ROW OF THE ERROR GRID
!           *PLONM*  - ARRAY CONTAINING LONGITUDES (RADIANS) OF THE
!                      INTERPOLATION POINTS
!           *PLATM*  - ARRAY CONTAINING LATITUDES (RADIANS) OF THE
!                      INTERPOLATION POINTS
!           *KNPTS*  - NUMBER OF INTERPOLATION POINTS
!           *KNDIM1* - FIRST DIMENSION OF PFER
!           *KNFLDS* - NUMBER OF FIELDS
!           *PFER*   - ARRAY OF FORECAST ERRORS ON THE ERROR GRID
!           *LDNG*   - OPTIONAL SWITCH FOR NEAREST GP INSTEAD OF INTERPOLATION
!           *KMASK*  - OPTIONAL MASK FOR INTERPOLATION TO BE DONE (1) OR NOT DONE(0)
!        OUTPUT:
!           *PFLDM*  - ARRAY OF INTERPOLATED VALUES

!     METHOD.
!     -------
!        Bilinear interpolation from the four nearest points.

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

!     REFERENCE.
!     ----------

!        NONE.

!     AUTHOR.
!     -------

!        M. Fisher  *ECMWF* 07:11:95

!     MODIFICATIONS.
!     --------------
!        M. Fisher 96/04/17: Ungridded interpolation points
!        M. Fisher 00/10/26: Added PDLONE to allow non-global grids
!        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)    :: KLATE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNPTS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNDIM1 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNFLDS 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLON0E(KLATE) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDLONE(KLATE) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLATE(KLATE) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLONE(KLATE) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLONM(KNPTS) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLATM(KNPTS) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFER(KNDIM1,KNFLDS) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLDM(KNPTS,KNFLDS) 
INTEGER(KIND=JPIM), ALLOCATABLE :: INDER(:,:)
LOGICAL, OPTIONAL, INTENT(IN)    :: LDNG
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN)    :: KMASK(KNPTS)
INTEGER(KIND=JPIM) :: I, ILATE, ILATN, ILATS, ILONE, ILONNE, ILONNW,&
 & ILONSE, ILONSW, IPT  
LOGICAL :: LLNG
REAL(KIND=JPRB) :: ZDLAT, ZDLONN, ZDLONS, ZLATM, ZLONMN, ZLONMS, ZLONNW, ZLONSW
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER(KIND=JPIM) :: IMASK(KNPTS)
#include "abor1.intfb.h"

IF (LHOOK) CALL DR_HOOK('SUHIFCE',0,ZHOOK_HANDLE)
IMASK(:)=1
IF (PRESENT(KMASK)) IMASK=KMASK
ALLOCATE (INDER(MAXVAL(KLONE(1:KLATE)),KLATE))
IF (PLATE(KLATE) > PLATE(1)) THEN
  WRITE (NULOUT,*)'SUHIFCE EXPECTS LATITUDE ROWS IN DECREASING ORDER'
  CALL ABOR1 ('SUHIFCE: LATITUDE ROWS NOT IN DECREASING ORDER')
ENDIF

!--- GENERATE A MAP FROM 2D GRIDPOINT INDEXING TO 1D ARRAY INDEXING

I=0
DO ILATE=1,KLATE
  DO ILONE=1,KLONE(ILATE)
    I=I+1
    INDER(ILONE,ILATE) = I
  ENDDO
ENDDO

!--- FOR EACH INTERPOLATION POINT, FIND NEAREST ROWS OF THE ERROR GRID

DO IPT=1,KNPTS
  IF (IMASK(IPT) == 0) CYCLE
  ZLATM = PLATM(IPT)
  IF (ZLATM <= PLATE(KLATE)) THEN
    ILATS = KLATE
    ILATN = KLATE
  ELSE
    ILATS = 1
    DO WHILE (ZLATM < PLATE(ILATS))
      ILATS = ILATS+1
    ENDDO
    ILATN = MAX(1,ILATS-1)
  ENDIF

  IF (ILATN == ILATS) THEN
    ZDLAT = 0._JPRB
  ELSE
    ZDLAT = (ZLATM-PLATE(ILATN))/(PLATE(ILATS)-PLATE(ILATN))
  ENDIF

!--- FIND THE NEAREST POINTS IN BOTH ROWS

  ZLONMS = PLONM(IPT)
  DO WHILE (ZLONMS < PLON0E(ILATS))
    ZLONMS=ZLONMS+2.0_JPRB*RPI
  ENDDO

  ZLONMN = PLONM(IPT)
  DO WHILE (ZLONMN < PLON0E(ILATN))
    ZLONMN=ZLONMN+2.0_JPRB*RPI
  ENDDO

  ILONSW = 1 + INT( (ZLONMS-PLON0E(ILATS))/PDLONE(ILATS) )
  ILONNW = 1 + INT( (ZLONMN-PLON0E(ILATN))/PDLONE(ILATN) )

  IF (ILONSW > KLONE(ILATS)) THEN
    WRITE (NULOUT,*) 'SUHIFCE: ILONSW=',ILONSW,' KLONE=',KLONE(ILATS), &
     & ' ZLONMS=',ZLONMS,' PLON0E=',PLON0E(ILATS), &
     & ' PDLONE=',PDLONE(ILATS),' PLONM=',PLONM(IPT)  
    CALL ABOR1 ('SUHIFCE: ILONSW > KLONE(ILATS)')
  ENDIF

  IF (ILONNW > KLONE(ILATN)) THEN
    WRITE (NULOUT,*) 'SUHIFCE: ILONNW=',ILONNW,' KLONE=',KLONE(ILATN), &
     & ' ZLONMN=',ZLONMN,' PLON0E=',PLON0E(ILATN), &
     & ' PDLONE=',PDLONE(ILATN),' PLONM=',PLONM(IPT)  
    CALL ABOR1 ('SUHIFCE: ILONNW > KLONE(ILATN)')
  ENDIF

  ILONSE = 1 + MOD( ILONSW , KLONE(ILATS) )
  ILONNE = 1 + MOD( ILONNW , KLONE(ILATN) )

  ZLONSW = PLON0E(ILATS)+ PDLONE(ILATS)*REAL(ILONSW-1,JPRB)
  ZLONNW = PLON0E(ILATN)+ PDLONE(ILATN)*REAL(ILONNW-1,JPRB)
  ZDLONS = (ZLONMS-ZLONSW)/PDLONE(ILATS)
  ZDLONN = (ZLONMN-ZLONNW)/PDLONE(ILATN)
  LLNG=.FALSE.
  IF (PRESENT(LDNG) ) LLNG=LDNG
  IF (LLNG) THEN
    if (zdlat < 0.5_JPRB) then
      zdlat=0._JPRB
      if (zdlonn < 0.5_JPRB) then
        zdlonn=0._JPRB
      else
        zdlonn=1._JPRB
      endif
    else
      zdlat=1._JPRB
      if (zdlons < 0.5_JPRB) then
        zdlons=0._JPRB
      else
        zdlons=1._JPRB
      endif
    endif
  ENDIF
!--- INTERPOLATE

  PFLDM(IPT,:) = ZDLAT*(&
   & ZDLONS*PFER(INDER(ILONSE,ILATS),:)&
   & +(1.0_JPRB-ZDLONS)*PFER(INDER(ILONSW,ILATS),:))&
   & + (1.0_JPRB-ZDLAT)*(&
   & ZDLONN*PFER(INDER(ILONNE,ILATN),:)&
   & +(1.0_JPRB-ZDLONN)*PFER(INDER(ILONNW,ILATN),:))  

ENDDO

DEALLOCATE (INDER)
IF (LHOOK) CALL DR_HOOK('SUHIFCE',1,ZHOOK_HANDLE)
END SUBROUTINE SUHIFCE
