C Copyright 1981-2007 ECMWF
C 
C Licensed under the GNU Lesser General Public License which
C incorporates the terms and conditions of version 3 of the GNU
C General Public License.
C See LICENSE and gpl-3.0.txt for details.
C

      INTEGER FUNCTION IAINTGG (KIFELD, KILEN, PWEST, PEAST, PNORTH,
     1   PSOUTH, KGAUSS, KOFELD, KOLEN, KOBITS, KPR, KERR)
C
C---->
C**** *IAINTGG*
C
C     PURPOSE
C     _______
C
C     The controlling routine for interpolating between a GRIB input
C     field and a Gaussian output field.
C
C     INTERFACE
C     _________
C
C     IERR = IAINTGG (KIFELD, KILEN, PWEST, PEAST, PNORTH, PSOUTH,
C    1   KGAUSS, KOFELD, KOLEN, KOBITS, KPR, KERR)
C
C     Input parameters
C     ________________
C
C     KIFELD     - The input field provided by the calling routine.
C
C     KILEN      - The length of the input field.
C
C     PWEST      - The Western limit of the output field area.
C
C     PEAST      - The Eastern limit of the output field area.
C
C     PNORTH     - The Northern limit of the output field area.
C
C     PSOUTH     - The Southern limit of the output field area.
C
C     KGAUSS     - The Gaussian truncation for the output field.
C
C     KOLEN      - The length of the output field.
C
C     KOBITS     - The number of bits used for packing the output array.
C
C     KPR        - The debug print switch.
C                  0  , No debugging output.
C                  1  , Produce debugging output.
C
C     KERR       - The error control flag.
C                  -ve, No error message. Return error code.
C                  0  , Hard failure with error message.
C                  +ve, Print error message. Return error code.
C
C     Output parameters
C     ________________
C
C     KOFELD     - The output field returned to the calling routine.
C
C     KOLEN      - The amount of the output array used for the packed
C                  GRIB field.
C
C     Return value
C     ____________
C
C     The error indicator (INTEGER).
C
C     Error and Warning Return Values
C     _______________________________
C
C     21501 The number of bits requested was outside the allowed
C           range 0 to 24.
C     21502 The input data representation was not valid when the GRIB
C           field had been expanded.
C
C     Common block usage
C     __________________
C
C     grfixed.h    - The include file contains all the array space
C                    for grid to grid interpolation.
C
C     MILLEN       - The array of latitude line lengths for a quasi
C                    regular input field is used.
C     RIGAUSS      - Real array of input field Gaussian latitudes is
C                    used.
C     ROGAUSS      - Real array of output field Gaussian latitudes is
C                    used.
C
C     ouspace.h    - This file contains the work space array
C                    definitions for the arrays to hold the unpacked
C                    real data from GRIB fields.
C
C     RIFELD       - The expanded input field is set and used.
C     ROFELD       - The expanded output field is set and used.
C
C     nifld.common - This file contains all the input field
C                    definition variables.
C
C     LCHANGE      - Process change flag is set.
C
C     NIAREA       - Input field area definition (N/W/S/E) is set.
C     NIGAUSS      - Input field Gaussian truncation is used.
C     NIGRID       - Input field grid definition (WE/NS) is used.
C     NINS         - Number of grid points in NS direction for input
C                    field is used.
C     NIREPR       - Input field representation is used.
C     NIWE         - Number of grid points in WE direction for input
C                    field is used.
C
C     nofld.common - This file contains all the output field
C                    definition variables.
C
C     NOACC        - Number of packing bits to be used for output
C                    GRIB field is set.
C     NOAREA       - Output field area definition (N/W/S/E) is set.
C     NOGAUSS      - Output field Gaussian truncation is set.
C     NONS         - Number of grid points in NS direction for output
C                    field is set and used.
C     NOWE         - Number of grid points in WE direction for output
C                    field is set and used.
C
C     EXTERNALS
C     _________
C
C     ABORTX     - Standard routine to kill task.
C     GRIBEX     - Standard routine to unpack or pack a GRIB field.
C     IAGCNTL    - Perform regular grid to grid point interpolation.
C     IARCNTL    - Perform regular grid to grid point interpolation.
C     IAIDEF     - Initialise the input field definition variables
C                  from a GRIB definition
C     IAOGDEF    - Initialise the output field definition variables
C                  from the user supplied values.
C     IARESET    - Create the output field definition in GRIB format.
C     IARMEM     - Get space for the unpacked input and output
C                  fields.
C     IGLSIZE    - Evaluate the array sizes for a regular
C                  latitude/longitude grid and area.
C     IGSIZE     - Evaluate the array sizes for a Gaussian truncation
C                  and area.
C     IRSIZE     - Evaluate the array sizes for a quasi regular
C                  Gaussian field.
C     INTLOG     - Logs messages.
C
C     METHOD
C     ______
C
C     This is purely a controlling routine with all the work being
C     performed in the external routines.
C
C     REFERENCE
C     _________
C
C     None
C
C     COMMENTS
C     ________
C
C     Program contains sections 0 to 7 and 9
C
C     AUTHOR
C     ______
C
C     K. Fielding      *ECMWF*      Apr 1994
C
C     MODIFICATIONS
C     _____________
C
C     None
C
C----<
C     _______________________________________________________
C
C
C*    Section 0. Definition of variables.
C     _______________________________________________________
C
C*    Prefix conventions for variable names
C
C     Logical      L (but not LP), global or common.
C                  O, dummy argument
C                  G, local variable
C                  LP, parameter.
C     Character    C, global or common.
C                  H, dummy argument
C                  Y (but not YP), local variable
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy argument
C                  I, local variable
C                  J (but not JP), loop control
C                  JP, parameter.
C     REAL         A to F and Q to X, global or common.
C                  P (but not PP), dummy argument
C                  Z, local variable
C                  PP, parameter.
C
C     Implicit statement to force declarations
C
      IMPLICIT NONE
