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

      SUBROUTINE JINTLL( KIBUFF, KLENI, PWEST, PEAST, PNORTH, PSOUTH,
     X                   PLATINC, PLONINC, KOBUFF, KLENO, KBITS, KRET)
C
C---->
C**** JINTLL
C
C     PURPOSE
C     _______
C
C     This routine converts spectral input fields to standard
C     lat/long grid fields.
C
C     INTERFACE
C     _________
C
C     CALL JINTLL( KIBUFF, KLENI, PWEST, PEAST, PNORTH, PSOUTH,
C    X             PLATINC, PLONINC, KOBUFF, KLENO, KBITS, KRET)
C
C     Input parameters
C     ________________
C
C     KIBUFF  - Array containing input spherical harmonic field
C               in GRIB format.
C     KLENI   - Length in words of KIBUFF.
C     PWEST   - Required area, west longitude(degrees)
C     PEAST   - Required area, east longitude(degrees)
C     PNORTH  - Required area, north latitude(degrees)
C     PSOUTH  - Required area, south latitude(degrees)
C     PLATINC - Required latitude interval in degrees.
C     PLONINC - Required longitude interval in degrees.
C     KLENO   - Length in words of KOBUFF.
C     KBITS   - Number of bits to be used for packing values in KOBUFF.
C
C
C     Output parameters
C     ________________
C
C     KOBUFF  - Array containing output spherical harmonic field
C               in GRIB format.
C     KLENO   - Number of words of KOBUFF occupied by GRIB.
C     KRET    - Return status code
C               0 = OK
C
C
C     Common block usage
C     __________________
C
C     JDCNDGB
C
C
C     Method
C     ______
C
C     None.
C
C
C     Externals
C     _________
C
C     JDEBUG    - Checks environment variable to switch on/off debug
C     GRIBEX    - Decodes/encodes GRIB product
C     JALLGP    - Transform from spherical harmonics to regular lat/long
C                 grid.
C     JMEMHAN   - Handles memory allocation.
C     INTLOG   - Output log message
C     INTLOGR  - Output log message (with real value)
C
C
C     Reference
C     _________
C
C     None.
C
C
C     Comments
C     ________
C
C     If PWEST, PEAST, PNORTH, PSOUTH are all 0.0, then the area
C     defaults to global.
C
C     If KBITS, the number of bits to be used for packing values, is
C     0, the number of bits used in the input spectral field is used.
C
C
C     AUTHOR
C     ______
C
C     J.D.Chambers      *ECMWF*      Apr 1994
C
C     MODIFICATIONS
C     _____________
C
C     J.D.Chambers     ECMWF        Feb 1997
C     Allow for 64-bit pointers
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
      IMPLICIT NONE
#include "jparams.h"
#include "parim.h"
C
C     Parameters
      INTEGER JPROUTINE
      PARAMETER ( JPROUTINE = 30300 )
C     Arrays are dimensioned to accommodate spectral T639 data and
C     maximum resolution of (0.5 * 0.5) deg.
      INTEGER JPACK, JPMLAT, JPMLON
      PARAMETER (JPACK=420000)
      PARAMETER (JPMLAT=361)
      PARAMETER (JPMLON=720)
C
C     Subroutine arguments
      INTEGER KIBUFF, KLENI, KOBUFF, KLENO, KBITS, KRET
      DIMENSION KIBUFF(KLENI)
      DIMENSION KOBUFF(*)
      REAL PWEST, PEAST, PNORTH, PSOUTH, PLATINC, PLONINC
C
C     Local variables
      REAL NORTH, SOUTH, EAST, WEST
      INTEGER IPUNP, ITRUNC, NBITS
      INTEGER ISEC0, ISEC1, ISEC2, ISEC3, ISEC4
      REAL ZSEC2, ZSEC3, ZSEC4
#ifndef _CRAYFTN
#ifdef POINTER_64
      INTEGER*8 IZOUTBF
#endif
#endif
      REAL ZOUTBF
      POINTER ( IZOUTBF, ZOUTBF )
      DIMENSION ZOUTBF( 1 )
      INTEGER ILAT, ILON, IWORD
C
C     Array for integer parameters from section 0 of GRIB message.
      DIMENSION ISEC0(JPGRIB_ISEC0)
