C Copyright 1981-2012 ECMWF.
C
C This software is licensed under the terms of the Apache Licence 
C Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
C
C In applying this licence, ECMWF does not waive the privileges and immunities 
C granted to it by virtue of its status as an intergovernmental organisation 
C nor does it submit to any jurisdiction.
C

      INTEGER FUNCTION INTFBP( INGRIB,INLEN,OUTGRIB,OUTLEN)
C
C---->
C**** INTFBP
C
C     Purpose
C     -------
C
C     Interpolate input field...
C
C
C     Interface
C     ---------
C
C     IRET = INTFBP( INGRIB,INLEN,OUTGRIB,OUTLEN)
C
C     Input
C     -----
C
C     INGRIB - Input field (packed).
C     INLEN  - Input field length (words).
C
C
C     Output
C     ------
C
C     OUTGRIB - Output field (packed).
C     OUTLEN  - Output field length (words).
C
C
C     Method
C     ------
C
C     Call interpolation routines; then repack if GRIB output.
C
C     Currently, subareas are not supported for reduced gaussian fields.
C     (Works OK; but need to setup values in GRIB product for number of
C      points in each latitude row)
C
C
C     Externals
C     ---------
C
C     IARCNTL - Control interp. quasi reg.Gauss -> Gaussian or lat/long
C     IAGCNTL - Control interpolation reg.Gaussian or lat/long fields.
C     JSH2SH  - Changes resolution of a field of spectral coefficients.
C     JALLGP  - Converts spectral input fields to lat/long grid fields.
C     JALLWN  - Converts spectral input wind fields to lat/long grids.
C     JAGGGP  - Converts spectral input fields to a gaussian grid field.
C     IBASINI - Ensure basic interpolation setup is done.
C     GRIBEX  - Decode/encode GRIB product.
C     GRSVCK  - Turn off GRIB checking
C     RESET_C - Reset interpolation handling options using GRIB product.
C     IGSETUP - Setup GRIB sections for the output product.
C     JMEMHAN - Handles memory allocation.
C     IGLSIZE - Evaluate array sizes for reg. lat/long and area.
C     IGSIZE  - Evaluate array sizes for a regular Gaussian.
C     IRSIZE  - Evaluate array sizes for a quasi reg Gaussian.
C     FIXAREA - Fixup area definition to correspond to grid definitions
C     ISCRSZ  - Calculate number of values in generated field.
C     INTLOG  - Log error message.
C
C
C     Author
C     ------
C
C     J.D.Chambers     ECMWF     Aug 1994
C
C     J.D.Chambers     ECMWF        Feb 1997
C     Allow for 64-bit pointers
C
C----<
C
      IMPLICIT NONE
C
C     Function arguments
      INTEGER INGRIB(*),OUTGRIB(*),INLEN,OUTLEN
C
#include "parim.h"
#include "nifld.common"
#include "nofld.common"
#include "grfixed.h"
#include "intf.h"
C
C     Parameters
      INTEGER JPROUTINE
      PARAMETER (JPROUTINE = 26500 )
C
C     Local variables
C
      CHARACTER*1 HFUNC
      INTEGER IWORD, IERR, ILENF, ISIZE, IUV
      REAL PNORTH, PSOUTH, PWEST, PEAST, PLATINC, PLONINC
      LOGICAL OIWEGLOBE, OINPOLE, OISPOLE
      LOGICAL OOWEGLOBE, OONPOLE, OOSPOLE
      INTEGER KILN, KITOTAL, KOLN, KOTOTAL, KPR, KERR
#ifndef _CRAYFTN
#ifdef POINTER_64
      INTEGER*8 IZNFLDO
#endif
#endif
      REAL ZNFLDO
      POINTER ( IZNFLDO, ZNFLDO )
      DIMENSION ZNFLDO( 1 )
C
C     Externals
C
      INTEGER IGLSIZE, IGSIZE, IRSIZE, IARCNTL, IAGCNTL
      INTEGER IGSETUP, FIXAREA, ISCRSZ
C
C ------------------------------------------------------------------
C*    Section 1.   Initialise
C ------------------------------------------------------------------
C
  100 CONTINUE
      INTFBP = 0
      IERR = 0
      KPR = 0
C
C     Allocate work array ZNFELDI if not already done.
C
      IF( IZNJDCI.NE.1952999238 ) THEN
        CALL JMEMHAN( 19, IZNFLDI, JPEXPAND, 1, IERR)
        IF( IERR.NE.0 ) THEN
          CALL INTLOG(JP_WARN,'INTFBP: ZNFELDI allocation fail',JPQUIET)
          INTFBP = IERR
          GOTO 900
        ENDIF
        IZNJDCI = 1952999238
      ENDIF