C
#include "parim.h"
#include "nifld.common"
#include "nofld.common"
#include "grfixed.h"
#include "ouspace.h"
C
C     Function arguments
C
      INTEGER KGAUSS, KILEN, KOLEN, KOBITS, KPR, KERR
      REAL PWEST, PEAST, PNORTH, PSOUTH
      INTEGER KIFELD (*), KOFELD (*)
C
C     Local variables
C
      CHARACTER*1 HFUNC
      LOGICAL GIWEGLOBE, GINPOLE, GISPOLE, GOWEGLOBE, GONPOLE,
     1   GOSPOLE, GICHNG, GOCHNG
      INTEGER IILN, ITOTAL, IOLN
      INTEGER IIAREA (4), IOAREA (4)
      INTEGER JLAT, JSET
      INTEGER IERR
      INTEGER ISEC0 (JPGRIB_ISEC0), ISEC1 (JPGRIB_ISEC1)
      INTEGER ISEC2 (JPGRIB_ISEC2), ISEC3 (JPGRIB_ISEC3)
      INTEGER ISEC4 (JPGRIB_ISEC4)
      INTEGER ZSEC2 (JPGRIB_RSEC2), ZSEC3 (JPGRIB_RSEC3)
      INTEGER JPROUTINE
      PARAMETER (JPROUTINE = 21500)
C
C     External functions
C
      INTEGER IAGCNTL, IARCNTL, IAIDEF, IAOGDEF, IARESET, IARMEM,
     1   IGLSIZE, IGSIZE, IRSIZE
C
C     Transform definition variables that must be preserved
C
      SAVE IILN, IIAREA, IOLN, IOAREA, ITOTAL
      SAVE GIWEGLOBE, GINPOLE, GISPOLE, GOWEGLOBE, GONPOLE,
     1   GOSPOLE
C
C     _______________________________________________________
C
C*    Section 1. Initialisation
C     _______________________________________________________
C
  100 CONTINUE
C
      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IAINTGG: Section 1.',JPQUIET)
C
      IAINTGG = 0
C
      IERR = 0
C
      IF (KPR .GE. 1) THEN
         CALL INTLOG(JP_DEBUG,'IAINTGG: Input parameters',JPQUIET)
         CALL INTLOG(JP_DEBUG,'IAINTGG: Input array length = ',KILEN)
         CALL INTLOG(JP_DEBUG,'IAINTGG: Output array length = ',KOLEN)
         CALL INTLOG(JP_DEBUG,'IAINTGG: Gaussian truncation = ',KGAUSS)
         CALL INTLOG(JP_DEBUG,'IAINTGG: Out field packing bits=',KOBITS)
         CALL INTLOGR(JP_DEBUG,'IAINTGG: Area North = ',PNORTH)
         CALL INTLOGR(JP_DEBUG,'IAINTGG: Area West = ',PWEST)
         CALL INTLOGR(JP_DEBUG,'IAINTGG: Area South = ',PSOUTH)
         CALL INTLOGR(JP_DEBUG,'IAINTGG: Area East = ',PEAST)
      ENDIF