C
C     Array for integer parameters from section 1 of GRIB message.
      DIMENSION ISEC1(JPGRIB_ISEC1)
C
C     Array for integer parameters from section 2 of GRIB message.
      DIMENSION ISEC2(JPGRIB_ISEC2)
C
C     Array for integer parameters from section 3 of GRIB message.
      DIMENSION ISEC3(JPGRIB_ISEC3)
C
C     Array for integer parameters from section 4 of GRIB message.
      DIMENSION ISEC4(JPGRIB_ISEC4)
C
C     Array for real parameters from section 2 of GRIB message.
      DIMENSION ZSEC2(JPGRIB_RSEC2)
C
C     Array for real parameters from section 3 of GRIB message.
      DIMENSION ZSEC3(JPGRIB_RSEC3)
C
C     Array for real parameters from section 4 of GRIB message.
C     This is the binary data section and the array to hold
C     the unpacked data may need to be 4 times as long as that
C     for the packed data.
C
      DIMENSION ZSEC4(JPACK)
C
C     _______________________________________________________
C
C*    Section 1.    Unpack the input GRIB product.
C     _______________________________________________________
C
  100 CONTINUE
C
      CALL JDEBUG( )
C
      IF ( NDBG .GT. 0) THEN
        CALL INTLOG(JP_DEBUG,'JINTLL - Input parameters:',JPQUIET)
        DO 101 NDBGLP = 1, 20
          CALL INTLOGR(JP_DEBUG,' ',KIBUFF( NDBGLP ))
  101   CONTINUE
        CALL INTLOG(JP_DEBUG,
     X    'JINTLL - Length(words) of input product = ', KLENI)
        CALL INTLOGR(JP_DEBUG,
     X    'JINTLL - Required area, west long(deg) = ', PWEST)
        CALL INTLOGR(JP_DEBUG,
     X    'JINTLL - Required area, east long(deg) = ', PEAST)
        CALL INTLOGR(JP_DEBUG,
     X    'JINTLL - Required area, north lat(deg) = ', PNORTH)
        CALL INTLOGR(JP_DEBUG,
     X    'JINTLL - Required area, south lat(deg) = ', PSOUTH)
        CALL INTLOGR(JP_DEBUG,
     X    'JINTLL - Latitude grid interval (deg) = ', PLATINC)
        CALL INTLOGR(JP_DEBUG,
     X    'JINTLL - Longitude grid interval (deg) = ', PLONINC)
        CALL INTLOG(JP_DEBUG,
     X    'JINTLL - Length in words of KOBUFF = ', KLENO)
        CALL INTLOG(JP_DEBUG,
     X    'JINTLL - Number of bits for packing = ', KBITS)
      ENDIF
C
      IPUNP = JPACK*4
C
      IF ( NDBG .GT. 0) CALL GRSDBG(1)
C
      KRET = 1
      CALL GRIBEX (ISEC0,ISEC1,ISEC2,ZSEC2,ISEC3,ZSEC3,ISEC4,
     X             ZSEC4,IPUNP,KIBUFF,KLENI,IWORD,'D',KRET)
C
      IF ( NDBG .GT. 0) CALL INTLOG(JP_DEBUG,
     X    'JINTLL - Return from GRIBEX decoding = ', KRET)
C
C     Check return code.
      IF (KRET.GT.0) GOTO 900
C
C     Set number of bits to same as input if user did not give a number
      IF ( KBITS .LE. 0 ) THEN
        NBITS = ISEC4(2)
      ELSE
        NBITS = KBITS
      ENDIF
C     _______________________________________________________
C
C*    Section 2.    Interpolate to a latitude/longitude grid.
C     _______________________________________________________
C
 200  CONTINUE
C
C     Setup geographical limits
      IF ( (PWEST.EQ.0.0) .AND. (PEAST.EQ.0.0) .AND.
     X     (PNORTH.EQ.0.0) .AND. (PSOUTH.EQ.0.0) ) THEN
        NORTH = 90.0
        SOUTH = -90.0
        WEST  = 0.0
        EAST  = 360.0 - PLONINC
      ELSE
        WEST  = PWEST
        EAST  = PEAST
        NORTH = PNORTH
        SOUTH = PSOUTH
      ENDIF