C
C ------------------------------------------------------------------
C*    Section 3.   Interpolation spherical harmonics to spherical
C                  harmonics
C ------------------------------------------------------------------
C
  300 CONTINUE
C
      IF ( ((NIREPR.EQ.JPSPHERE).OR.(NIREPR.EQ.JPSPHROT)) .AND.
     X     ((NOREPR.EQ.JPSPHERE).OR.(NOREPR.EQ.JPSPHROT)) ) THEN
C
C       Get scratch space for interpolation
        ISIZE = ISCRSZ()
        IF ( ISIZE .LE. 0 ) THEN
          CALL INTLOG(JP_ERROR,'INTFBP: Get scratch space failed',ISIZE)
          INTFBP = JPROUTINE + 2
          GOTO 900
        ENDIF
        CALL JMEMHAN( 3, IZNFLDO, ISIZE, 1, IERR)
        IF ( IERR .NE. 0 ) THEN
          CALL INTLOG(JP_ERROR,'INTFBP: Get scratch space fail',JPQUIET)
          INTFBP = JPROUTINE + 2
          GOTO 900
        ENDIF
C
        CALL SH2SH( ZNFELDI, NIRESO, ZNFLDO, NORESO )
C
        GOTO 700
C
C     If not spectral -> spectral transformation, make sure the input
C     and output area definitions have been setup.
C
      ELSE
C
C       Fixup area definition to correspond to grid definitions
        IERR = FIXAREA()
        IF ( IERR .NE. 0 ) THEN
          CALL INTLOG(JP_ERROR,
     X      'INTFBP: Fixup area definition failed.',JPQUIET)
          INTFBP = JPROUTINE + 9
          GOTO 900
        ENDIF
C
C       Setup geographical limits
        PNORTH = FLOAT( NOAREA(1) ) / PPMULT
        PWEST  = FLOAT( NOAREA(2) ) / PPMULT
        PSOUTH = FLOAT( NOAREA(3) ) / PPMULT
        PEAST  = FLOAT( NOAREA(4) ) / PPMULT
C
      ENDIF
C
C ------------------------------------------------------------------
C     Section 4.   Interpolation spherical harmonics to grid point.
C ------------------------------------------------------------------
C
  400 CONTINUE
C
      IF ( (NIREPR.EQ.JPSPHERE).OR.(NIREPR.EQ.JPSPHROT) ) THEN
C
C       Get scratch space for interpolation
C
        ISIZE = ISCRSZ()
        IF ( ISIZE .LE. 0 ) THEN
          CALL INTLOG(JP_ERROR,'INTFBP: Get scratch space failed',ISIZE)
          INTFBP = JPROUTINE + 2
          GOTO 900
        ENDIF
C
        CALL JMEMHAN( 3, IZNFLDO, ISIZE, 1, IERR)
        IF ( IERR .NE. 0 ) THEN
          CALL INTLOG(JP_ERROR,'INTFBP: Get scratch space fail',JPQUIET)
          INTFBP = JPROUTINE + 2
          GOTO 900
        ENDIF
C
C       Setup wind flag
C
        IF( .NOT.LWINDSET ) THEN
          LWIND = ( ( NOTABLE.EQ.128 ).AND.
     X            ((NOPARAM.EQ.131).OR.(NOPARAM.EQ.132)) )
        ENDIF
        CALL INTLOG(JP_DEBUG,'INTFBP: Wind flag = ', LWIND)
        IF ( LWIND ) THEN
          IUV = 1
        ELSE
          IUV = 0
        ENDIF
C
C ------------------------------------------------------------------
C*    Section 4.1  Interpolation spherical harmonics to grid point.
C ------------------------------------------------------------------
C
  410 CONTINUE
C
        IF ( (NOREPR.EQ.JPREGULAR).OR.(NOREPR.EQ.JPREGROT) ) THEN
C
C         -> latitude/longitude grid
C
          PLONINC = FLOAT( NOGRID(1) ) / PPMULT
          PLATINC = FLOAT( NOGRID(2) ) / PPMULT
          IF ( LWIND ) THEN
            CALL JALLWN( ZNFELDI, NIRESO, PNORTH, PSOUTH, PWEST, PEAST,
     X                   PLATINC, PLONINC, ZNFLDO, IERR)
          ELSE
            CALL JALLGP( ZNFELDI, NIRESO, PNORTH, PSOUTH, PWEST, PEAST,
     X                   PLATINC, PLONINC, ZNFLDO, IERR)
          ENDIF
          IF ( IERR .NE. 0 ) THEN
            CALL INTLOG(JP_ERROR,
     X        'INTFBP: Interpolation of gaussian field failed.',JPQUIET)
            INTFBP = JPROUTINE + 3
            GOTO 900
          ENDIF