C
      IF (KOBITS .LT. 0 .OR. KOBITS .GT. 24) THEN
        IAINTGG = JPROUTINE + 1
        IF (KERR .GE. 0) THEN
          CALL INTLOG(JP_ERROR,
     X      'IAINTGG: No. bits requested = ',KOBITS)
          CALL INTLOG(JP_ERROR,
     X      'IAINTGG: Range allowed is <0 - 24>',JPQUIET)
          IF (KERR .EQ. 0) CALL INTLOG(JP_FATAL,
     X      'IAINTGG: Interpolation failing.',JPQUIET)
        ENDIF
        GO TO 900
      ENDIF
C
      NOACC = KOBITS
C
C     _______________________________________________________
C
C
C*    Section 2. Input grid definition from GRIB file
C     _______________________________________________________
C
  200 CONTINUE
C
      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IAINTGG: Section 2.',JPQUIET)
C
C     Unpack GRIB sections 0, 1 and 2 only
C
      IERR = KERR
C
C     CALL GRSDBG (KPR)
C
      CALL GRIBEX (ISEC0, ISEC1, ISEC2, ZSEC2, ISEC3, ZSEC3, ISEC4,
     X   RIFELD, 1, KIFELD, KILEN, KOLEN, 'I', IERR)
C
      IF (IERR .NE. 0) THEN
        IAINTGG = IERR
        GO TO 900
      ENDIF
C
      IERR = IAIDEF (ISEC1, ISEC2, IIAREA, MILLEN, GICHNG, KPR, KERR)
C
      IF (IERR .GT. 0) THEN
        IAINTGG = IERR
        GO TO 900
      ENDIF
C
      IF (GICHNG) THEN
C
        DO 210 JSET = 1, 4
          NIAREA (JSET) = IIAREA (JSET)
  210   CONTINUE
C
        IF (NIREPR .EQ. JPGAUSSIAN) THEN
C
          IERR = IGSIZE (NIGAUSS, NIAREA, NIWE, NINS, IILN, RIGAUSS,
     1         GIWEGLOBE, GINPOLE, GISPOLE, KPR, KERR)
C
          IF (IERR .GT. 0) THEN
            IAINTGG = IERR
            GO TO 900
          ENDIF
C
          ITOTAL = NIWE * NINS
C
        ELSE IF (NIREPR .EQ. JPQUASI) THEN
C
          IERR = IRSIZE (NIGAUSS, NIAREA, MILLEN, NIWE, NINS, IILN,
     1         ITOTAL, RIGAUSS, GIWEGLOBE, GINPOLE, GISPOLE, KPR, KERR)
C
          IF (IERR .GT. 0) THEN
            IAINTGG = IERR
            GO TO 900
          ENDIF
C
        ELSE IF (NIREPR .EQ. JPREGULAR) THEN
C
          IERR = IGLSIZE (NIGRID, NIAREA, NIWE, NINS, IILN, GIWEGLOBE,
     X         GINPOLE, GISPOLE, KPR, KERR)
C
          IF (IERR .GT. 0) THEN
            IAINTGG = IERR
            GO TO 900
          ENDIF
C
          ITOTAL = NIWE * NINS
C
        ELSE
C
          IAINTGG = JPROUTINE + 2
          IF (KERR .GE. 0) CALL INTLOG(JP_ERROR,
     X      'IAINTGG: Invalid input representation = ',NIREPR)
          IF (KERR .EQ. 0) CALL INTLOG(JP_FATAL,
     X      'IAINTGG: Interpolation failing.',JPQUIET)
          GO TO 900
C
        ENDIF
      ELSE
        IF (NIREPR .NE. JPQUASI) THEN
          ITOTAL = NIWE * NINS
        ELSE
          ITOTAL = 0
          DO 220 JLAT = 1, NINS
            ITOTAL = ITOTAL + MILLEN (JLAT)
  220     CONTINUE
        ENDIF
      ENDIF
C
      LCHANGE = LCHANGE .OR. GICHNG
C
C     _______________________________________________________
C
C*    Section 3. Output field definiton from parameters
C     _______________________________________________________
C
  300 CONTINUE
C
      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IAINTGG: Section 3.',JPQUIET)
C
      IERR = IAOGDEF (PWEST, PEAST, PNORTH, PSOUTH, KGAUSS, IOAREA,
     1   GOCHNG, GIWEGLOBE, GINPOLE, GISPOLE, NIAREA, KPR, KERR)