C
C     Use input truncation
      ITRUNC = ISEC2(2)
C
      IF ( NDBG .GT. 0) THEN
        CALL INTLOG(JP_DEBUG,'JINTLL - WEST = ', WEST)
        CALL INTLOG(JP_DEBUG,'JINTLL - EAST = ', EAST)
        CALL INTLOG(JP_DEBUG,'JINTLL - NORTH = ', NORTH)
        CALL INTLOG(JP_DEBUG,'JINTLL - SOUTH = ', SOUTH)
        CALL INTLOG(JP_DEBUG,'JINTLL - ITRUNC = ', ITRUNC)
      ENDIF
C
      ILAT = NINT( (EAST - WEST)/PLATINC ) + 1
      ILON = NINT( (NORTH - SOUTH)/PLONINC ) + 1
      IPUNP = ILAT * ILON
C
      IF ( NDBG .GT. 0) THEN
        CALL INTLOG(JP_DEBUG,'JINTLL - Number of lat. points = ', ILAT)
        CALL INTLOG(JP_DEBUG,'JINTLL - Number of long.points = ', ILON)
        CALL INTLOG(JP_DEBUG,'JINTLL - Total no.of grid pnts = ', IPUNP)
      ENDIF
C
C     Allocate memory for scratch array.
      CALL JMEMHAN( 1, IZOUTBF, IPUNP, 1, KRET)
      IF ( KRET .NE. 0 ) THEN
        KRET =  JPROUTINE + 1
        CALL INTLOG(JP_ERROR,'JINTLL - Memory allocation failed',KRET)
        GOTO 900
      ENDIF
C
      CALL JALLGP( ZSEC4, ITRUNC, NORTH, SOUTH, WEST, EAST,
     X                    PLATINC, PLONINC, ZOUTBF, KRET)
C
      IF ( KRET .NE. 0 ) GOTO 900
C
C     _______________________________________________________
C
C*    Section 3.    Pack the output GRIB product.
C     _______________________________________________________
C
  300 CONTINUE
C
C
      ISEC1(4) = 255
      ISEC1(5) = 128
      ISEC1(19) = 0
      ISEC1(20) = 0
C
      ISEC2(1) = 0
      ISEC2(2) = ILAT
      ISEC2(3) = ILON
      ISEC2(4) = ( NORTH * 1000.0 )
      ISEC2(5) = ( WEST * 1000.0 )
      IF ( ISEC2(5) .LT. 0 ) ISEC2(5) = 360000 + ISEC2(5)
      IF ( ISEC2(5) .GT. 360000 ) ISEC2(5) = ISEC2(5) - 360000
      ISEC2(6) = 128
      ISEC2(7) = ( SOUTH * 1000.0 )
      ISEC2(8) = ( EAST * 1000.0 + 0.5 )
      IF ( ISEC2(8) .LT. 0 ) ISEC2(8) = 360000 + ISEC2(8)
      IF ( ISEC2(8) .GT. 360000 ) ISEC2(8) = ISEC2(8) - 360000
      ISEC2(9) = NINT( PLONINC * 1000.0 )
      ISEC2(10) = NINT( PLATINC * 1000.0 )
      ISEC2(11) = 0
      ISEC2(17) = 0
C
      ISEC4(1) = IPUNP
      ISEC4(2) = NBITS
      ISEC4(3) = 0
      ISEC4(4) = 0
      ISEC4(5) = 0
      ISEC4(6) = 0
      ISEC4(8) = 0
      ISEC4(9) = 0
      ISEC4(10) = 0
      ISEC4(11) = 0
C
      IF ( NDBG .GT. 0) CALL GRSDBG(1)
C
      KRET = 1
      CALL GRIBEX (ISEC0,ISEC1,ISEC2,ZSEC2,ISEC3,ZSEC3,ISEC4,
     X             ZOUTBF,IPUNP,KOBUFF,KLENO,KLENO,'C',KRET)
C
C     Check return code.
      IF ( NDBG .GT. 0)
     X  CALL INTLOG(JP_DEBUG,'JINTLL - status GRIBEX coding = ', KRET)
C
C     _______________________________________________________
C
C*    Section 9. Return to calling routine.
C     _______________________________________________________
C
 900  CONTINUE
C
      RETURN
C
      END