C
          GOTO 700
C
        ENDIF
C
C
        IF ( NOREPR .EQ. JPGAUSSIAN) THEN
C
C         -> regular gaussian grid
C
          CALL JAGGGP( ZNFELDI, NIRESO, PNORTH, PSOUTH, PWEST, PEAST,
     X                 NOGAUSS, 'U', NOLPTS, ZNFLDO, IUV, IERR)
          IF ( IERR .NE. 0 ) THEN
            CALL INTLOG(JP_ERROR,
     X        'INTFBP: Interpolation of gaussian field failed.',JPQUIET)
            INTFBP = JPROUTINE + 4
            GOTO 900
          ENDIF
C
          GOTO 700
C
        ENDIF
C
C
        IF ( NOREPR .EQ. JPQUASI) THEN
C
C         -> reduced gaussian grid
          CALL JAGGGP( ZNFELDI, NIRESO, PNORTH, PSOUTH, PWEST, PEAST,
     X                 NOGAUSS, 'U', NOLPTS, ZNFLDO, IUV, IERR)
          IF ( IERR .NE. 0 ) THEN
            CALL INTLOG(JP_ERROR,
     X        'INTFBP: Interpolation of gaussian field failed.',JPQUIET)
            INTFBP = JPROUTINE + 4
            GOTO 900
          ENDIF
C
          GOTO 700
C
        ENDIF
C
C       Dropthrough => unrecognized output field type
        IERR   = JPROUTINE + 1
        CALL INTLOG(JP_ERROR,
     X    'INTFBP: Unrecognized output field type.',NOREPR)
        INTFBP = IERR
        GOTO 900
C
      ENDIF
C
C ------------------------------------------------------------------
C     Section 5.   Interpolate Gaussian grid to grid point.
C ------------------------------------------------------------------
C
  500 CONTINUE
C
C     Setup flags for input and output fields
      KERR = 1
      IF (NIREPR .EQ. JPQUASI) THEN
        IERR = IRSIZE( NIGAUSS, NIAREA, MILLEN, NIWE, NINS, KILN,
     X                 KITOTAL, RIGAUSS, OIWEGLOBE, OINPOLE, OISPOLE,
     X                 KPR, KERR)
      ELSE IF ( NIREPR .EQ. JPGAUSSIAN ) THEN
          IERR = IGSIZE( NIGAUSS, NIAREA, NIWE, NINS, KILN, RIGAUSS,
     X                    OIWEGLOBE, OINPOLE, OISPOLE, KPR, KERR)
      ELSE
        IERR = IGLSIZE( NIGRID, NIAREA, NIWE, NINS, KILN, OIWEGLOBE,
     X                  OINPOLE, OISPOLE, KPR, KERR)
      ENDIF
C
      NONS = 0
      NOWE = 0
      IF (NOREPR .EQ. JPQUASI) THEN
        IERR = IRSIZE( NOGAUSS, NOAREA, NOLPTS, NOWE, NONS, KOLN,
     X                 KOTOTAL, ROGAUSS, OOWEGLOBE, OONPOLE, OOSPOLE,
     X                 KPR, KERR)
      ELSE IF ( NOREPR .EQ. JPGAUSSIAN ) THEN
          IERR = IGSIZE( NOGAUSS, NOAREA, NOWE, NONS, KOLN, ROGAUSS,
     X                    OOWEGLOBE, OONPOLE, OOSPOLE, KPR, KERR)
      ELSE
        IERR = IGLSIZE( NOGRID, NOAREA, NOWE, NONS, KOLN, OOWEGLOBE,
     X                  OONPOLE, OOSPOLE, KPR, KERR)
      ENDIF