C
      IF (IERR .GT. 0) THEN
        IAINTGG = IERR
        GO TO 900
      ENDIF
C
      IF (GOCHNG) THEN
C
        DO 310 JSET = 1, 4
          NOAREA (JSET) = IOAREA (JSET)
  310   CONTINUE
C
        NOWE = 0
        NONS = 0
C
        IERR = IGSIZE (NOGAUSS, NOAREA, NOWE, NONS, IOLN, ROGAUSS,
     1      GOWEGLOBE, GONPOLE, GOSPOLE, KPR, KERR)
C
        IF (IERR .GT. 0) THEN
          IAINTGG = IERR
          GO TO 900
        ENDIF
      ENDIF
C
      LCHANGE = LCHANGE .OR. GOCHNG
C
C     _______________________________________________________
C
C*    Section 4. Get space for REAL input and output arrays
C     _______________________________________________________
C
  400 CONTINUE
C
      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IAINTGG: Section 4.',JPQUIET)
C
      IF (LCHANGE) THEN
C
        IERR = IARMEM (ITOTAL, NOWE * NONS, KPR, KERR)
C
        IF (IERR .GT. 0) THEN
          IAINTGG = IERR
          GO TO 900
        ENDIF
      ENDIF
C
C     _______________________________________________________
C
C*    Section 5. Fully unpack the GRIB array
C     _______________________________________________________
C
  500 CONTINUE
C
      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IAINTGG: Section 5.',JPQUIET)
C
      IERR = KERR
C
C     CALL GRSDBG (KPR)
C
      ISEC3(2) = NINT(RMISSGV)
      ZSEC3(2) = RMISSGV
      CALL GRIBEX (ISEC0, ISEC1, ISEC2, ZSEC2, ISEC3, ZSEC3, ISEC4,
     X   RIFELD, ITOTAL, KIFELD, KILEN, KOLEN, 'D', IERR)
C
      IF (IERR .NE. 0) THEN
        IAINTGG = IERR
        GO TO 900
      ENDIF
C
C     _______________________________________________________
C
C*    Section 6. Basic interpolation from input to output field
C     _______________________________________________________
C
  600 CONTINUE
C
      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IAINTGG: Section 6.',JPQUIET)
C
      IF (NIREPR .EQ. JPQUASI) THEN
        IERR = IARCNTL (RIFELD, ITOTAL, ROFELD, NOWE * NONS, IILN,
     X      GIWEGLOBE, GINPOLE, GISPOLE, IOLN, GOWEGLOBE, GONPOLE,
     X      GOSPOLE, KPR, KERR)
      ELSE
        IERR = IAGCNTL (RIFELD, ITOTAL, ROFELD, NOWE * NONS, IILN,
     X      GIWEGLOBE, GINPOLE, GISPOLE, IOLN, GOWEGLOBE, GONPOLE,
     X      GOSPOLE, KPR, KERR)
      ENDIF
C
      IF (IERR .NE. 0) THEN
        IAINTGG = IERR
        GO TO 900
      ENDIF
C
C     _______________________________________________________
C
C
C*    Section 7. Repack GRIB code
C     _______________________________________________________
C
  700 CONTINUE
C
      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IAINTGG: Section 7.',JPQUIET)
C
      IERR = IARESET (ISEC2, ISEC4, NOWE * NONS, KPR, KERR)
C
      IF (IERR .NE. 0) THEN
        IAINTGG = IERR
        GO TO 900
      ENDIF
C
      IERR = KERR
C
C     CALL GRSDBG (KPR)
C
C     PACKING specified can be second-order, simple or archive value
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
        HFUNC = 'C'
        ISEC4(4)  = 0
        ISEC4(6)  = 0
      ELSE IF( NOHFUNC.EQ.'A' ) THEN
        IF( ISEC4(4).EQ.64 ) THEN
          HFUNC = 'K'
        ELSE
          HFUNC = 'C'
        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   ROFELD, NOWE * NONS, KOFELD, KOLEN, KOLEN, HFUNC, IERR)
C
      IF (IERR .NE. 0) THEN
        IAINTGG = IERR
        GO TO 900
      ENDIF
C
      IF (KPR .GE. 1) CALL INTLOG(JP_DEBUG,
     X  'IAINTGG: Output field length is ',KOLEN)
C
C     _______________________________________________________
C
C*    Section 9. Return to calling routine. Format statements
C     _______________________________________________________
C
  900 CONTINUE
C
      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IAINTGG: Section 9.',JPQUIET)
C
      RETURN
      END