C
      IF ( IERR .NE. 0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTFBP: Setup of gaussian field flags failed.',IERR)
        INTFBP = JPROUTINE + 6
        GOTO 900
      ENDIF
C
C
C ------------------------------------------------------------------
C     Section 5.1  Interpolate reduced Gaussian grid to grid point.
C ------------------------------------------------------------------
C
  510 CONTINUE
C
C
      ISIZE = ISCRSZ()
      IF ( ISIZE .LE. 0 ) THEN
        CALL INTLOG(JP_ERROR,'INTFBP: Get scratch space failed.',ISIZE)
        INTFBP = JPROUTINE + 2
        GOTO 900
      ENDIF
      CALL JMEMHAN( 3, IZNFLDO, ISIZE, 1, IERR)
      IF ( IERR .NE. 0 ) THEN
        CALL INTLOG(JP_ERROR,'INTFBP: Get scratch space fail.',JPQUIET)
        INTFBP = JPROUTINE + 2
        GOTO 900
      ENDIF
C
      IF (NIREPR .EQ. JPQUASI) THEN
        IERR = IARCNTL( ZNFELDI, JPEXPAND, ZNFLDO, ISIZE, KILN,
     X                  OIWEGLOBE, OINPOLE, OISPOLE, KOLN, OOWEGLOBE,
     X                  OONPOLE, OOSPOLE, KPR ,KERR)
        IF ( IERR .NE. 0 ) THEN
          CALL INTLOG(JP_ERROR,
     X      'INTFBP: Interpolation of gaussian field failed.',IERR)
          INTFBP = JPROUTINE + 7
          GOTO 900
        ENDIF
C
        GOTO 700
C
      ENDIF
C
C ------------------------------------------------------------------
C*    Section 6.   Interpolate regular grid point to grid point.
C ------------------------------------------------------------------
C
  600 CONTINUE
C
      IERR = IAGCNTL( ZNFELDI, JPEXPAND, ZNFLDO, ISIZE, KILN,
     X                OIWEGLOBE, OINPOLE, OISPOLE, KOLN, OOWEGLOBE,
     X                OONPOLE, OOSPOLE, KPR, KERR)
      IF ( IERR .NE. 0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTFBP: Interpolation of gaussian field failed.',IERR)
        INTFBP = JPROUTINE + 8
        GOTO 900
      ENDIF
C
C ------------------------------------------------------------------
C*    Section 7.   Pack field into GRIB if necessary.
C ------------------------------------------------------------------
C
  700 CONTINUE
C
C     Setup GRIB sections for the output product
      IERR = IGSETUP( ISEC1, ISEC2, ISEC4 )
      IF ( IERR .NE. 0 ) THEN
        CALL INTLOG(JP_ERROR,'INTFBP: Setup GRIB sections failed.',IERR)
        INTFBP = IERR
        GOTO 900
      ENDIF
C
C     Code data into GRIB
C
      ILENF = ISIZE
      IERR = 1
C
C     If grid-point output, setup for 2nd order packing if requested.
C
      IF( (NOREPR.NE.JPSPHERE) .AND. (NOREPR.NE.JPSPHROT) ) THEN
        HFUNC = 'C'
        IF( NOHFUNC.EQ.'K' ) THEN
          HFUNC = 'K'
          ISEC4(4)  = 64
          ISEC4(6)  = 16
          ISEC4(9)  = 32
          ISEC4(10) = 16
          ISEC4(12) = 8
          ISEC4(13) = 4
          ISEC4(14) = 0
          ISEC4(15) = -1
        ELSE IF( NOHFUNC.EQ.'S' ) THEN
          ISEC4(4)  = 0
          ISEC4(6)  = 0
        ENDIF
      ELSE
        HFUNC = 'C'
        IF( NOHFUNC.EQ.'C' ) THEN
          ISEC2(6) = 2
          ISEC4(4) = 64
        ELSE IF( NOHFUNC.EQ.'S' ) THEN
          ISEC2(6) = 1
          ISEC4(4) = 0
        ENDIF
      ENDIF
C
      IF( LIMISSV ) THEN
        ISEC1(5) = 192
        ISEC3(2) = NINT(RMISSGV)
        ZSEC3(2) = RMISSGV
      ENDIF
      CALL GRIBEX( ISEC0, ISEC1, ISEC2, ZSEC2, ISEC3, ZSEC3, ISEC4,
     X             ZNFLDO,ILENF,OUTGRIB,OUTLEN,IWORD,HFUNC,IERR)
      IF ( IERR .NE. 0 ) THEN
        CALL INTLOG(JP_ERROR,'INTFBP: GRIBEX encoding failed.',IERR)
        INTFBP = JPROUTINE + 5
        GOTO 900
      ENDIF
      OUTLEN = IWORD
C
C ------------------------------------------------------------------
C*    Section 9.   Closedown.
C ------------------------------------------------------------------
C
  900 CONTINUE
C
C     Clear change flags for next product processing
      LCHANGE = .FALSE.
      LSMCHNG = .FALSE.
C
      RETURN
      END
