      SUBROUTINE PRTBIN (KIN,KNBIT,KOUT,KERR)
C
C**** PRTBIN - Binary to decimal conversion.
C
C     Purpose.
C     --------
C
C           Produces a decimal number with ones and zeroes
C           corresponding to the ones and zeroes of the input
C           binary number.
C           eg input number 1011 binary, output number 1011 decimal.
C
C**   Interface.
C     ----------
C
C           CALL PRTBIN (KIN,KNBIT,KOUT,KERR)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KIN   - Integer variable containing binary number.
C
C               KNBIT - Number of bits in binary number.
C
C               Output Parameters.
C               -----------------
C
C               KOUT  - Integer variable containing decimal value
C                       with ones and zeroes corresponding to those of
C                       the input binary number.
C
C               KERR  - 0, If no error.
C                       1, Number of bits in binary number exceeds
C                          maximum allowed or is less than 1.
C
C     Method.
C     -------
C
C           Odd numbers have a binary representation ending in 1, even
C           numbers end in 0.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           None.
C
C     Comments.
C     ---------
C
C           Replaces earlier routine of the same name, which
C           contained non-ANSI code.
C           Routine contains sections 0, 1 and section 9.
C
C     Author.
C     -------
C
C           John Hennessy     ECMWF    01.10.91
C
C     Modifications.
C     --------------
C
C           None.
C
C     ---------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0. Definition of variables. Check on parameters.
C     -----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER IDEC
      INTEGER IK
      INTEGER ITEMP
C
      INTEGER J102
C
      INTEGER KERR
      INTEGER KIN
      INTEGER KNBIT
      INTEGER KOUT
C
C     Check length of binary number to ensure decimal number
C     generated will fit in the computer word - in this case will
C     it fit in a Cray 48 bit integer?
C
      IF (KNBIT.LT.1.OR.KNBIT.GT.14)
     C   THEN
             KERR = 1
             WRITE (*,9000) KNBIT
             GO TO 900
         ELSE
             KERR = 0
         ENDIF
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1. Generate required number.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
      KOUT = 0
      IK   = KIN
      IDEC = 1
C
      DO 102 J102=1,KNBIT
         ITEMP = IK - ( (IK/2)*2 )
         KOUT  = KOUT + ITEMP * IDEC
         IK    = IK / 2
         IDEC  = IDEC * 10
  102 CONTINUE
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9. Format statements. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
 9000 FORMAT (1H ,'PRTBIN : Error in binary number length - ',I3,
     C            ' bits.')
C
      RETURN
      END
      SUBROUTINE MAXMIN (PARRAY,KLEN,PMAX,PMIN)
C
C**** MAXMIN - Get maximum and minimum values.
C
C     Purpose.
C     --------
C
C           Get maximum and minimum values from an array of
C           floating point numbers.
C
C**   Interface.
C     ----------
C
C           CALL MAXMIN (PARRAY,KLEN,PMAX,PMIN)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               PARRAY     - Array of numbers.
C               KLEN       - Last word of this array.
C
C               Output Parameters.
C               ------------------
C
C               PMAX       - Maximum value.
C               PMIN       - Minimum value.
C
C     Method.
C     -------
C
C           Intrinsic functions MAX and MIN are used.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           None.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      18:06:91
C
C     Modifications.
C     --------------
C
C           None.
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER J110
C
      INTEGER KLEN
C
      REAL PARRAY
      REAL PMAX
      REAL PMIN
C
      DIMENSION PARRAY(*)
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Get maximum and minimum values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
C     Set initial values.
C
      PMAX = PARRAY(1)
      PMIN = PARRAY(1)
C
C     Extract maximum and minimum values.
C
      DO 110 J110 = 1 , KLEN
         PMAX = MAX (PMAX,PARRAY(J110))
         PMIN = MIN (PMIN,PARRAY(J110))
  110 CONTINUE
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9. Return to calling routine.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
      RETURN
C
      END
      SUBROUTINE GRPRS0 (KSEC0)
C
C**** GRPRS0 - Print information from Section 0 of GRIB code.
C
C     Purpose.
C     --------
C
C           Print the information in the Indicator
C           Section (Section 0) of decoded GRIB data.
C
C**   Interface.
C     ----------
C
C           CALL GRPRS0 (KSEC0)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KSEC0 - Array of decoded parameters from Section 0.
C
C               Output Parameters.
C               ------------------
C
C               None.
C
C     Method.
C     -------
C
C           Fields are printed as integers.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes re GRIB Code.
C           See also routine GRIBEX.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy    ECMWF 18.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy    ECMWF 30.08.91
C           Changes to some comments only.
C
C     -----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER KSEC0
C
      DIMENSION KSEC0(*)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Print required information.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
      WRITE (*,9000)
      WRITE (*,9001)
      WRITE (*,9002)
      WRITE (*,9003) KSEC0(1)
      WRITE (*,9004) KSEC0(2)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Format statements. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
 9000 FORMAT (1H )
 9001 FORMAT (1H ,'Section 0 - Indicator Section.       ')
 9002 FORMAT (1H ,'-------------------------------------')
 9003 FORMAT (1H ,'Length of GRIB message (octets).     ',I9)
 9004 FORMAT (1H ,'GRIB Edition Number.                 ',I9)
C
      RETURN
C
      END
      SUBROUTINE GRPRS1 (KSEC0,KSEC1)
C
C**** GRPRS1 - Print information from Section 1 of GRIB code.
C
C     Purpose.
C     --------
C
C           Print the information in the Product Definition
C           Section (Section 1) of decoded GRIB data.
C
C**   Interface.
C     ----------
C
C           CALL GRPRS1 (KSEC0,KSEC1)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KSEC0 - Array of decoded parameters from Section 0.
C
C               KSEC1 - Array of decoded parameters from Section 1.
C
C               Output Parameters.
C               ------------------
C
C               None.
C
C     Method.
C     -------
C
C           Flag fields are printed in binary representation.
C           Other fields as integers.
C           Fields printed depend on GRIB Edition.
C
C     Externals.
C     ----------
C
C           PRTBIN
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes re GRIB Code.
C           See also routine GRIBEX.
C
C     Comments.
C     ---------
C
C           When decoding data from Experimental Edition or Edition 0,
C           routine GRIBEX adds the additional fields available in
C           Edition 1.
C
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy    ECMWF 18.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy    ECMWF 30.08.91
C           Different print for GRIB Editions up to Edition 1
C           removed.
C
C           J. Hennessy    ECMWF 07.01.92
C           Different print for GRIB Editions up to Edition 1
C           added for centres other than ECMWF.
C
C           J. Hennessy    ECMWF 27.07.92
C           Print added for satellite identifiers.
C
C           J. Hennessy    ECMWF 03.11.92
C           Print of local ECMWF use of section 1 added.
C
C     -----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER IBIT
      INTEGER IERR
      INTEGER IOUT
C
      INTEGER J210
C
      INTEGER KSEC0
      INTEGER KSEC1
C
      DIMENSION KSEC0(*)
      DIMENSION KSEC1(*)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Print required information.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
      WRITE (*,9000)
      WRITE (*,9001)
      WRITE (*,9002)
C
      WRITE (*,9100) KSEC1(1)
      WRITE (*,9101) KSEC1(2)
      WRITE (*,9102) KSEC1(3)
      WRITE (*,9103) KSEC1(4)
      IBIT = 8
      CALL PRTBIN (KSEC1(5),IBIT,IOUT,IERR)
      WRITE (*,9104) IOUT
      WRITE (*,9105) KSEC1(6)
C
      IF (KSEC1(6).NE.127)
     C   THEN
             WRITE (*,9106) KSEC1(7)
             WRITE (*,9107) KSEC1(8)
             WRITE (*,9108) KSEC1(9)
         ELSE
             WRITE (*,9206) KSEC1(7)
             WRITE (*,9207) KSEC1(8)
         ENDIF
C
      WRITE (*,9109) KSEC1(10)
      WRITE (*,9110) KSEC1(11)
      WRITE (*,9111) KSEC1(12)
      WRITE (*,9112) KSEC1(13)
      WRITE (*,9113) KSEC1(14)
      WRITE (*,9114) KSEC1(15)
      WRITE (*,9115) KSEC1(16)
      WRITE (*,9116) KSEC1(17)
      WRITE (*,9117) KSEC1(18)
      WRITE (*,9118) KSEC1(19)
      WRITE (*,9119) KSEC1(20)
C
C     All ECMWF data in GRIB Editions before Edition 1 is decoded
C     as 20th century data. Other centres are decoded as missing.
C
      IF (KSEC0(2).LT.1.AND.KSEC1(2).NE.98)
     C   THEN
             WRITE (*,9122)
         ELSE
             WRITE (*,9120) KSEC1(21)
         ENDIF
C
      WRITE (*,9121) KSEC1(23)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C
C*    Section 2 . Print local ECMWF information.
C     -----------------------------------------------------------------
C
  200 CONTINUE
C
      IF (KSEC1(2).EQ.98.AND.KSEC1(24).EQ.1)
     C   THEN
             WRITE (*,9301) KSEC1(37)
             WRITE (*,9302) KSEC1(38)
             WRITE (*,9303) KSEC1(39)
             WRITE (*,9304) KSEC1(40)
             IF (KSEC1(38).EQ.1)
     C          THEN
                    WRITE (*,9305) KSEC1(41)
                ELSE
                    WRITE (*,9306) KSEC1(41)
                ENDIF
             IF (KSEC1(39).EQ.40) WRITE (*,9307) KSEC1(42)
             IF (KSEC1(39).GT.4.AND.KSEC1(39).LT.9)
     C          THEN
                    WRITE (*,9308) KSEC1(42)
                    WRITE (*,9309) KSEC1(43)
                ENDIF
             IF (KSEC1(39).EQ.10.OR.KSEC1(39).EQ.11)
     C          THEN
                    WRITE (*,9310) KSEC1(42)
                    WRITE (*,9311) KSEC1(43)
                ENDIF
             IF (KSEC1(39).EQ.14.OR.KSEC1(39).EQ.15)
     C          THEN
                    WRITE (*,9312) KSEC1(42)
                    WRITE (*,9313) KSEC1(43)
                    WRITE (*,9314) KSEC1(44)
                    WRITE (*,9315) KSEC1(45)
                    WRITE (*,9316) KSEC1(46)
                    WRITE (*,9317) KSEC1(47)
                    WRITE (*,9318) KSEC1(48)
                    WRITE (*,9319) KSEC1(49)
                    WRITE (*,9320) KSEC1(50)
                    WRITE (*,9321) KSEC1(51)
                    WRITE (*,9324) KSEC1(52)
                    WRITE (*,9322) KSEC1(53)
                    DO 210 J210 = 1,KSEC1(53)
                       WRITE (*,9323) KSEC1(J210+53)
  210               CONTINUE
                ENDIF
         ENDIF
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Format statements. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
 9000 FORMAT (1H )
 9001 FORMAT (1H ,'Section 1 - Product Definition Section.')
 9002 FORMAT (1H ,'---------------------------------------')
 9100 FORMAT (1H ,'Code Table 2 Version Number.         ',I9)
 9101 FORMAT (1H ,'Originating centre identifier.       ',I9)
 9102 FORMAT (1H ,'Model identification.                ',I9)
 9103 FORMAT (1H ,'Grid definition.                     ',I9)
 9104 FORMAT (1H ,'Flag (Code Table 1)                   ',I8.8)
 9105 FORMAT (1H ,'Parameter identifier (Code Table 2). ',I9)
 9106 FORMAT (1H ,'Type of level (Code Table 3).        ',I9)
 9107 FORMAT (1H ,'Value 1 of level (Code Table 3).     ',I9)
 9108 FORMAT (1H ,'Value 2 of level (Code Table 3).     ',I9)
 9109 FORMAT (1H ,'Year of data.                        ',I9)
 9110 FORMAT (1H ,'Month of data.                       ',I9)
 9111 FORMAT (1H ,'Day of data.                         ',I9)
 9112 FORMAT (1H ,'Hour of data.                        ',I9)
 9113 FORMAT (1H ,'Minute of data.                      ',I9)
 9114 FORMAT (1H ,'Time unit (Code Table 4).            ',I9)
 9115 FORMAT (1H ,'Time range one.                      ',I9)
 9116 FORMAT (1H ,'Time range two.                      ',I9)
 9117 FORMAT (1H ,'Time range indicator (Code Table 5)  ',I9)
 9118 FORMAT (1H ,'Number averaged.                     ',I9)
 9119 FORMAT (1H ,'Number missing from average.         ',I9)
 9120 FORMAT (1H ,'Century of data.                     ',I9)
 9121 FORMAT (1H ,'Units decimal scaling factor.        ',I9)
 9122 FORMAT (1H ,'Century of data.                     not given')
 9206 FORMAT (1H ,'Satellite identifier (Code Table 3). ',I9)
 9207 FORMAT (1H ,'Spectral band.                       ',I9)
C
 9301 FORMAT (1H ,'ECMWF local usage identifier.        ',I9)
 9302 FORMAT (1H ,'Class.                               ',I9)
 9303 FORMAT (1H ,'Type.                                ',I9)
 9304 FORMAT (1H ,'Stream.                              ',I9)
 9305 FORMAT (1H ,'Version number.                      ',I9)
 9306 FORMAT (1H ,'Experiment identifier.                    ',A8)
 9307 FORMAT (1H ,'Band.                                ',I9)
 9308 FORMAT (1H ,'Simulation number.                   ',I9)
 9309 FORMAT (1H ,'Total number of simulations.         ',I9)
 9310 FORMAT (1H ,'Forecast number.                     ',I9)
 9311 FORMAT (1H ,'Total number of forecasts.           ',I9)
 9312 FORMAT (1H ,'Cluster number.                      ',I9)
 9313 FORMAT (1H ,'Total number of clusters.            ',I9)
 9314 FORMAT (1H ,'Clustering method.                   ',I9)
 9315 FORMAT (1H ,'Start time step when clustering.     ',I9)
 9316 FORMAT (1H ,'End time step when clustering.       ',I9)
 9317 FORMAT (1H ,'Northern latitude of domain.         ',I9)
 9318 FORMAT (1H ,'Western longitude of domain.         ',I9)
 9319 FORMAT (1H ,'Southern latitude of domain.         ',I9)
 9320 FORMAT (1H ,'Eastern longitude of domain.         ',I9)
 9321 FORMAT (1H ,'Operational forecast in cluster      ',I9)
 9322 FORMAT (1H ,'Number of forecasts in cluster.      ',I9)
 9323 FORMAT (1H ,'Forecast number                      ',I9)
 9324 FORMAT (1H ,'Control forecast in cluster          ',I9)
C
      RETURN
C
      END
      SUBROUTINE GRPRS2 (KSEC0,KSEC2,PSEC2)
C
C**** GRPRS2 - Print information from Section 2 of GRIB code.
C
C     Purpose.
C     --------
C
C           Print the information in the Grid Description
C           Section (Section 2) of decoded GRIB data.
C
C**   Interface.
C     ----------
C
C           CALL GRPRS2 (KSEC0,KSEC2,PSEC2)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KSEC0 - Array of decoded integers from Section 0.
C
C               KSEC2 - Array of decoded integers from Section 2.
C
C               PSEC2 - Array of decoded reals from Section 2.
C
C               Output Parameters.
C               ------------------
C
C               None.
C
C     Method.
C     -------
C
C           Flag fields are printed in binary representation
C           Other fields as integers or reals, as appropriate.
C           Fields printed depend on GRIB Edition.
C
C     Externals.
C     ----------
C
C           PRTBIN
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes re GRIB Code.
C
C     Comments.
C     ---------
C
C           Only data representation types catered for are Gaussian
C           grid, latitude/longitude grid, Spherical Harmonics,
C           Polar stereographic and Space view perspective.
C
C     Author.
C     -------
C
C           J. Hennessy    ECMWF 18.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy    ECMWF 02.09.91
C           Polar stereographic print added.
C
C           J. Hennessy    ECMWF 25.09.91
C           Space view perspective print added.
C
C     -----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      CHARACTER*10 YOUT
C
      INTEGER I
      INTEGER IBIT
      INTEGER IEDIT
      INTEGER IERR
      INTEGER IOUT
      INTEGER IJ
      INTEGER IK
      INTEGER IRESOL
C
      INTEGER J103
C
      INTEGER KSEC0
      INTEGER KSEC2
C
      REAL PSEC2
C
      DIMENSION KSEC0(*)
      DIMENSION KSEC2(*)
C
      DIMENSION PSEC2(*)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Print required information.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
C     GRIB Edition number.
C
      IEDIT = KSEC0(2)
C
      WRITE (*,9000)
      WRITE (*,9001)
      WRITE (*,9002)
C
C*    Spherical harmonic data.
C
      IF (KSEC2(1).EQ.50
     C    .OR.KSEC2(1).EQ.60
     C    .OR.KSEC2(1).EQ.70
     C    .OR.KSEC2(1).EQ.80)
     C   THEN
C
             WRITE (*,9101) KSEC2(1)
             WRITE (*,9102) KSEC2(2)
             WRITE (*,9103) KSEC2(3)
             WRITE (*,9104) KSEC2(4)
             WRITE (*,9105) KSEC2(5)
             WRITE (*,9106) KSEC2(6)
             WRITE (*,9107) (KSEC2(I),I=7,11)
             WRITE (*,9212) KSEC2(12)
             GO TO 190
C
         ENDIF
C
C*    Gaussian grid.
C
      IF (KSEC2(1).EQ.4
     C    .OR.KSEC2(1).EQ.14
     C    .OR.KSEC2(1).EQ.24
     C    .OR.KSEC2(1).EQ.34)
     C   THEN
C
             WRITE (*,9200)
             WRITE (*,9101) KSEC2(1)
C
C            Quasi-regular grids introduced in Edition 1.
C
             IF (KSEC2(17).EQ.0.OR.IEDIT.LT.1)
     C          THEN
                    WRITE (*,9201) KSEC2(2)
                ELSE
                    WRITE (*,9233)
                    WRITE (*,9234)
                    IJ = 0
                    YOUT = ' '
                    DO 103 J103 =1,KSEC2(3)
                       IJ = IJ + 1
                       WRITE (YOUT(1:3),'(I3)') IJ
                       IF (IJ.GT.KSEC2(3)) GO TO 104
                       IF (IJ.EQ.KSEC2(3))
     C                    THEN
                              WRITE (*,9235) KSEC2(IJ+22) , YOUT
                              GO TO 104
                          ENDIF
                       IK = 0
  102                  CONTINUE
                       IK = IK + 1
                       IF (KSEC2(IJ+22+1).EQ.KSEC2(IJ+22))
     C                    THEN
                              IJ = IJ + 1
                              GO TO 102
                          ENDIF
                       IF (IK.GT.1)
     C                    THEN
                              YOUT(4:) = ' to '
                              WRITE (YOUT(8:10),'(I3)') IJ
                          ENDIF
                       WRITE (*,9235) KSEC2(IJ+22) , YOUT
                       YOUT = ' '
  103               CONTINUE
  104               CONTINUE
                ENDIF
             WRITE (*,9202) KSEC2(3)
             WRITE (*,9203) KSEC2(4)
             WRITE (*,9204) KSEC2(5)
             IBIT = 8
             IRESOL = KSEC2(6) + KSEC2(18) + KSEC2(19)
             CALL PRTBIN (IRESOL,IBIT,IOUT,IERR)
             WRITE (*,9205) IOUT
             WRITE (*,9206) KSEC2(7)
             WRITE (*,9207) KSEC2(8)
C
C            Print increment if given.
C
             IF (KSEC2(6).EQ.128)
     C          THEN
                    WRITE (*,9208) KSEC2(9)
                ELSE
                    WRITE (*,9236)
                ENDIF
             WRITE (*,9210) KSEC2(10)
             IBIT = 8
             CALL PRTBIN (KSEC2(11),IBIT,IOUT,IERR)
             WRITE (*,9211) IOUT
             WRITE (*,9212) KSEC2(12)
             GO TO 190
C
         ENDIF
C
C*    Latitude / longitude grids.
C
      IF (KSEC2(1).EQ.0
     C    .OR.KSEC2(1).EQ.10
     C    .OR.KSEC2(1).EQ.20
     C    .OR.KSEC2(1).EQ.30)
     C   THEN
C
             WRITE (*,9200)
             WRITE (*,9101) KSEC2(1)
             WRITE (*,9201) KSEC2(2)
             WRITE (*,9202) KSEC2(3)
             WRITE (*,9203) KSEC2(4)
             WRITE (*,9204) KSEC2(5)
             IBIT = 8
             IRESOL = KSEC2(6) + KSEC2(18) + KSEC2(19)
             CALL PRTBIN (IRESOL,IBIT,IOUT,IERR)
             WRITE (*,9205) IOUT
             WRITE (*,9206) KSEC2(7)
             WRITE (*,9207) KSEC2(8)
C
C            Print increment if given.
C
             IF (KSEC2(6).EQ.128)
     C          THEN
                    WRITE (*,9208) KSEC2(9)
                    WRITE (*,9209) KSEC2(10)
                ELSE
                    WRITE (*,9236)
                    WRITE (*,9237)
                ENDIF
             IBIT = 8
             CALL PRTBIN (KSEC2(11),IBIT,IOUT,IERR)
             WRITE (*,9211) IOUT
             WRITE (*,9212) KSEC2(12)
             GO TO 190
C
         ENDIF
C
C*    Polar stereographic.
C
      IF (KSEC2(1).EQ.5)
     C   THEN
C
             WRITE (*,9200)
             WRITE (*,9101) KSEC2(1)
             WRITE (*,9301) KSEC2(2)
             WRITE (*,9302) KSEC2(3)
             WRITE (*,9203) KSEC2(4)
             WRITE (*,9204) KSEC2(5)
             IBIT = 8
             IRESOL = KSEC2(18) + KSEC2(19)
             CALL PRTBIN (IRESOL,IBIT,IOUT,IERR)
             WRITE (*,9205) IOUT
             WRITE (*,9303) KSEC2(7)
             WRITE (*,9304) KSEC2(9)
             WRITE (*,9305) KSEC2(10)
             IBIT = 8
             CALL PRTBIN (KSEC2(11),IBIT,IOUT,IERR)
             WRITE (*,9211) IOUT
             WRITE (*,9212) KSEC2(12)
             WRITE (*,9306) KSEC2(13)
             GO TO 190
C
         ENDIF
C
C*    Space view perspective or orthographic.
C
      IF (KSEC2(1).EQ.90)
     C   THEN
             WRITE (*,9200)
             WRITE (*,9101) KSEC2(1)
             WRITE (*,9301) KSEC2(2)
             WRITE (*,9302) KSEC2(3)
             WRITE (*,9310) KSEC2(4)
             WRITE (*,9311) KSEC2(5)
             IBIT = 8
             IRESOL = KSEC2(18) + KSEC2(19)
             CALL PRTBIN (IRESOL,IBIT,IOUT,IERR)
             WRITE (*,9205) IOUT
             WRITE (*,9312) KSEC2(7)
             WRITE (*,9313) KSEC2(8)
             WRITE (*,9314) KSEC2(9)
             WRITE (*,9315) KSEC2(10)
             IBIT = 8
             CALL PRTBIN (KSEC2(11),IBIT,IOUT,IERR)
             WRITE (*,9211) IOUT
             WRITE (*,9212) KSEC2(12)
             WRITE (*,9303) KSEC2(13)
             WRITE (*,9316) KSEC2(14)
             WRITE (*,9317) KSEC2(15)
             WRITE (*,9318) KSEC2(16)
             GO TO 190
C
         ENDIF
C
C*    Representation type not catered for.
C
      WRITE (*,9500) KSEC2(1)
      GO TO 900
C
C*    Print vertical coordinate parameters, if any.
C
  190 CONTINUE
C
      IF (KSEC2(12).NE.0)
     C   THEN
             WRITE (*,9000)
             WRITE (*,9400)
             WRITE (*,9401)
             WRITE (*,'(4X,F20.12,4X,F20.12)')
     C               (PSEC2(I),I=11,KSEC2(12)+10)
         ENDIF
C
C     Rotated and stretched grids introduced in Edition 1.
C
      IF (IEDIT.LT.1) GO TO 900
C
C*    Rotated grid information, if any.
C
      IF (KSEC2(1).EQ.10
     C    .OR.KSEC2(1).EQ.30
     C    .OR.KSEC2(1).EQ.14
     C    .OR.KSEC2(1).EQ.34
     C    .OR.KSEC2(1).EQ.60
     C    .OR.KSEC2(1).EQ.80
     C    .OR.KSEC2(1).EQ.30)
     C   THEN
C
             WRITE (*,9000)
             WRITE (*,9220) KSEC2(13)
             WRITE (*,9221) KSEC2(14)
             WRITE (*,9222) PSEC2(1)
         ENDIF
C
C*    Stretched grid information, if any.
C
      IF (KSEC2(1).EQ.20
     C    .OR.KSEC2(1).EQ.30
     C    .OR.KSEC2(1).EQ.24
     C    .OR.KSEC2(1).EQ.34
     C    .OR.KSEC2(1).EQ.70
     C    .OR.KSEC2(1).EQ.80)
     C   THEN
C
             WRITE (*,9000)
             WRITE (*,9230) KSEC2(15)
             WRITE (*,9231) KSEC2(16)
             WRITE (*,9232) PSEC2(2)
         ENDIF
C
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C*    Section 9 . Format statements. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
 9000 FORMAT (1H )
 9001 FORMAT (1H ,'Section 2 - Grid Description Section.')
 9002 FORMAT (1H ,'-------------------------------------')
 9101 FORMAT (1H ,'Data representation type (Table 6).          ',I9)
 9102 FORMAT (1H ,'J - Pentagonal resolution parameter.         ',I9)
 9103 FORMAT (1H ,'K - Pentagonal resolution parameter.         ',I9)
 9104 FORMAT (1H ,'M - Pentagonal resolution parameter.         ',I9)
 9105 FORMAT (1H ,'Representation type (Table 9)                ',I9)
 9106 FORMAT (1H ,'Representation mode (Table 10).              ',I9)
 9107 FORMAT (1H ,'Not used.                                    ',I9)
C
 9200 FORMAT (1H ,'(Southern latitudes and Western longitudes',
     C            ' are negative.)')
 9201 FORMAT (1H ,'Number of points along a parallel.           ',I9)
 9202 FORMAT (1H ,'Number of points along a meridian.           ',I9)
 9203 FORMAT (1H ,'Latitude of first grid point.                ',I9)
 9204 FORMAT (1H ,'Longitude of first grid point.               ',I9)
 9205 FORMAT (1H ,'Resolution and components flag.               ',I8.8)
 9206 FORMAT (1H ,'Latitude of last grid point.                 ',I9)
 9207 FORMAT (1H ,'Longitude of last grid point.                ',I9)
 9208 FORMAT (1H ,'i direction (East-West) increment.           ',I9)
 9209 FORMAT (1H ,'j direction (North-South) increment.         ',I9)
 9210 FORMAT (1H ,'Number of parallels between pole and equator.',I9)
 9211 FORMAT (1H ,'Scanning mode flags (Code Table 8)            ',I8.8)
 9212 FORMAT (1H ,'Number of vertical coordinate parameters.    ',I9)
C
 9220 FORMAT (1H ,'Latitude of southern pole of rotation.       ',I9)
 9221 FORMAT (1H ,'Longitude of southern pole of rotation.      ',I9)
 9222 FORMAT (1H ,'Angle of rotation.                     ',F20.10)
C
 9230 FORMAT (1H ,'Latitude of pole of stretching.              ',I9)
 9231 FORMAT (1H ,'Longitude of pole of stretching.             ',I9)
 9232 FORMAT (1H ,'Stretching factor.                     ',F20.10)
 9233 FORMAT (1H ,'Number of points along a parallel varies.')
 9234 FORMAT (1H ,'Number of points.   Parallel. (Numbered from ',
     C            'North to South)')
 9235 FORMAT (1H , I5,16X,A10)
 9236 FORMAT (1H ,'i direction (East-West) increment not given.')
 9237 FORMAT (1H ,'j direction (North-South) increment not given.')
C
 9301 FORMAT (1H ,'Number of points along X axis.               ',I9)
 9302 FORMAT (1H ,'Number of points along Y axis.               ',I9)
 9303 FORMAT (1H ,'Orientation of the grid.                     ',I9)
 9304 FORMAT (1H ,'X direction increment.                       ',I9)
 9305 FORMAT (1H ,'Y direction increment.                       ',I9)
 9306 FORMAT (1H ,'Projection centre flag.                      ',I9)
C
 9310 FORMAT (1H ,'Latitude of sub-satellite point.             ',I9)
 9311 FORMAT (1H ,'Longitude of sub-satellite point.            ',I9)
 9312 FORMAT (1H ,'Diameter of the earth in x direction.        ',I9)
 9313 FORMAT (1H ,'Diameter of the earth in y direction.        ',I9)
 9314 FORMAT (1H ,'x coordinate of sub-satellite point.         ',I9)
 9315 FORMAT (1H ,'Y coordinate of sub-satellite point.         ',I9)
 9316 FORMAT (1H ,'Altitude of the camera.                      ',I9)
 9317 FORMAT (1H ,'Y coordinate of origin of sector image.      ',I9)
 9318 FORMAT (1H ,'X coordinate of origin of sector image.      ',I9)
C
 9400 FORMAT (1H ,'Vertical Coordinate Parameters.')
 9401 FORMAT (1H ,'-------------------------------')
C
 9500 FORMAT (1H ,'GRPRS2 :Data representation type not catered for -',
     C            I4)
c
      RETURN
C
      END
      SUBROUTINE GRIBEX (KSEC0,KSEC1,KSEC2,PSEC2,KSEC3,PSEC3,KSEC4,
     C                   PSEC4,KLENP,KGRIB,KLENG,KWORD,HOPER,KRET)
C
C**** GRIBEX - Coding and decoding of GRIB format data.
C
C     Purpose.
C     --------
C
C           1) Code data in FM-92 GRIB code, Edition 1.
C           2) Decode data from FM-92 GRIB code.
C           3) Decode only identification sections of GRIB
C              coded data ie Sections 0, 1 and 2.
C           4) Return length of GRIB message, in bytes, and GRIB
C              Edition number only.
C
C              A number of options exist when coding or decoding -
C              see values allowed for requested function, HOPER, below.
C
C              Decoding functions work on Experimental Edition,
C              Edition 0 and Edition 1 of GRIB code. Decoded values
C              for Sections 0 to 2 are always in Edition 1 format.
C
C**   Interface.
C     ----------
C
C           CALL GRIBEX (KSEC0,KSEC1,KSEC2,PSEC2,KSEC3,PSEC3,KSEC4,
C    C                   PSEC4,KLENP,KGRIB,KLENG,KWORD,HOPER,KRET)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters for all functions.
C               -----------------------------------
C
C               HOPER      - Requested function.
C
C                            'C' To code data in GRIB code, with or
C                                without bit-maps.
C
C                            'D' To decode data from GRIB code. If
C                                ECMWF pseudo-Grib data is encountered,
C                                only sections 0 and 1 are decoded and
C                                the return code is set to -6.
C
C                            'I' To decode only identification
C                                sections 0, 1 and 2 of GRIB or
C                                pseudo-Grib data.
C
C                            'L' Return length of GRIB message, in
C                                bytes, and GRIB Edition number only.
C                                Length does not include any bytes
C                                added to round message length to a
C                                multiple of 120 bytes. Works also for
C                                pseudo-Grib data.
C
C                            'M' To code data in GRIB code and, if a
C                                bit-map is encountered, make GRIB
C                                message full length ie the same length
C                                as if all data values were given.
C
C                            'R' To decode data from GRIB code, and if
C                                a quasi-regular Gaussian grid is
C                                encountered, convert it to regular.
C
C                            'S' To decode initialised analysis data
C                                from GRIB code, and if data is in the
C                                Experimental Edition of GRIB, set the
C                                Time Range Indicator flag. In the
C                                Experimental Edition there was no
C                                distinction between initialised and
C                                uninitialised analyses.
C
C                            'X' To extract data values for up to 4
C                                points from a GRIB coded Gaussian or
C                                Latitude/longitude field, without
C                                unpacking the data at other points.
C
C                            'Z' To decode data from GRIB code.
C                                If a bit-map is encountered,
C                                only sections 0,1 and 2 are decoded and
C                                the return code is set to -5.
C
C               KLENP      - Length of array PSEC4.
C
C               KLENG      - Length of array KGRIB.
C
C               KRET       - Response to error indicator.
C                            0         , Abort if error encountered.
C                                        Negative return codes are
C                                        informative and do not cause
C                                        an abort.
C                            Non- zero , Return to calling routine
C                                        even if error encountered.
C
C
C
C
C
C               Input parameters for coding function.
C               Output Parameters for decoding functions.
C               -----------------------------------------
C
C               KSEC1      - Integer parameters of Section 1 (Product
C                            Definition Section) of GRIB code.
C                            Integer array of at least 25 words.
C
C                            If Section 1 of the GRIB code contains
C                            data for ECMWF local use, KSEC1 should
C                            be sized accordingly eg 53 + N , where
C                            N is the number of ensemble forecasts.
C
C                   Word   Contents.
C                   ----   ---------
C                     1    Version number of Code Table 2.
C                     2    Identification of centre (Code Table 0).
C                     3    Generating process identification number
C                          ( allocated by originating centre ).
C                     4    Grid definition (NNN -  Catalogue number
C                          of grid used by originating centre. See
C                          Volume B of publication WMO - No.9).
C                     5    Flag indication relative to Section 2
C                          (Grid Description Section) and Section
C                          3 (Bit Map Section). Code Table 1.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Sections 2 and 3 omitted.
C                           128      Section 2 included, Section 3
C                                    omitted.
C                            64      Section 2 omitted, Section 3
C                                    included.
C                           192      Sections 2 and 3 included.
C
C                     6    Indicator of parameter (Code Table 2).
C                     7    Indicator of type of level (Code Table 3).
C                     8    Height, pressure etc of level (Code Table 3).
C                          Single level or top of layer.
C                     9    Height, pressure etc of level (Code Table 3).
C                          Bottom of layer, if word 6 indicates a layer.
C                    10    Year of century  }
C                    11    Month            } Reference time of data -
C                    12    Day              } Date and time of start of
C                    13    Hour             } averaging or accumulation
C                    14    Minute           } period.
C                    15    Indicator of unit of time (Code Table 4).
C                    16    P1 - Period of time (number of time units)
C                          (0 for analyses or initialised analyses).
C                    17    P2 - Period of time (number of time units);
C                          or time interval between successive
C                          analyses, initialised analyses or forecasts
C                          undergoing averaging or accumulation;
C                          otherwise set to zero.
C                    18    Time range indicator (Code Table 5).
C                    19    Number included in average, when time range
C                          indicator indicates an average or
C                          accumulation; otherwise set to zero.
C                    20    Number missing from average, when time range
C                          indicator indicates an average or
C                          accumulation; otherwise set to zero.
C                    21    Century of reference time of data.
C                    22    Reserved. set to 0.
C                    23    Decimal scale factor.
C                    24    Flag field to indicate local use in
C                          Section 1.
C                          0 - No local use of section 1.
C                          1 - Local use of section 1.
C                 25-36    Reserved for WMO reserved fields. Set to 0.
C                    37    ECMWF local usage identifier.This is a number
C                          which indicates the contents of words 38-nn.
C
C                          1 - ECMWF local GRIB use definition 1.
C                          2 - ECMWF local GRIB use definition 1.
C
C                    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
C                   ECMWF local GRIB use definition 1.
C                   ----------------------------------
C
C
C                    38    Class : 1 = Operations
C                                  2 = Research
C
C                    39    Type  : 1 = First Guess
C                                  2 = Analysis
C                                  3 = Initialised analysis
C                                  4 = OI analysis
C                                  5 = 3 D variational analysis
C                                  6 = 4 D variational analysis
C                                  7 = 3 D variational gradients
C                                  8 = 4 D variational gradients
C                                  9 = Forecast
C                                 10 = Control forecast
C                                 11 = Perturbed forecast
C                                 12 = Errors in first guess
C                                 13 = Errors in analysis
C                                 14 = Cluster means
C                                 15 = Cluster standard deviations.
C                                 20 = Climatology
C                                 30 = Observations
C                                 31 = Quality control
C                                 32 = Difference statistics
C                                 40 = Image data
C
C                    40  Stream : 51 = Meteosat 4
C                                201 = NOAA 9
C                                251 = GOES 7
C                               1025 = Daily archive
C                               1035 = Ensemble forecasts
C                               1041 = TOGA
C                               1042 = Chernobyl
C                               1043 = Monthly
C                               1044 = Supplementary data
C                               1045 = Wave
C                               1050 = Bracknell
C                               1051 = Washington
C                               1052 = Offenbach
C                               1053 = Paris
C                               1054 = Tokyo
C                               1055 = Montreal
C                               1060 = Test
C
C                    41  Expver : Version number/experiment identifier.
C
C                    42 Number : Ensemble forecast number.
C                                Control forecast is number 0,
C                                perturbed forecasts 1-nn.
C
C                                Set to 0, if not ensemble forecast.
C
C                    43 Total  : Total number of forecasts in ensemble.
C                                This number includes the control
C                                forecast.
C
C                                Set to 0, if not ensemble forecast.
C
C
C                    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
C                    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
C                   ECMWF local GRIB use definition 2.
C                   ----------------------------------
C
C         Words 38-41 as for definition 1.
C
C                    42 Number : Cluster number.
C
C                    43 Total  : Total number of clusters.
C
C                    44 Clustering method :-
C                               1 - Maximum linkage method
C                               2 - Mixed method
C                               3 - Small linkage method
C
C                    45 Start time step considered when clustering
C                       (Same units of time as forecast timesteps)
C
C                    46 End time step considered when clustering
C                       (Same units of time as forecast timesteps)
C
C                    47 Northern latitude of domain of clustering
C                    48 Western longitude of domain of clustering
C                    49 Southern latitude of domain of clustering
C                    50 Eastern longitude of domain of clustering
C                       (See Notes 1-4 below)
C
C                    51       : Number of cluster to which operational
C                               forecast belongs.
C
C                    52       : Number of cluster to which control
C                               forecast belongs.
C
C                    53   N   : Number of forecasts belonging to
C                               the cluster , including the
C                               control forecast.
C
C                 54-53+N     : List of N ensemble forecast numbers.
C
C                    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
C
C
C
C
C               KSEC2      - Integer parameters of Section 2 (Grid
C                            Description Section) of GRIB code.
C                            Integer array of at least 22 + n words,
C                            where n is the number of parallels or
C                            meridians in a quasi-regular (reduced)
C                            Gaussian or latitude/longitude grid.
C
C                    Notes:- 1) Latitudes, longitudes are in
C                               millidegrees.
C                            2) Latitude values in the range 0-90000.
C                            3) Longitude values in the range 0-360000.
C                            4) Southern latitudes and western
C                               longitudes are negative.
C
C                   Word   Contents for latitude/longitude grids or
C                          equidistant cylindrical or Plate Carree.
C                   ----   ----------------------------------------
C                     1    Data representation type (Code Table 6).
C                     2    Ni - Number of points along a parallel.
C                     3    Nj - Number of points along a meridian.
C                     4    La1 - Latitude of first grid point.
C                     5    Lo1 - Longitude of first grid point.
C                     6    Resolution flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Direction increments not given.
C                                    Used for quasi-regular grids, but
C                                    can also be used for regular grids.
C                           128      Direction increments given.
C                                    Grids must be regular.
C
C                     7    La2 - Latitude of last grid point.
C                     8    Lo2 - Longitude of last grid point.
C                     9    Di - i direction increment.
C                    10    Dj - j direction increment.
C                    11    Scanning mode flags (Code Table 8).
C                    12    Number of vertical coordinate parameters.
C                    13    Latitude of the southern pole of rotation.
C                    14    Longitude of the southern pole of rotation.
C                    15    Latitude of the the pole of stretching.
C                    16    Longitude of the the pole of stretching.
C                    17    0 , Regular grid.
C                          1 , Quasi-regular (reduced) grid.
C
C                       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C                       !                                               
C                       !      At the moment quasi-regular latitude/    
C                       !      longitude grids are not properly defined.
C                       !      The Resolution flag field indicates both 
C                       !      direction increments are given or not.   
C                       !      One increment needs to be given. Grids   
C                       !      can be irregular in one direction only.  
C                       !                                               
C                       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
C                    18    Earth flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Earth assumed spherical with
C                                    radius of 6367.47 km.
C                            64      Earth assumed oblate spheroidal
C                                    with size as determined by IAU in
C                                    1965 :
C                                    (6378.160km,6356.775km,f=1/297.0)
C
C                    19    Components flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Resolved u and v components of
C                                    vector quantities relative to
C                                    easterly and northerly directions.
C
C                             8      Resolved u and v components of
C                                    vector quantities relative to the
C                                    defined grid in the direction of
C                                    increasing x and y (or i and j)
C                                    coordinates respectively.
C
C                 20-22    Reserved. Set to 0.
C                 23-nn    Number of points along each parallel
C                          in a Quasi-regular grid. Number of parallels
C                          is given by Nj above.
C                          or
C                          Number of points along each meridian
C                          in a Quasi-regular grid. Number of  meridians
C                          is given by Ni above.
C
C                          Scanning mode flags (Code Table 8) indicate
C                          whether points are consecutive on a meridian
C                          or a parallel.
C
C                    Notes:- 1) Increments are in millidegrees.
C
C
C
C
C
C                   Word   Contents for Gaussian grids .
C                   ----   ---------------------------------------
C                     1    Data representation type (Code Table 6).
C                     2    Ni - Number of points along a parallel.
C                              Cannot be used for quasi-regular grids.
C                     3    Nj - Number of points along a meridian.
C                     4    La1 - Latitude of first grid point.
C                     5    Lo1 - Longitude of first grid point.
C                     6    Resolution flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Direction increments not given.
C                                    Used for quasi-regular grids, but
C                                    can also be used for regular grids.
C                           128      Direction increments given.
C                                    Grids must be regular.
C
C                     7    La2 - Latitude of last grid point.
C                     8    Lo2 - Longitude of last grid point.
C                     9    Di - i direction increment.
C                               Cannot be used for quasi-regular grids.
C                    10    N - Number of parallels between a Pole and
C                          the Equator.
C                    11    Scanning mode flags (Code Table 8).
C                    12    Number of vertical coordinate parameters.
C                    13    Latitude of the southern pole of rotation.
C                    14    Longitude of the southern pole of rotation.
C                    15    Latitude of the the pole of stretching.
C                    16    Longitude of the the pole of stretching.
C                    17    0 , Regular grid.
C                          1 , Quasi-regular (reduced) grid.
C                    18    Earth flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Earth assumed spherical with
C                                    radius of 6367.47 km.
C                            64      Earth assumed oblate spheroidal
C                                    with size as determined by IAU in
C                                    1965 :
C                                    (6378.160km,6356.775km,f=1/297.0)
C
C                    19    Components flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Resolved u and v components of
C                                    vector quantities relative to
C                                    easterly and northerly directions.
C
C                             8      Resolved u and v components of
C                                    vector quantities relative to the
C                                    defined grid in the direction of
C                                    increasing x and y (or i and j)
C                                    coordinates respectively.
C
C                 20-22    Reserved. Set to 0.
C                 23-nn    Number of points along each parallel
C                          in a Quasi-regular grid. Number of parallels
C                          is given by Nj above.
C
C                    Notes:- 1) Increments are in millidegrees.
C
C
C
C
C
C                   Word   Contents for Spherical Harmonic Coefficients.
C                   ----   --------------------------------------------
C                     1    Data representation type (Code Table 6).
C                     2    J - Pentagonal resolution parameter.
C                     3    K - Pentagonal resolution parameter.
C                     4    M - Pentagonal resolution parameter.
C                     5    Representation type ( Code Table 9 ).
C                     6    Representation mode ( Code Table 10 ).
C                  7-11    Reserved. Set to 0.
C                    12    Number of vertical coordinate parameters.
C                    13    Latitude of the southern pole of rotation.
C                    14    Longitude of the southern pole of rotation.
C                    15    Latitude of the the pole of stretching.
C                    16    Longitude of the the pole of stretching.
C                 17-22    Reserved. Set to 0.
C
C
C
C
C
C                   Word   Contents for Polar Stereographic.
C                   ----   --------------------------------------------
C                     1    Data representation type (Code Table 6).
C                     2    Nx - Number of points along X-axis.
C                     3    Ny - Number of points along Y-axis.
C                     4    La1 - Latitude of first grid point.
C                     5    Lo1 - Longitude of first grid point.
C                     6    Reserved. Set to 0. Resolution flag is
C                          not applicable to Polar stereographic.
C                     7    LoV - Orientation of the grid ie the
C                          longitude of the meridian which is parallel
C                          to the Y-axis along which latitude increases
C                          as the Y-coordinate increases.
C                     8    Reserved. Set to 0.
C                     9    Dx - X-direction grid length.
C                    10    Dy - Y-direction grid length.
C                    11    Scanning mode flag (Code Table 8).
C                    12    Number of vertical coordinate parameters.
C                    13    Projection centre flag.
C                          0 , North pole is on projection plane.
C                          1 , South pole is on projection plane. ??????
C                          128 , South pole is on projection plane. ????
C                 14-16    Reserved. Set to 0.
C                    17    0 , Regular grid.
C                          1 , Quasi-regular (reduced) grid.
C                    18    Earth flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Earth assumed spherical with
C                                    radius of 6367.47 km.
C                            64      Earth assumed oblate spheroidal
C                                    with size as determined by IAU in
C                                    1965 :
C                                    (6378.160km,6356.775km,f=1/297.0)
C
C                    19    Components flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Resolved u and v components of
C                                    vector quantities relative to
C                                    easterly and northerly directions.
C
C                             8      Resolved u and v components of
C                                    vector quantities relative to the
C                                    defined grid in the direction of
C                                    increasing x and y (or i and j)
C                                    coordinates respectively.
C                         20-22      Reserved. Set to 0.
C
C
C                    Notes   1) Grid lengths are in metres, at the 60-
C                               degree parallel nearest to the pole on
C                               the projection plane.
C
C
C
C
C
C                   Word   Contents for Mercator.
C                   ----   ---------------------------------------
C                     1    Data representation type (Code Table 6).
C                     2    Ni - Number of points along a parallel.
C                     3    Nj - Number of points along a meridian.
C                     4    La1 - Latitude of first grid point.
C                     5    Lo1 - Longitude of first grid point.
C                     6    Resolution flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Direction increments not given.
C                           128      Direction increments given.
C
C                     7    La2 - Latitude of last grid point.
C                     8    Lo2 - Longitude of last grid point.
C                     9    Latin - latitude at which the Mercator
C                          projection cylinder intersects the earth.
C                    10    Reserved. set to 0.
C                    11    Scanning mode flags (Code Table 8).
C                    12    Number of vertical coordinate parameters.
C                    13    Di - i direction grid length.
C                    14    Dj - j direction grid length.
C                 15-16    Reserved. Set to 0.
C                    17    0 , Regular grid.
C                          1 , Quasi-regular (reduced) grid.
C                    18    Earth flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Earth assumed spherical with
C                                    radius of 6367.47 km.
C                            64      Earth assumed oblate spheroidal
C                                    with size as determined by IAU in
C                                    1965 :
C                                    (6378.160km,6356.775km,f=1/297.0)
C
C                    19    Components flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Resolved u and v components of
C                                    vector quantities relative to
C                                    easterly and northerly directions.
C
C                             8      Resolved u and v components of
C                                    vector quantities relative to the
C                                    defined grid in the direction of
C                                    increasing x and y (or i and j)
C                                    coordinates respectively.
C
C                 20-22    Reserved. Set to 0.
C
C                    Notes   1) Grid lengths are in units of metres,
C                               at the parallel specified by Latin.
C
C
C
C
C
C                   Word   Contents for Lambert conformal, secant or
C                          tangent, conical or bi-polar (normal or
C                          oblique) or
C                          Albers equal-area, secant or tangent,
C                          conical or bi-polar (normal or oblique).
C                   ----   --------------------------------------------
C                     1    Data representation type (Code Table 6).
C                     2    Nx - Number of points along X-axis.
C                     3    Ny - Number of points along Y-axis.
C                     4    La1 - Latitude of first grid point.
C                     5    Lo1 - Longitude of first grid point.
C                     6    Resolution flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Direction increments not given.
C                           128      Direction increments given.
C
C                     7    LoV - Orientation of the grid ie the  East
C                          longitude of the meridian which is parallel
C                          to the Y-axis along which latitude increases
C                          as the Y-coordinate increases.
C                     8    Reserved. Set to 0.
C                     9    Dx - X-direction grid length.
C                    10    Dy - Y-direction grid length.
C                    11    Scanning mode flag (Code Table 8).
C                    12    Number of vertical coordinate parameters.
C                    13    Projection centre flag.
C                            0 , North pole is on projection plane.
C                                Only one projection centre is used.
C                          128 , South pole is on projection plane.
C                                Only one projection centre is used.
C                           64 , North pole is on projection plane.
C                                Projection is bi-polar and symmetric.
C                          192 , South pole is on projection plane.
C                                Projection is bi-polar and symmetric.
C                    14    Latin 1 - First latitude from the pole at
C                          which the secant cone cuts the sphere.
C                    15    Latin 2 - Second latitude from the pole at
C                          which the secant cone cuts the sphere.
C                    16    Reserved. Set to 0.
C                    17    0 , Regular grid.
C                          1 , Quasi-regular (reduced) grid.
C                    18    Earth flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Earth assumed spherical with
C                                    radius of 6367.47 km.
C                            64      Earth assumed oblate spheroidal
C                                    with size as determined by IAU in
C                                    1965 :
C                                    (6378.160km,6356.775km,f=1/297.0)
C
C                    19    Components flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Resolved u and v components of
C                                    vector quantities relative to
C                                    easterly and northerly directions.
C
C                             8      Resolved u and v components of
C                                    vector quantities relative to the
C                                    defined grid in the direction of
C                                    increasing x and y (or i and j)
C                                    coordinates respectively.
C
C                    20    Latitude of the southern pole.
C                    21    Longitude of the southern pole.
C                    22    Reserved. Set to 0.
C
C                    Notes   1) Grid lengths are in metres, at the 60-
C                               degree parallel nearest to the pole on
C                               the projection plane.
C
C
C
C
C
C                   Word   Contents for Space view perspective
C                          or orthographic.
C                   ----   ---------------------------------------
C                     1    Data representation type (Code Table 6).
C                     2    Nx - Number of points along x-axis.
C                     3    Ny - Number of points along y-axis.
C                     4    Lap - Latitude of sub-satellite point.
C                     5    Lop - Longitude of sub-satellite point.
C                     6    Resolution flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Direction increments not given.
C                           128      Direction increments given.
C
C                     7    dx - Apparent diameter of the earth in
C                          grid lengths in the x direction.
C                     8    dy - Apparent diameter of the earth in
C                          grid lengths in the y direction.
C                     9    Xp X-coordinate of sub-satellite point
C                    10    Yp Y-coordinate of sub-satellite point
C                    11    Scanning mode flag (Code Table 8).
C                    12    Number of vertical coordinate parameters.
C                    13    The orientation of the grid.
C                    14    nr - the altitude of the camera from the
C                          earth's centre.
C                          For orthographic view from infinite
C                          distance 16777215.
C                    15    Xo - X coordinate of origin of sector
C                               image.
C                    16    Yo - Y coordinate of origin of sector
C                               image.
C                    17    0 , Regular grid.
C                          1 , Quasi-regular (reduced) grid.
C                    18    Earth flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Earth assumed spherical with
C                                    radius of 6367.47 km.
C                            64      Earth assumed oblate spheroidal
C                                    with size as determined by IAU in
C                                    1965 :
C                                    (6378.160km,6356.775km,f=1/297.0)
C
C                    19    Components flag.
C                          Valid values are :-
C
C                          Decimal
C                          value     Meaning
C                          -----     -------
C                             0      Resolved u and v components of
C                                    vector quantities relative to
C                                    easterly and northerly directions.
C
C                             8      Resolved u and v components of
C                                    vector quantities relative to the
C                                    defined grid in the direction of
C                                    increasing x and y (or i and j)
C                                    coordinates respectively.
C
C                 20-22    Reserved. Set to 0.
C
C
C
C
C
C               PSEC2      - Real parameters for Section 2 (Grid
C                            Definition Section) of GRIB Code.
C                            Real array of at least 10 + nn words, where
C                            nn is the number of vertical coordinate
C                            parameters.
C
C                   Word   Contents.
C                   ----   --------------------------------------------
C                     1      Angle of rotation.
C                     2      Stretching factor.
C                   3-10     Reserved. Set to 0.
C                  11-nn     Vertical coordinate parameters.
C                            Number given in KSEC2(12)
C
C
C
C
C
C               KSEC3      - Integer parameters for Section 3 (Bit Map
C                            Section) of GRIB code.
C                            Integer array of at least 2 words.
C
C                   Word   Contents.
C                   ----   --------------------------------------------
C                     1      0 , Bit map included in the GRIB message.
C                                Binary data array (PSEC4) contains the
C                                missing data indicator at the points
C                                where no data is given.
C                            Non-zero, Number of predetermined bit-map.
C                                Bit map is not included in the message.
C                                Binary data array contains only valid
C                                data values.
C
C                     2      The value used to indicate missing data in
C                            an integer binary data array is indicated
C                            here.
C                            This value is user supplied for both
C                            coding and decoding.
C
C
C
C
C
C               PSEC3      - Real parameters for Section 3 (Bit Map
C                            Section) of GRIB code.
C                            Real array of at least 2 words.
C
C                   Word   Contents.
C                   ----   --------------------------------------------
C                     1      Not used.
C
C                     2      The value used to indicate missing data in
C                            a real binary data array is indicated here.
C                            This value is user supplied for both
C                            coding and decoding.
C
C
C
C
C
C               KSEC4      - Integer parameters for Section 4 (Binary
C                            Data Section) of GRIB code.
C                            Integer array of at least 42 words.
C
C                   Word   Contents.
C                   ----   --------------------------------------------
C                     1    Number of data values in array PSEC4 to be
C                          packed in GRIB code or which have been
C                          unpacked from GRIB code. Where a bit-map
C                          is used this number includes the number of
C                          mising data values.
C
C                       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C                       !                                              !
C                       ! If this number is NEGATIVE, it indicates     !
C                       ! ENTIRE FIELD IS MISSING. All values in PSEC4 !
C                       ! are 0. This is an ECMWF convention - coded   !
C                       ! data has scale factor, exponent and mantissa !
C                       ! of reference value with all bits set to 1.   !
C                       !                                              !
C                       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
C                     2    Number of bits used for each packed value.
C                     3    Type of data. Used only if Section 2 is
C                          not included when coding data.
C                            0 - Grid point data.
C                          128 - Spherical harmonic coefficients.
C                     4    Type of packing.
C                            0 - Simple packing.
C                           64 - Complex or second order packing.
C                                (Not implemented)
C                     5    Data representation.
C                            0 - Floating point data.
C                           32 - Integer data.
C                     6    Additional flags indicator.
C                            0 - No additional flags.
C                           16 - additional flags.
C                     7    Reserved. Set to 0.
C                     8    Number of values indicator.
C                            0 - Single datum at each grid point.
C                           64 - Matrix of values at each grid point.
C                     9    Secondary bit maps indicator.
C                            0 - No secondary bit maps.
C                           32 - Secondary bit maps present.
C                    10    Values width indicator.
C                            0 - Second order values constant width.
C                           16 - Second order values different widths.
C                                (Not implemented)
C                    11    Number of bits for second order values,
C                          when of constant width.
C                                (Not implemented)
C                 12-15    Reserved for WMO reserved flag fields.
C                          Set to 0.
C                 12-33    Reserved. Set to 0.
C
C                          Words 34 to 42 are used only for the 'X'
C                          function. Scanning mode must be from West
C                          to East and from North to South.
C                    34    Number of points (maximum 4) from which
C                          data is to be unpacked.
C                    35    Number of latitude row of first value.
C                    36    Number of longitude point of first value.
C                    37    Number of latitude row of second value.
C                    38    Number of longitude point of second value.
C                    39    Number of latitude row of third value.
C                    40    Number of longitude point of third value.
C                    41    Number of latitude row of fourth value.
C                    42    Number of longitude point of fourth value.
C
C                          For grid point packing, with a matrix of
C                          values at each grid point, words 50 to
C                          50+NC1+NC2 are used as follows.
C                    50    First dimension (rows) of each matrix.
C                    51    Second dimension (columns) of each matrix.
C                    52    First dimension coordinate values definition
C                          See Code Table 12.
C                    53    NC1- Number of coefficients or values used to
C                          specify first dimension coordinate function.
C                    54    Second dimension coordinate values definition
C                          See Code Table 12.
C                    55    NC2- Number of coefficients or values used to
C                          specify second dimension coordinate function.
C                    56    First dimension physical significance. See
C                          Code Table 13.
C                    57    Second dimension physical significance. See
C                          Code Table 13.
C               58 - 59    Reserved. Set to 0.
C
C                          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C                          !                                           !
C                          ! In the WMO specification the following    !
C                          ! fields are integer values. ECMWF uses     !
C                          ! floating point values for the wave models !
C                          ! so these fields contain real values on    !
C                          ! both input and output.
C                          !                                           !
C                          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
C         60 - (59+NC1)    Coefficients to define first dimension
C                          coordinate values in functional form, or the
C                          the explicit coordinate values.
C (60+NC1)-(59+NC1+NC2)    Coefficients to define second dimension
C                          coordinate values in functional form, or the
C                          the explicit coordinate values.
C
C
C
C
C
C               PSEC4      - Array of data values to be packed in GRIB
C                            code or which have been unpacked. Where a
C                            bit-map is included in the GRIB message
C                            this array contains missing data indicator
C                            ( value supplied by the user in PSEC3(2)
C                            or KSEC3(2) ) at the appropriate places.
C
C                            Although declared as real in GRIBEX this
C                            can be an array of integer data. The value
C                            in KSEC4(5) indicates whether data is in
C                            integer or floating point format.
C
C                        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C                        !                                            !
C                        !   When CODING data, PSEC4 is OVERWRITTEN.  !
C                        !                                            !
C                        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
C               Output parameters for coding function.
C               Input Parameters for decoding functions.
C               -----------------------------------------
C
C               KGRIB      - Array containing GRIB coded data.
C
C               KWORD      - Number of words of KGRIB occupied by
C                            coded data. Output parameter for coding
C                            function only. Not required as input
C                            for decoding.
C
C               Output Parameters for all functions.
C               -----------------------------------
C
C               KSEC0      - Word 1 contains number of octets in
C                            GRIB message (not including padding to
C                            a word boundary or rounding to a multiple
C                            of 120 octets).
C                          - Word 2 contains GRIB edition number.
C
C               KRET       - Return code.
C
C                            Informative codes for decoding functions.
C
C                            -2  , Bit-map encountered with all bits
C                                  set to 1. Array PSEC4 contains all
C                                  real data values.
C                            -3  , Predetermined bit-map encountered.
C                                  Data has not been fully decoded ie
C                                  array PSEC4 contains only real data
C                                  values. The user must use this data
C                                  in conjunction with the defined
C                                  bit-map.
C                            -4  , Bit-map encountered. The data has
C                                  been fully decoded ie array PSEC4
C                                  contains real values and missing
C                                  data indicators where appropriate.
C                            -5  , Bit-map encountered. The data has
C                                  not been decoded. This return code
C                                  is set only by the 'Z' function.
C                            -6  , ECMWF pseudo-grib data encountered.
C
C                            Error codes.
C
C                            0   , No error encountered.
C                            201 , Invalid function requested.
C                            202 , Number of bits per data value exceeds
C                                  word length.
C                            203 , Missing data indicated and data field
C                                  contains non-zero values.
C
C                            301 , Error in inserting/extracting
C                                  letters GRIB.
C                            302 , Error extracting length of GRIB
C                                  message.
C                            303 , Error inserting/extracting GRIB
C                                  Edition Number.
C                            304 , Error extracting octets 22 and 23
C                                  Experimental Edition check.
C                            305 , Input data is not GRIB or pseudo-
C                                  grib.
C                            401 , Error inserting/extracting length of
C                                  Section 1.
C                            402 , Error inserting/extracting Parameter
C                                  Version Number.
C                            403 , Error inserting/extracting six fields
C                                  from Identification of Centre to
C                                  Indicator of type of level.
C                            404 , Error inserting/extracting Height,
C                                  pressure, etc of levels.
C                            405 , Error inserting/extracting six fields
C                                  from Year of century to Indicator
C                                  of unit of time range.
C                            406 , Error inserting/extracting Period of
C                                  time.
C                            407 , Error inserting/extracting time range
C                                  indicator.
C                            408 , Error inserting/extracting number
C                                  averaged.
C                            409 , Error inserting/extracting number
C                                  missing from averages etc.
C                            410 , Error inserting/extracting century of
C                                  data or reserved field.
C                            411 , Error inserting/extracting units
C                                  decimal scale factor.
C                            412 , Error inserting/extracting ECMWF
C                                  local data.
C                            499 , Error found when checking values for
C                                  Section 1 against valid GRIB values.
C
C                            501 , Error inserting/extracting length of
C                                  Section 2.
C                            502 , Error inserting/extracting number of
C                                  Vertical coordinate parameters.
C                            503 , Error inserting/extracting location
C                                  of List of vertical coordinate
C                                  parameters or List of numbers of
C                                  points.
C                            504 , Error inserting/extracting data
C                                  representation type.
C                            505 , Error inserting/extracting number of
C                                  points along a parallel or meridian.
C                            506 , Error inserting/extracting latitude
C                                  or longitude of first grid point.
C                            507 , Error inserting/extracting components
C                                  flag.
C                            508 , Error inserting/extracting latitude
C                                  or longitude of last grid point.
C                            509 , Error inserting/extracting i
C                                  direction increment.
C                            510 , Error inserting/extracting number of
C                                  parallels between pole and Equator.
C                            511 , Error inserting/extracting scanning
C                                  mode flags.
C                            513 , Error inserting/extracting j
C                                  direction increment.
C                            514 , Error inserting/extracting J,K,M
C                                  pentagonal resolution parameters.
C                            515 , Error inserting/extracting
C                                  representation type or mode.
C                            517 , Error inserting/extracting latitude
C                                  or longitude of southern pole.
C                            518 , Error inserting/extracting angle
C                                  of rotation.
C                            519 , Error inserting/extracting latitude
C                                  or of pole of stretching.
C                            520 , Error inserting/extracting
C                                  stretching factor.
C                            521 , Error inserting/extracting
C                                  vertical coordinate parameters.
C                            522 , Error inserting/extracting list of
C                                  numbers of points.
C                            523 , Error inserting/extracting number of
C                                  points along X or Y axis.
C                            524 , Error inserting/extracting X or Y
C                                  axis grid lengths.
C                            525 , Error inserting/extracting Projection
C                                  centre flag.
C                            526 ,  Error inserting/extracting latitude
C                                  or  longitude of sub-satellite point.
C                            527 , Error inserting/extracting diameter
C                                  of the earth in x or y direction.
C                            528 , Error inserting/extracting X or Y
C                                  coordinate of sub-satellite point.
C                            529 , Error inserting/extracting orientatio
C                                  of the grid or camera angle.
C                            530 , Error inserting/extracting X or Y
C                                  coordinates of origin of sector.
C                            598 , Representation type not catered for.
C                            599 , Error found when checking values for
C                                  Section 2 against valid GRIB values.
C                            601 , Error inserting/extracting length of
C                                  Section 3.
C                            602 , Error inserting/extracting number of
C                                  unused bits at end of section 3.
C                            603 , Error inserting/extracting bit-map
C                                  reference table.
C                            604 , Error inserting/extracting primary
C                                  Bit-map.
C                            605 , Cannot convert Quasi-regular
C                                  Gaussian grid with a bit-map.
C                            699 , Error found when checking values for
C                                  Section 3 against valid GRIB values.
C                            701 , Error inserting/extracting length of
C                                  Section 4.
C                            705 , Only simple packing catered for.
C                            706 , Error in extracting section 4 flag
C                                  field.
C                            707 , Error inserting/extracting scale
C                                  factor.
C                            708 , Error inserting/extracting reference
C                                  value.
C                            709 , Error inserting/extracting number of
C                                  bits per data value.
C                            710 , Output array too small.
C                            711 , Error inserting/extracting real
C                                  coefficient.
C                            712 , Error inserting/extracting data
C                                  values.
C                            713 , Error inserting/extracting flag
C                                  and unused bit field.
C                            714 , Function is 'X' and number of
C                                  values is illegal.
C                            715 , Function is 'X' and scanning mode is
C                                  not North to South and West to East.
C                            716 , Function is 'X' and field is not
C                                  Gaussian or Latitude/longitude grid.
C                            717 , Function is 'X' and a bit-map is
C                                  included.
C                            720 , Error inserting/extracting octet
C                                  number at which packed data begins.
C                            721 , Error inserting/extracting extended
C                                  extended flag field.
C                            722 , Error inserting/extracting first or
C                                  second dimension of matrix.
C                            723 , Error inserting/extracting six fields
C                                  from first dimension coordinate value
C                                  onwards.
C                            724 , Error inserting/ectracting first or
C                                  second dimension coefficients.
C                            725 , Error inserting secondary bit-maps.
C                            799 , Error found when checking values for
C                                  Section 4 against valid GRIB values.
C                            801 , Error inserting/extracting 7777 group
C                            802 , Error inserting/extracting length of
C                                  GRIB message.
C                            805 , End of message 7777 group not found.
C                            806 , Error in extracting primary or
C                                  secondary bit maps.
C
C     Method.
C     -------
C
C           Input data packed in GRIB code in accordance with
C           parameters given or set by user or fully or partially
C           unpacked, depending on function used.
C
C     Externals.
C     ----------
C
C           ABORTX
C           CONFP3
C           DECFP2
C           ECLOC1
C           EXSCAL
C           EXTMAP
C           GRCHK1
C           GRCHK2
C           GRCHK3
C           GRCHK4
C           GRPRS0
C           GRPRS1
C           GRPRS2
C           GRPRS3
C           GRPRS4
C           INSCAL
C           INSMP1
C           INSMP2
C           INXBIT
C           MAXMIN
C           MAXMN2
C           QU2REG
C           RORINT
C           SETPAR
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes for GRIB definition.
C           WMO Publication No. 9, Volume B, for grid catalogue numbers.
C
C     Comments.
C     ---------
C
C               All machine dependent code is in 3 low level routines.
C               Versions of these exist for the VAX, CYBER, IBM
C               and SUN workstation, as well as the CRAY.
C               INXBIT - contains calls to the routines GBYTE(S)
C                        and SBYTE(S) or their equivalents.
C               SETPAR - to set number of bits in the computer word
C                        and largest negative number.
C               ABORTX - to terminate execution of the job.
C
C               This is not a full implementation of GRIB Code
C               Edition 1. This routine codes/decodes regular
C               latitude/longitude grids, regular and quasi-regular
C               Gaussian grids, spherical harmonic , Space view
C               perspective or orthographic and Polar
C               Stereographic data. Grids may be rotated, stretched
C               or rotated and stretched, with or without primary
C               and secondary bit-maps.
C               Only simple packing of data (real or integer) is
C               allowed. Matrices of values at grid points are
C               supported and the additional flag field is allowed.
C
C               Apart from the values which can be passed to  this
C               routine, other values are held in a common area and
C               are used by default, unless changed by calls to the
C               appropriate routines before calling GRIBEX. The
C               following defaults are used. They have been selected
C               to facilitate the most frequent usage at ECMWF and
C               to ease the transition to the next version of the
C               GRIB code.
C
C               1) By default debug printout is switched off.
C                  CALL GRSDBG (I) where
C                              I = Non-zero to switch on debug printout.
C                                  0, to switch off debug printout.
C
C               2) By default the reference value used is the minimum
C                  of the data values supplied.
C                  CALL GRSREF (ZREF) to change the value, where ZREF
C                  is real and the required value.
C
C               3) By default GRIB messages are rounded to a
C                  multiple of 120 octets.
C                  CALL GRSRND (I) where
C                              I = 0, to switch off rounding.
C                                  Non-zero to switch on rounding.
C
C               4) By default, the values given  are checked for
C                  consistency with GRIB code values as currently
C                  defined, when coding data. Data values are never
C                  checked.
C                  CALL GRSVCK (I) where
C                              I = 0, to switch off checking.
C                                  Non-zero to switch on checking.
C
C               Ancillary print routines are available for the
C               various sections of the GRIB code.
C
C               CALL GRPRS0 (KSEC0) To print section 0.
C
C               CALL GRPRS1 (KSEC0,KSEC1) To print section 1.
C
C               CALL GRPRS2 (KSEC0,KSEC2,PSEC2) To print section 2.
C
C               CALL GRPRS3 (KSEC0,KSEC3,PSEC3) To print section 3.
C
C               CALL GRPRS4 (KSEC0,KSEC4,PSEC4) To print section 4.
C
C           Routine contains Sections 0 to 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      25.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      09.07.91
C           Functions 'R' and 'L' added.
C           Release 1 of software.
C
C           J. Hennessy      ECMWF      14.08.91
C           Functions 'S' and 'X' added.
C
C           J. Hennessy      ECMWF      23.08.91
C           Bit-map handling added.
C
C           J. Hennessy      ECMWF      04.09.91
C           Polar stereographic representation added.
C           Flag bit handling modified. Various bugs fixed.
C
C           J. Hennessy      ECMWF      11.09.91
C           Function 'M' added.
C
C           J. Hennessy      ECMWF      24.09.91
C           Space view perspective representation added.
C
C           J. Hennessy      ECMWF      01.10.91
C           Integer data handling added. Length of GRIB message
C           for Experimental Edition and Edition 0 included
C           when function 'I' is used.
C
C           J. Hennessy      ECMWF      25.10.91
C           When decoding data with bit-maps, include the number of
C           missing data values in the number of values decoded.
C           Release 2 of software.
C
C           J. Hennessy      ECMWF      30.10.91
C           Check for ECMWF pseudo-grib data made specific for
C           parameter numbers 127 and 128.
C           Bug in 'X' function fixed.
C
C           J. Hennessy      ECMWF      22.11.91
C           A number of machine dependent features removed.
C           Bug fixed in Polar Stereographic representation.
C           Release 3 of software.
C
C           J. Hennessy      ECMWF      23.01.92
C           Handling of missing fields modified.
C           Print of sections 2 and 3 suppressed, if not used.
C
C           J. Hennessy      ECMWF      21.07.92
C           Consistency checks moved from end to start of sections.
C           Secondary bit-maps and matrix of values at each grid
C           point  and additional flag field added.
C           X and Y coordinates of origin of sector image added
C           to space view perspective representation.
C           Release 4 of software.
C
C           J. Hennessy      ECMWF      24.09.92
C           Bugfix. KSEC4(3) set to 0 before checking type of data.
C
C           J. Hennessy      ECMWF      12.10.92
C           Check for 'GRIB` added when decoding data.
C           Return correct error code, if 7777 group not found and
C           GRIB message contains bit-maps.
C
C           J. Hennessy      ECMWF      06.11.92
C           ECMWF use of part of Section 1 reserved for local use.
C           Release 5 of software.
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      CHARACTER*(*) HOPER
C
      CHARACTER*1   YFUNC
      CHARACTER*1   YTEMP
C
      INTEGER I
      INTEGER IBLEN
      INTEGER IBITS
      INTEGER IBMAP
      INTEGER IBMAP2
      INTEGER IBYTEX
      INTEGER ICOUNT
      INTEGER IEXP
      INTEGER IFLAG
      INTEGER IFLAGX
      INTEGER IFPT
      INTEGER IGRIB
      INTEGER IKEEP
      INTEGER IL
      INTEGER ILALO
      INTEGER ILEN
      INTEGER ILENF
      INTEGER ILEN1
      INTEGER ILEN2
      INTEGER ILEN3
      INTEGER ILEN4
      INTEGER IMANT
      INTEGER IMISNG
      INTEGER IMISS
      INTEGER IMODAY
      INTEGER INC
      INTEGER INIL
      INTEGER INITAL
      INTEGER INOLAT
      INTEGER INOLNG
      INTEGER INSPT
      INTEGER INUB
      INTEGER INUM
      INTEGER IOFF
      INTEGER IPARM
      INTEGER IPL
      INTEGER IPLEN
      INTEGER IPSEUD
      INTEGER IPVPL
      INTEGER IRESOL
      INTEGER IRET
      INTEGER ISBMAP
      INTEGER ISCALE
      INTEGER ISIGN
      INTEGER ISINT
      INTEGER ISKALE
      INTEGER ISKIP
      INTEGER ITEMP
      INTEGER ITRND
      INTEGER IVALS
      INTEGER I7777
C
      INTEGER JPEDNO
      INTEGER JPLEN1
C
      INTEGER J202
      INTEGER J204
      INTEGER J205
      INTEGER J206
      INTEGER J207
      INTEGER J501
      INTEGER J530
      INTEGER J711
      INTEGER J720
      INTEGER J732
      INTEGER J733
      INTEGER J736
      INTEGER J802
C
      INTEGER KGRIB
      INTEGER KLENG
      INTEGER KLENP
      INTEGER KRET
      INTEGER KRETA
      INTEGER KRETB
      INTEGER KSEC0
      INTEGER KSEC1
      INTEGER KSEC2
      INTEGER KSEC3
      INTEGER KSEC4
      INTEGER KWORD
C
      INTEGER NDBG
      INTEGER NFREF
      INTEGER NRND
      INTEGER NUSER
      INTEGER NVCK
C
      REAL    FREF
C
      REAL    PSEC2
      REAL    PSEC3
      REAL    PSEC4
C
      REAL    ZMAX
      REAL    ZMIN
      REAL    ZMISNG
      REAL    ZMSVAL
      REAL    ZREAL
      REAL    ZREF
      REAL    ZS
      REAL    ZSCALE
      REAL    ZTEMP
C
C     GRIB code version number used in coding data.
C
      PARAMETER (JPEDNO=1)
C
C     Length (in octets) used for Section 1, when coding data.
C
      PARAMETER (JPLEN1=28)
C
      DIMENSION IPARM(4)
      DIMENSION ILALO(2)
      DIMENSION KGRIB(*)
      DIMENSION KSEC0(*)
      DIMENSION KSEC1(*)
      DIMENSION KSEC2(*)
      DIMENSION KSEC3(*)
      DIMENSION KSEC4(*)
C
      DIMENSION PSEC2(*)
      DIMENSION PSEC3(*)
      DIMENSION PSEC4(*)
C
      DIMENSION IGRIB(4)
      DIMENSION I7777(4)
C
C     Common area holding various default or user supplied values.
C
      COMMON /GRBCOM/FREF,NFREF,NRND,NDBG,NVCK,NUSER
C
C     Missing data indicator for integer and real values in GRIB code
C     header fields.
C
      EQUIVALENCE (IMISNG,ZMISNG)
C
      EQUIVALENCE (ZREAL,ISINT)
C
      SAVE IGRIB
      SAVE I7777
      SAVE INITAL
      SAVE IBITS
      SAVE IMISNG
C
C     Characters GRIB and 7777 in Ascii for use in Sections 0 and 5
C     of GRIB code.
C
      DATA IGRIB /71,82,73,66/
      DATA I7777 /55,55,55,55/
C
C     First call flag.
C
      DATA INITAL /0/
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set initial values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
C*    Set number of bits per computer word and missing data
C     indicator, if first time through.
C
      IF (INITAL.EQ.0)
     C   THEN
             CALL SETPAR (IBITS,IMISNG,NDBG)
             INITAL = 1
         ENDIF
C
C*    Set default values for parameters in common area, if values
C     not already set , either on previous call or by user via calls
C     to the GRS--- routines.
C
      IF (NUSER.NE.11041967)
     C   THEN
C
C            Set all default values.
C
C            User supplied reference value.
C
             FREF   = 0.0
C
C            Reference value supplied by user flag. Set to off.
C
             NFREF  = 0
C
C            Set rounding to 120 bytes on.
C
             NRND   = 1
C
C            Set debug print off.
C
             NDBG   = 0
C
C            Set GRIB value checking on.
C
             NVCK   = 1
C
C            Mark common area values set.
C
             NUSER  = 11041967
         ENDIF
C
C*    When coding, print input parameters, if required.
C
      IF (NDBG.EQ.1)
     C   THEN
             WRITE (*,*) ' GRIBEX : Section 1.'
             WRITE (*,*) '          Input values used -'
             WRITE (*,9001) KLENG
             WRITE (*,9002) KLENP
             WRITE (*,*) ' '
             IF (HOPER.EQ.'C'.OR.HOPER.EQ.'M')
     C          THEN
                    KSEC0(2) = JPEDNO
                    CALL GRPRS1 (KSEC0,KSEC1)
C
C                   Print section 2 if present.
C
                    IF (KSEC1(5).EQ.128.OR.KSEC1(5).EQ.192)
     C                 CALL GRPRS2 (KSEC0,KSEC2,PSEC2)
C
C                   Print section 3 if present.
C
                    IF (KSEC1(5).EQ.64.OR.KSEC1(5).EQ.192)
     C                 CALL GRPRS3 (KSEC0,KSEC3,PSEC3)
                    CALL GRPRS4 (KSEC0,KSEC4,PSEC4)
                ENDIF
         ENDIF
C
C     Reset return code to 0, retaining input value to decide
C     on abort / no abort, if error encountered later.
C
      IRET   = KRET
      KRET   = 0
C
C     IPSEUD is used to indicate pseudo-GRIB data encountered,
C     when decoding.
C     ISBMAP is the bit-map section flag and indicates what decoding
C     has been done on bit-maps and data.
C     See informative return codes for KRET when decoding.
C
      IPSEUD = 0
      ISBMAP = 0
C
C     Reset bit-pointer to 0.
C
      INSPT = 0
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 . Check input parameters.
C     ----------------------------------------------------------------
C
  200 CONTINUE
C
      IF (NDBG.EQ.1) WRITE (*,*) ' GRIBEX : Section 2.'
C
C*    Check that valid function has been requested.
C
      YFUNC = HOPER
      IF (YFUNC.NE.'C'.AND.YFUNC.NE.'D'.AND.YFUNC.NE.'I'.AND.
     C    YFUNC.NE.'L'.AND.YFUNC.NE.'R'.AND.YFUNC.NE.'S'.AND.
     C    YFUNC.NE.'X'.AND.YFUNC.NE.'Z'.AND.YFUNC.NE.'M')
     C   THEN
             KRET = 201
             WRITE (*,9201) HOPER , KRET
             GO TO 900
         ENDIF
C
C*    Function 'L' returns the length of the GRIB message and
C     GRIB Edition number only, so no array initialisation is
C     necessary.
C
      IF (YFUNC.EQ.'L') GO TO 300
C
C*    Function 'M' is for coding data, and if a bit map is encountered
C     GRIB messages are made a fixed length. HOPER is passed to the
C     bit-map handling routine.
C
      IF (HOPER.EQ.'M') YFUNC = 'C'
C
C*    Function 'I' is for decoding of sections 0, 1 and 2
C     of GRIB code only. Value of HOPER is checked at the start of
C     decoding section 3.
C
      IF (HOPER.EQ.'I') YFUNC = 'D'
C
C*    Function 'R' is the same as 'D', but if a quasi-regular
C     Gaussian is encountered, it is converted to a regular one.
C     Value of HOPER is checked near end of section 8.
C
      IF (HOPER.EQ.'R') YFUNC = 'D'
C
C*    Function 'S' is the same as 'D', but if analysis data in
C     GRIB Experimental Edition is encountered, the time range
C     indicator flag is set to indicate initialised analysis.
C     Value of HOPER is checked  when time range indicator has
C     been extracted.
C
      IF (HOPER.EQ.'S') YFUNC = 'D'
C
C*    Function 'X' is the same as 'D', but only the data
C     at the requested points is unpacked.
C     Value of HOPER is checked prior to unpacking data values.
C
      IF (HOPER.EQ.'X') YFUNC = 'D'
C
C*    Function 'Z' is for decoding only the information which could
C     be handled by the the old decoding routine DECOGB (eg no bit
C     maps) and is used by the new DECOGB interface.
C
      IF (HOPER.EQ.'Z') YFUNC = 'D'
C
C*    Preset some arrays to 0.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            Set array to receive coded GRIB data to 0.
C
             DO 202 J202 = 1,KLENG
                KGRIB(J202) = 0
  202        CONTINUE
C
C*           Check number of bits per data field.
C
             IF (IBITS.LT.KSEC4(2))
     C          THEN
                    KRET = 202
                    WRITE (*,9202) KSEC4(2) , IBITS , KRET
                    GO TO 900
                ENDIF
C
C*           If missing field is indicated, check that data contains
C            all zero values.
C
             IF (KSEC4(1).LT.0)
     C          THEN
                    IMISS = 1
                    ILENF = - KSEC4(1)
                    DO 204 J204 = 1 , ILENF
                       IF (PSEC4(J204).NE.0.0)
     C                    THEN
                              KRET = 203
                              WRITE (*,9203) KRET
                              GO TO 900
                          ENDIF
  204               CONTINUE
                ELSE
                    IMISS = 0
                    ILENF = KSEC4(1)
                ENDIF
C
C            If input data is integer, change it to real.
C
             IF (KSEC4(5).EQ.32) CALL RORINT (PSEC4,PSEC4,ILENF,'R')
C
         ELSE
C
C            Preset arrays to receive section header information to 0.
C            Routine GSBITE resets data array to 0.
C
             DO 205 J205=1,25
                KSEC1(J205) = 0
  205        CONTINUE
C
             DO 206 J206=1,22
                KSEC2(J206) = 0
  206        CONTINUE
C
             DO 207 J207=1,12
                KSEC4(J207) = 0
  207        CONTINUE
C
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 3 . Indicator Section (Section 0) of GRIB code.
C     ----------------------------------------------------------------
C
  300 CONTINUE
C
      IF (NDBG.EQ.1) WRITE (*,*) ' GRIBEX : Section 3.'
C
C*    Octets 1 - 4 : The letters G R I B.
C     Four 8 bit fields.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            Insert fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IGRIB(1),4,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 301
                    WRITE (*,9301) KRET
                    GO TO 900
                ENDIF
         ELSE
C
C            When decoding data, a check is now made on
C            whether letters are actually GRIB.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IPARM(1),4,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 301
                    WRITE (*,9301) KRET
                    GO TO 900
                ENDIF
C
C            Check that 'GRIB' is found where expected.
C
             IF (IPARM(1).EQ.71.AND.IPARM(2).EQ.82.AND.
     C           IPARM(3).EQ.73.AND.IPARM(4).EQ.66) GO TO 310
C
C            ECMWF pseudo-grib data uses 'BUDG' and 'TIDE`.
C
             IF (IPARM(1).EQ.66.AND.IPARM(2).EQ.85.AND.
     C           IPARM(3).EQ.68.AND.IPARM(4).EQ.71) GO TO 310
C
             IF (IPARM(1).EQ.84.AND.IPARM(2).EQ.73.AND.
     C           IPARM(3).EQ.68.AND.IPARM(4).EQ.69) GO TO 310
C
C            Data is not GRIB or pseudo-grib.
C
             KRET = 305
             WRITE (*,9305) KRET
             GO TO 900
C
         ENDIF
C
  310 CONTINUE
C
C*    Octets 5 - 7 : Length of message.
C     One 24 bit field.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            When coding data, skip field. Length is inserted
C            later, when known.
C            Update bit-pointer.
C
             INSPT = INSPT + 24
         ELSE
C
C            Extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC0(1),1,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 302
                    WRITE (*,9302) KRET
                    GO TO 900
                ENDIF
         ENDIF
C
C*    Octet 8 : GRIB Edition Number.
C     One 8 bit field.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            Set value, if coding data.
C
             KSEC0(2) = JPEDNO
C
C            Insert field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC0(2),1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 303
                    WRITE (*,9303) KRET
                    GO TO 900
                ENDIF
C
         ELSE
C
C            Extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC0(2),1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 303
                    WRITE (*,9303) KRET
                    GO TO 900
                ENDIF
C
C*           When decoding or calculating length, previous editions
C            of the GRIB code must be taken into account.
C
C            In the table below, covering sections 0 and 1 of the GRIB
C            code, octet numbering is from the beginning of the GRIB
C            message;
C            * indicates that the value is not available in the code
C            edition;
C            R indicates reserved, should be set to 0;
C            Experimental edition is considered as edition -1.
C
C            GRIB code edition -1 has fixed length of 20 octets for
C            section 1, the length not included in the message.
C            GRIB code edition 0 has fixed length of 24 octets for
C            section 1, the length being included in the message.
C            GRIB code edition 1 can have different lengths for section
C            1, the minimum being 28 octets, length being included in
C            the message.
C
C                                               Octet numbers for code
C                                                        editions
C
C                      Contents.                   -1      0      1
C                      ---------                ----------------------
C            Letters GRIB                          1-4    1-4    1-4
C            Total length of GRIB message.          *      *     5-7
C            GRIB code edition number               *      *      8
C            Length of Section 1.                   *     5-7    9-11
C            Reserved octet (R).                    *      8(R)   *
C            Version no. of Code Table 2.           *      *     12
C            Identification of centre.              5      9     13
C            Generating process.                    6     10     14
C            Grid definition .                      7     11     15
C            Flag (Code Table 1).                   8     12     16
C            Indicator of parameter.                9     13     17
C            Indicator of type of level.           10     14     18
C            Height, pressure etc of levels.      11-12  15-16  19-20
C            Year of century.                      13     17     21
C            Month.                                14     18     22
C            Day.                                  15     19     23
C            Hour.                                 16     20     24
C            Minute.                               17     21     25
C            Indicator of unit of time.            18     22     26
C            P1 - Period of time.                  19     23     27
C            P2 - Period of time                  20(R)   24     28
C            or reserved octet (R).
C            Time range indicator.                21(R)   25     29
C            or reserved octet (R).
C            Number included in average.       22-23(R)  26-27  30-31
C            or reserved octet (R).
C            Number missing from average.         24(R)  28(R)   32
C            or reserved octet (R).
C            Century of data.                       *      *     33
C            Reserved. set to 0.                    *      *     34
C            Decimal scale factor.                  *      *    35-36
C            Reserved. Set to 0.                    *      *    37-48
C            (Need not be present)
C            For originating centre use only.       *      *    49-nn
C            (Need not be present)
C
C*           Identify which GRIB code edition is being decoded.
C
C            In GRIB edition 1, the edition number is in octet 8.
C            In GRIB edition 0, octet 8 is reserved and set to 0.
C            In GRIB edition -1, octet 8 is a flag field and can have a
C            a valid value of 0, 1, 2 or 3.
C
C            However, GRIB edition number 0 has a fixed
C            length of 24, included in the message, for section 1, so
C            if the value extracted from octets 5-7 is 24 and that from
C            octet 8 is 0, it is safe to assume edition 0 of the code.
C
             IF (KSEC0(1).EQ.24.AND.KSEC0(2).EQ.0)
     C          THEN
C
C                   Set bit-pointer back by 32 bits (4 octets).
C
                    INSPT = INSPT - 32
C
C                   Set length of GRIB message to missing data
C                   value.
C
                    KSEC0(1) = IMISNG
C
                    GO TO 400
                ENDIF
C
C            In GRIB Edition -1, octets 22 and 23 are reserved and set
C            to 0. These octets in Edition 1 are the month and the day,
C            and must be non-zero.
C
             ITEMP = 168
             CALL INXBIT (KGRIB,KLENG,ITEMP,IMODAY,1,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 304
                    WRITE (*,9304) KRET
                    GO TO 900
                ENDIF
C
             IF (IMODAY.EQ.0)
     C          THEN
C
C                   Set bit-pointer back by 32 bits (4 octets).
C
                    INSPT = INSPT - 32
C
                    KSEC0(2) = -1
C
C                   Set length of GRIB message to missing data
C                   value.
C
                    KSEC0(1) = IMISNG
C
C                   Set length of section 1 of GRIB code to 20 octets.
C
                    ILEN1 = 20
C
C                   Skip next 4 octets, as they do not exist in
C                   the Experimental Edition of the code. ie
C                   length of Section and Table 2 Version Number.
C
                    GO TO 401
                ENDIF
C
         ENDIF
C
C*    If Grib Edition 1 and only length is required, go to section 9.
C
      IF (YFUNC.EQ.'L') GO TO 900
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 4 . Product Definition Section (Section 1) of GRIB code.
C    -----------------------------------------------------------------
C
  400 CONTINUE
C
      IF (NDBG.EQ.1) WRITE (*,*) ' GRIBEX : Section 4.'
C
C*    Check consistency of values given, with GRIB code, if required.
C
      IF (NVCK.EQ.1.AND.YFUNC.EQ.'C')
     C   THEN
             CALL GRCHK1 (KSEC1,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 499
                    WRITE (*,9499) KRET
                    GO TO 900
                ENDIF
         ENDIF
C
C*    Octets 1 - 3 : Length of Section.
C     One 24 bit field.
C
C     Set value, if coding data.
C
      IF (YFUNC.EQ.'C')
     C   THEN
             ILEN1 = JPLEN1
C
C            Extra octets if ECMWF local use.
C
             IF (KSEC1(24).EQ.1.AND.KSEC1(2).EQ.98)
     C          THEN
C
C                   Definition 1 is 52 octets long.
C
                    ILEN1 = 52
C
C                   Definition 2 is 328 octets long.
C
                    IF (KSEC1(37).EQ.2) ILEN1 = 328
                ENDIF
         ENDIF
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,ILEN1,1,IBITS,
     C             24,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 401
             WRITE (*,9401) KRET
             GO TO 900
         ENDIF
C
C*    Octet 4  : Version Number of Table 2.
C     One 8 bit field.
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC1(1),1,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 402
             WRITE (*,9402) KRET
             GO TO 900
         ENDIF
C
  401 CONTINUE
C
C*    Print length of Section 1, if required.
C
      IF (NDBG.EQ.1) WRITE (*,9101) ILEN1
C
C*    Octet 5  : Identification of centre.
C     Octet 6  : Generating process identification.
C     Octet 7  : Grid definition.
C     Octet 8  : Flag.
C     Octet 9  : Indicator of parameter.
C     Octet 10 : Indicator of type of level.
C                (or satellite identifier)
C     Six 8 bit fields.
C
C     Insert / extract fields.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC1(2),6,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 403
             WRITE (*,9403) KRET
             GO TO 900
         ENDIF
C
C*    Unless coding, fix-up for Experimental Edition and Edition 0
C     of GRIB code.
C
      IF (YFUNC.NE.'C')
     C   THEN
C
C            In GRIB Experimental Edition and Edition 0
C            the International Table Version Number in use was 0.
C            ECMWF has always used its own local table. It is the same
C            for Experimental Edition, Edition 0 and Edition 1 and is
C            local table number 128.
C
             IF (KSEC0(2).LT.1)
     C          THEN
                    IF (KSEC1(2).EQ.98)
     C                 THEN
C
C                          ECMWF data. Local table number.
C
                           KSEC1(1) = 128
                       ELSE
C
C                          International table number.
C
C                          KSEC1(1) = 0 is already preset.
                       ENDIF
                ENDIF
C
C*           Fix-up for flag field, which was different in Experimental
C            Edition.
C
C                         Experimental          Editions 0 and 1
C                         Edition
C
C            Sections     Binary    Decimal     Binary    Decimal
C            included     value     value       value     value
C
C              none       00000000    0         00000000     0
C               2         00000001    1         10000000   128
C               3         00000010    2         01000000    64
C            2 and 3      00000011    3         11000000   192
C
             IF (KSEC0(2).EQ.-1)
     C          THEN
                    IF (KSEC1(5).EQ.1) KSEC1(5) = 128
                    IF (KSEC1(5).EQ.2) KSEC1(5) = 64
                    IF (KSEC1(5).EQ.3) KSEC1(5) = 192
                ENDIF
         ENDIF
C
C*    Once the flag field has been extracted, no further fields
C     from section 1 of the GRIB code are required, when length
C     of GRIB or pseudo-Grib message only is required.
C
      IF (YFUNC.EQ.'L')
     C   THEN
C
C            Length of section 0 + section 1 is 28 octets (224 bits)
C            for GRIB Edition 0 and 24 octets (192 bits) for
C            Experimental edition.
C            Set bit-pointer and jump
C            to extraction of length of section 3.
C
             INSPT = 224
             IF (KSEC0(2).EQ.-1) INSPT = 192
             GO TO 500
        ENDIF
C
C*    Octets 11 - 12 : Height, pressure etc of levels or
C                      satellite spectral band.
C     One 16 bit field or two 8 bit fields.
C
C     For certain levels, no description is necessary, and
C     when decoding the fields are already set to 0.
C
      IF (YFUNC.NE.'C'.AND.(KSEC1(7).LT.8.OR.KSEC1(7).EQ.102))
     C   THEN
C
C            Update bit-pointer and skip extraction.
C            KSEC1(8) and KSEC1(9) already set to 0.
C
             INSPT = INSPT + 16
             GO TO 402
         ENDIF
C
C     Certain level types require that the description occupies
C     both octets.
C     Spectral band occupies both octets.
C
      IF (KSEC1(7).EQ.100.OR.KSEC1(7).EQ.103.OR.
     C    KSEC1(7).EQ.105.OR.KSEC1(7).EQ.107.OR.
     C    KSEC1(7).EQ.109.OR.KSEC1(7).EQ.111.OR.
     C    KSEC1(7).EQ.160.OR.KSEC1(6).EQ.127)
     C   THEN
C
C            One 16 bit field.
C
             INUM     = 1
             IBLEN    = 16
             KSEC1(9) = 0
         ELSE
C
C            Two 8 bit fields.
C
             INUM  = 2
             IBLEN = 8
         ENDIF
C
C     Insert / extract fields.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC1(8),INUM,IBITS,
     C             IBLEN,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 404
             WRITE (*,9404) KRET
             GO TO 900
         ENDIF
C
C*    Fix-up for ECMWF upper-air data incorrectly coded in Experimental
C     Edition.
C
      IF (KSEC0(2).EQ.-1.AND.KSEC1(2).EQ.98)
     C   THEN
             ITEMP = INSPT - 16
             INUM  = 2
             IBLEN = 8
             CALL INXBIT (KGRIB,KLENG,ITEMP,KSEC1(8),INUM,IBITS,
     C             IBLEN,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 404
                    WRITE (*,9404) KRET
                    GO TO 900
                ENDIF
             KSEC1(8) = KSEC1(8) * 32 + KSEC1(9)
             KSEC1(9) = 0
         ENDIF
C
  402 CONTINUE
C
C*    Octet 13 : Year of century.
C     Octet 14 : Month.
C     Octet 15 : Day.
C     Octet 16 : Hour.
C     Octet 17 : Minute.
C     Octet 18 : Indicator of unit of time range..
C     Six 8 bit fields.
C
C     Insert / extract fields.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC1(10),6,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 405
             WRITE (*,9405) KRET
             GO TO 900
         ENDIF
C
C*    Fix-up for unit of time, which was different in Experimental
C     Edition.
C
C
C                  Experimental          Editions 0 and 1
C                  Edition
C
C     Meaning      Decimal               Decimal
C                  value                 value
C
C     Minute       0 or 30                 0
C     Hour         1 or 40                 1
C     Day          2 or 50                 2
C     Month        3 or 60                 3
C     Year         4 or 70                 4
C     Decade       5 or 80                 5
C     Normal         6                     6
C     Century      7 or 90                 7
C     Second         -                   254
C
      IF (KSEC0(2).EQ.-1)
     C   THEN
             IF (KSEC1(15).EQ.90) KSEC1(15) = 7
             IF (KSEC1(15).GT.10) KSEC1(15) = (KSEC1(15) / 10) - 3
         ENDIF
C
C*    Octets 19 - 20 : Period of time.
C     One 16 bit field or two 8 bit fields.
C
      IF (YFUNC.EQ.'C'.AND.KSEC1(18).EQ.10)
     C   THEN
C
C            One 16 bit field.
C
             INUM  = 1
             IBLEN = 16
         ELSE
C
C            Two 8 bit fields.
C
             INUM  = 2
             IBLEN = 8
         ENDIF
C
C     Insert / extract fields.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC1(16),INUM,IBITS,
     C             IBLEN,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 406
             WRITE (*,9406) KRET
             GO TO 900
         ENDIF
C
C*    Octet 21 : Time range indicator.
C     One 8 bit field.
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC1(18),1,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 407
             WRITE (*,9407) KRET
             GO TO 900
         ENDIF
C
C*    When decoding, period of time field and time range
C     indicator may need modification.
C
      IF (YFUNC.NE.'C')
     C   THEN
C
C            When decoding, length of period of time field is known
C            only at this time. If a 16 bit field is indicated, put
C            the two extracted 8-bit fields together.
C
             IF (KSEC1(18).EQ.10)
     C          THEN
C
C                   One 16 bit field.
C
                    KSEC1(16) = KSEC1(16) * 256 + KSEC1(17)
                    KSEC1(17) = 0
                ENDIF
C
C            If data is known to be initialised analysis and GRIB is
C            Experimental Edition, set time range indicator flag.
C
             IF (KSEC1(16).EQ.0.AND.HOPER.EQ.'S'.AND.KSEC0(2).EQ.-1)
     C           KSEC1(18) = 1
C
         ENDIF
C
C*    Octet 22 - 23 : Number averaged.
C     One 16 bit field.
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC1(19),1,IBITS,
     C             16,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 408
             WRITE (*,9408) KRET
             GO TO 900
         ENDIF
C
C*    Octet 24 : Number missing from averages etc.
C     One 8 bit field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC1(20),1,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 409
             WRITE (*,9409) KRET
             GO TO 900
         ENDIF
C
C*    This is the end of Section 1 , if Edition 0 or -1 of GRIB code.
C     Set other fields to be compatible with Edition 1, where possible.
C
      IF (KSEC0(2).LT.1)
     C   THEN
C
C            Century of data.
C
             IF (KSEC1(2).EQ.98)
     C          THEN
C
C                   All ECMWF data in Edition 0 or -1 is 20th century.
C
                    KSEC1(21) = 20
                ELSE
C
C                   Otherwise set century to missing data value.
C
                    KSEC1(21) = IMISNG
                ENDIF
C
C            Reserved field and decimal scale factor field (which
C            was always 0).
C
C            KSEC1(22) and KSEC1(23) already set to 0.
C
             GO TO 499
         ENDIF
C
C*    Octet 25 : Century of data.
C     One 8 bit field.
C
C     When coding, set sign bit if value is negative.
C
      IF (YFUNC.EQ.'C')
     C   THEN
             IF (KSEC1(21).LT.0)
     C          THEN
                    ITEMP = - KSEC1(21)
                    ITEMP = ITEMP + 32768
                ELSE
                    ITEMP = KSEC1(21)
                ENDIF
         ENDIF
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,ITEMP,1,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 410
             WRITE (*,9410) KRET
             GO TO 900
         ENDIF
C
C     When decoding, set sign bit if value is negative.
C
      IF (YFUNC.EQ.'D')
     C   THEN
             IF (ITEMP.GT.32768)
     C          THEN
                    ITEMP = ITEMP - 32768
                    KSEC1(21) = - ITEMP
                ELSE
                    KSEC1(21) = ITEMP
                ENDIF
         ENDIF
C
C*    Octet 26 : Reserved field. (set to 0)
C     One 8 bit field.
C
C     When coding data, array KGRIB is already set to 0.
C     When decoding, KSEC1(22) is already set to 0.
C     Update pointer only.
C
      INSPT = INSPT + 8
C
C*    Octets 27 - 28 : Units decimal scale factor.
C     One 16 bit field.
C
C     When coding, set sign bit if value is negative.
C
      IF (YFUNC.EQ.'C')
     C   THEN
             IF (KSEC1(23).LT.0)
     C          THEN
                    ITEMP = - KSEC1(23)
                    ITEMP = ITEMP + 32768
                ELSE
                    ITEMP = KSEC1(23)
                ENDIF
         ENDIF
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,ITEMP,1,IBITS,
     C             16,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 411
             WRITE (*,9411) KRET
             GO TO 900
         ENDIF
C
C     When decoding, set sign bit if value is negative.
C
      IF (YFUNC.EQ.'D')
     C   THEN
             IF (ITEMP.GT.32768)
     C          THEN
                    ITEMP = ITEMP - 32768
                    KSEC1(23) = - ITEMP
                ELSE
                    KSEC1(23) = ITEMP
                ENDIF
         ENDIF
C
C*    When coding data, the reserved octets 29-40 need not be
C     present and are not included, unless ECMWF local use
C     of octets 41 onwards is indicated.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            When coding data, the reserved octets 29-40 need not
C            be present and are not included, unless ECMWF local
C            use of octets 41 onwards is indicated.
C
             IF (KSEC1(24).EQ.1.AND.KSEC1(2).EQ.98)
     C          THEN
C
C                   Set pointer past reserved octets. These are
C                   already set to 0.
C
                    INSPT = INSPT + 96
C
C                   Insert local ECMWF data.
C
                    CALL ECLOC1 (YFUNC,KSEC1,KGRIB,KLENG,INSPT,
     C                        IBITS,NDBG,KRET)
                    IF (KRET.NE.0)
     C                 THEN
                           KRET = 412
                           WRITE (*,9412) KRET
                           GO TO 900
                       ENDIF
C
                ENDIF
C
         ELSE
C
C            When decoding data the reserved octets are skipped.
C            If local use is not ECMWF use, the local use
C            octets are also skipped.
C            Presence is indicated by length of section > 28 octets.
C
             IF (ILEN1.GT.28.AND.KSEC1(2).EQ.98)
     C          THEN
C
C                   Set pointer past reserved octets.
C
                    INSPT = INSPT + 96
C
C                   Set flag to indicate local use.
C
                    KSEC1(24) = 1
C
C                   Extract local ECMWF data.
C
                    CALL ECLOC1 (YFUNC,KSEC1,KGRIB,KLENG,INSPT,
     C                        IBITS,NDBG,KRET)
                    IF (KRET.NE.0)
     C                 THEN
                           KRET = 412
                           WRITE (*,9412) KRET
                           GO TO 900
                       ENDIF
C
                ELSE
                    IF (ILEN1.GT.28) INSPT = INSPT + (ILEN1-28) * 8
                ENDIF
C
         ENDIF
C
  499 CONTINUE
C
C*    Check for ECMWF pseudo-grib data. This saves calling GRIBEX
C     with function 'I' to check if the data is GRIB data, and another
C     call with function 'D' when GRIB data is found.
C
      IF (YFUNC.NE.'C'.AND.(KSEC1(6).EQ.127.OR.KSEC1(6).EQ.128))
     C   THEN
             IF (KSEC1(1).EQ.128.AND.KSEC1(2).EQ.98)
     C          THEN
C
                    IPSEUD = -6
C
C                   Change function to 'L' so that section 0 is
C                   fully decoded.
C
                    YFUNC = 'L'
                    GO TO 500
C
                ENDIF
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 5 . Grid Description Section (Section 2) of GRIB code.
C     ----------------------------------------------------------------
C
  500 CONTINUE
C
      IF (NDBG.EQ.1) WRITE (*,*) ' GRIBEX : Section 5.'
C
C*    Go to section 6, if no grid description included.
C
      IF (KSEC1(5).EQ.0.OR.KSEC1(5).EQ.64)
     C   THEN
C
C            Set section 2 values to missing data indicator value,
C            if decoding data.
C
             IF (YFUNC.EQ.'D')
     C          THEN
                    DO 501 J501=1,22
                       KSEC2(J501) = IMISNG
  501               CONTINUE
                ENDIF
             GO TO 600
         ENDIF
C
C*    Check consistency of values given, with GRIB code, if required.
C
      IF (NVCK.EQ.1.AND.YFUNC.EQ.'C')
     C   THEN
             CALL GRCHK2 (KSEC1,KSEC2,PSEC2,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 599
                    WRITE (*,9599) KRET
                    GO TO 900
                ENDIF
         ENDIF
C
C*    Octets 1 - 3 : Length of section.
C     One 24 bit field.
C
C     Calculate length of section, if coding data.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            Length is normally 32 + stretched and/or rotated
C            parameters + vertical coordinate parameters + list of
C            numbers of points.
C            (Lambert conformal and Mercator are 42 octets in length,
C            while Space view appears to be 40 !!!!!!!!!!!!!!!!!!)
C
C            Ordinary Grid.
C
             INC = 0
C
C            Space view perspective. !!!!!!!!!!! +10 ????
C
             IF (KSEC2(1).EQ.90) INC = 8
C
C            Rotated grid.
C            (Gaussian, Latitude/longitude or Spherical Harmonics)
C
             IF (KSEC2(1).EQ.10.OR.KSEC2(1).EQ.14.OR.KSEC2(1).EQ.60)
     C           INC = 10
C
C            Stretched grid.
C            (Gaussian, Latitude/longitude or Spherical Harmonics)
C
             IF (KSEC2(1).EQ.20.OR.KSEC2(1).EQ.24.OR.KSEC2(1).EQ.70)
     C           INC = 10
C
C            Stretched and rotated grid.
C            (Gaussian, Latitude/longitude or Spherical Harmonics)
C
             IF (KSEC2(1).EQ.30.OR.KSEC2(1).EQ.34.OR.KSEC2(1).EQ.80)
     C           INC = 20
C
             ILEN2 = 32 + INC + (KSEC2(12)*4) + (KSEC2(17)*2*KSEC2(3))
C
         ENDIF
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,ILEN2,1,IBITS,
     C             24,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 501
             WRITE (*,9501) KRET
             GO TO 900
         ENDIF
C
C*    Print length of Section 2, if required.
C
      IF (NDBG.EQ.1) WRITE (*,9102) ILEN2
C
C*    If only length is required, update bit-pointer and jump
C     to extraction of length of section 3.
C
      IF (YFUNC.EQ.'L')
     C   THEN
             INSPT = INSPT -24 + ILEN2 * 8
             GO TO 600
         ENDIF
C
C*    Octet 4 : NV - number of vertical coordinate parameters.
C     One 8 bit field.
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(12),1,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 502
             WRITE (*,9502) KRET
             GO TO 900
         ENDIF
C
C*    Fixup for Editions -1 and 0 of GRIB code, where number
C     of Vertical Coordinate Parameters must be calculated,
C     as this octet contained the number of unused bits at the
C     end of the section, which by definition of the section
C     always had to be 0.
C
      IF (KSEC0(2).LT.1)
     C   THEN
             KSEC2(12) = ( ILEN2 - 32 ) / 4
         ENDIF
C
C*    Octet 5 : PV - location of list of vertical coordinate parameters,
C                    if any,
C               or
C               PL - location of list of numbers of points, if no PV,
C               or
C               255 - no PV or PL.
C     One 8 bit field.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            Set value, if coding data.
C
C            Neither present is default.
C
             IPVPL = 255
C
C            Vertical coordinate parameters present.
C
             IF (KSEC2(12).NE.0) IPVPL = 32 + INC + 1
C
C            List of number of points present, if no vertical
C            coordinate parameters present and if quasi-regular grid.
C
             IF (KSEC2(17).EQ.1.AND.KSEC2(12).EQ.0) IPVPL = 32 + INC + 1
C
C            Insert field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IPVPL,1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 503
                    WRITE (*,9503) KRET
                    GO TO 900
                ENDIF
C
         ELSE
C
C            If decoding data.
C
C            Extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IPVPL,1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 503
                    WRITE (*,9503) KRET
                    GO TO 900
                ENDIF
C
C            Experimental space view perspective data  received
C            at ECMWF has all 0 bits.
C            0 is illegal for all data types, so change it.
C
             IF (IPVPL.EQ.0) IPVPL = 255
C
C            Neither present, so set regular grid indicator.
C
             IF (IPVPL.EQ.255) KSEC2(17) = 0
C
C            Vertical coordinate parameters present.
C            If the length of section is greater than the
C            end of the vertical coordinate parameters, then
C            there is a list of numbers of points following, so
C            set quasi-regular grid indicator.
C
             IF (KSEC2(12).NE.0)
     C          THEN
                    IPL = 4 * KSEC2(12) + IPVPL - 1
                    IF (IPL.LT.ILEN2) KSEC2(17) = 1
                ENDIF
C
C
C            List of number of points present, no vertical
C            coordinate parameters present, so set quasi-regular
C            grid indicator.
C
             IF (KSEC2(12).EQ.0.AND.IPVPL.NE.255) KSEC2(17) = 1
C
C            Fixup for Editions -1 and 0 of GRIB code, where
C            all grids were regular.
C
             IF (KSEC0(2).LT.1)
     C          THEN
                    KSEC2(17) = 0
                ENDIF
C
         ENDIF
C
C*    Octet 6 : Data representation type.
C     One 8 bit field.
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(1),1,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 504
             WRITE (*,9504) KRET
             GO TO 900
         ENDIF
C
C
C
C
C
C
C
C
C
C
C*    Gaussian grid definition.
C
      IF (KSEC2(1).EQ.4.OR.KSEC2(1).EQ.14.OR.KSEC2(1).EQ.24
     C      .OR.KSEC2(1).EQ.34)
     C   THEN
C
C*           Octets 7 - 8  : Ni - number of points along a parallel.
C            Octets 9 - 10 : Nj - number of points along a meridian.
C            Two 16 bit fields.
C
C            For quasi-regular grids Ni is set to all 1 bits, as
C            the number of points is different on different parallels.
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                   When coding, set to all 1 bits.
C
                    IF (KSEC2(17).EQ.1) KSEC2(2) = 65535
                ENDIF
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(2),2,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 505
                    WRITE (*,9505) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C          THEN
C
C                   When decoding, change 1 bits to missing data value.
C
                    IF (KSEC2(2).EQ.65535) KSEC2(2) = IMISNG
                ENDIF
C
C*           Octets 11 - 13 : La1 - latitude of first grid point.
C            Octets 14 - 16 : Lo1 - longitude of first grid point.
C            Two 24 bit fields.
C
C            When coding data, set sign bit to 1, if value is
C            negative.
C
             IF (YFUNC.EQ.'C')
     C          THEN
                  ILALO(1) = KSEC2(4)
                  ILALO(2) = KSEC2(5)
                  IF (KSEC2(4).LT.0) ILALO(1) = -(KSEC2(4)) + 8388608
                  IF (KSEC2(5).LT.0) ILALO(2) = -(KSEC2(5)) + 8388608
                ENDIF
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,ILALO(1),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 506
                    WRITE (*,9506) KRET
                    GO TO 900
                ENDIF
C
C            When decoding data, if sign bit is 1, value is
C            negative.
C
             IF (YFUNC.EQ.'D')
     C          THEN
                  KSEC2(4) = ILALO(1)
                  KSEC2(5) = ILALO(2)
                  IF (KSEC2(4).GT.8388608)KSEC2(4) = -(KSEC2(4)-8388608)
                  IF (KSEC2(5).GT.8388608)KSEC2(5) = -(KSEC2(5)-8388608)
                ENDIF
C
C*           Octet 17 : Resolution and components flag.
C            One 8 bit field.
C
             IF (YFUNC.EQ.'C') IRESOL = KSEC2(6)+KSEC2(18)+KSEC2(19)
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IRESOL,1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 507
                    WRITE (*,9507) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C          THEN
C
C                   All flag fields are already set to 0, so
C
                    IF (IRESOL.EQ.0) GO TO 510
C
C                   Fix up for flag which was different in Experimental
C                   edition.
C
                    IF (KSEC0(2).EQ.-1.AND.(IRESOL.EQ.1.OR.IRESOL.EQ.
     C                            3)) IRESOL = 128
C
C                   Set Resolution flag.
C
                    IF (IRESOL.GE.128)
     C                 THEN
                           KSEC2(6) = 128
                           IRESOL   = IRESOL - 128
                       ENDIF
C
C                   Set earth flag.
C
                    IF (IRESOL.GE.64)
     C                 THEN
                           KSEC2(18) = 64
                           IRESOL    = IRESOL - 64
                       ENDIF
C
C                   Set components flag.
C
                    KSEC2(19) = IRESOL
C
                ENDIF
C
  510        CONTINUE
C
C*           Octets 18 - 20 : La2 - latitude of last grid point.
C            Octets 21 - 23 : Lo2 - longitude of last grid point.
C            Two 24 bit fields.
C
C            When coding data, set sign bit to 1, if value is
C            negative.
C
             IF (YFUNC.EQ.'C')
     C          THEN
                  ILALO(1) = KSEC2(7)
                  ILALO(2) = KSEC2(8)
                  IF (KSEC2(7).LT.0) ILALO(1) = -(KSEC2(7)) + 8388608
                  IF (KSEC2(8).LT.0) ILALO(2) = -(KSEC2(8)) + 8388608
                ENDIF
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,ILALO(1),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 508
                    WRITE (*,9508) KRET
                    GO TO 900
                ENDIF
C
C            When decoding data, if sign bit is 1, value is
C            negative.
C
             IF (YFUNC.EQ.'D')
     C          THEN
                  KSEC2(7) = ILALO(1)
                  KSEC2(8) = ILALO(2)
                  IF (KSEC2(7).GT.8388608)KSEC2(7) = -(KSEC2(7)-8388608)
                  IF (KSEC2(8).GT.8388608)KSEC2(8) = -(KSEC2(8)-8388608)
                ENDIF
C
C
C*           Octets 24 - 25 : Di - i direction increment.
C            One 16 bit field.
C
C            For quasi-regular grids all Di bits are set to 1, as
C            the increment is different on different parallels.
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                   When coding, set to all 1 bits.
C
                    IF (KSEC2(17).EQ.1) KSEC2(9) = 65535
C
C                   If increments not given, set all bits to 1.
C
                    IF (KSEC2(6).EQ.0) KSEC2(9) = 65535
                ENDIF
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(9),1,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 509
                    WRITE (*,9509) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C          THEN
C
C                   When decoding, change 1 bits to missing data value.
C
                    IF (KSEC2(9).EQ.65535) KSEC2(9) = IMISNG
                ENDIF
C
C*           Octets 26 - 27 : N- number of parallels between a Pole
C            and the Equator.
C            One 16 bit field.
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(10),1,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 510
                    WRITE (*,9510) KRET
                    GO TO 900
                ENDIF
C
C*           Octet 28 : Scanning mode flags.
C            One 8 bit field.
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(11),1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 511
                    WRITE (*,9511) KRET
                    GO TO 900
                ENDIF
C
C            Fix-up for flag which was different in Experimental
C            Edition.
C
             IF (KSEC0(2).EQ.-1.AND.KSEC2(11).EQ.1) KSEC2(11) = 0
C
C*           Octets 29 - 32 : Reserved.
C            Two 16 bit fields.
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                   All bits already set to 0.
C                   No insertion, only update bit pointer.
C
                    INSPT = INSPT + 32
C
                ELSE
C
C                   No extraction, only update bit pointer.
C
                    INSPT = INSPT + 32
C
                ENDIF
C
             GO TO 520
      ENDIF
C
C
C
C
C
C
C
C
C
C
C*    Latitude/longitude grid definition,
C     Equidistant Cylindrical or Plate Carree.
C
      IF (KSEC2(1).EQ.0.OR.KSEC2(1).EQ.10.OR.KSEC2(1).EQ.20
     C      .OR.KSEC2(1).EQ.30)
     C   THEN
C
C*           Octets 7 - 8  : Ni - number of points along a parallel.
C            Octets 9 - 10 : Nj - number of points along a meridian.
C            Quasi-regular grids not catered for.
C            Two 16 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(2),2,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 505
                    WRITE (*,9505) KRET
                    GO TO 900
                ENDIF
C
C*           Octets 11 - 13 : La1 - latitude of first grid point.
C            Octets 14 - 16 : Lo1 - longitude of first grid point.
C            Two 24 bit fields.
C
C            When coding data, set sign bit to 1, if value is
C            negative.
C
             IF (YFUNC.EQ.'C')
     C          THEN
                  ILALO(1) = KSEC2(4)
                  ILALO(2) = KSEC2(5)
                  IF (KSEC2(4).LT.0) ILALO(1) = -(KSEC2(4)) + 8388608
                  IF (KSEC2(5).LT.0) ILALO(2) = -(KSEC2(5)) + 8388608
                ENDIF
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,ILALO(1),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 506
                    WRITE (*,9506) KRET
                    GO TO 900
                ENDIF
C
C            When decoding data, if sign bit is 1, value is
C            negative.
C
             IF (YFUNC.EQ.'D')
     C          THEN
                  KSEC2(4) = ILALO(1)
                  KSEC2(5) = ILALO(2)
                  IF (KSEC2(4).GT.8388608)KSEC2(4) = -(KSEC2(4)-8388608)
                  IF (KSEC2(5).GT.8388608)KSEC2(5) = -(KSEC2(5)-8388608)
                ENDIF
C
C*           Octet 17 : Resolution and components flag.
C            One 8 bit field.
C
             IF (YFUNC.EQ.'C') IRESOL = KSEC2(6)+KSEC2(18)+KSEC2(19)
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IRESOL,1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 507
                    WRITE (*,9507) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C          THEN
C
C                   All flag fields are already set to 0, so
C
                    IF (IRESOL.EQ.0) GO TO 511
C
C                   Fix up for flag which was different in Experimental
C                   edition.
C
                    IF (KSEC0(2).EQ.-1.AND.(IRESOL.EQ.1.OR.IRESOL.EQ.
     C                            3)) IRESOL = 128
C
C                   Set Resolution flag.
C
                    IF (IRESOL.GE.128)
     C                 THEN
                           KSEC2(6) = 128
                           IRESOL   = IRESOL - 128
                       ENDIF
C
C                   Set earth flag.
C
                    IF (IRESOL.GE.64)
     C                 THEN
                           KSEC2(18) = 64
                           IRESOL    = IRESOL - 64
                       ENDIF
C
C                   Set components flag.
C
                    KSEC2(19) = IRESOL
C
                ENDIF
C
  511        CONTINUE
C
C*           Octets 18 - 20 : La2 - latitude of last grid point.
C            Octets 21 - 23 : Lo2 - longitude of last grid point.
C            Two 24 bit fields.
C
C            When coding data, set sign bit to 1, if value is
C            negative.
C
             IF (YFUNC.EQ.'C')
     C          THEN
                  ILALO(1) = KSEC2(7)
                  ILALO(2) = KSEC2(8)
                  IF (KSEC2(7).LT.0) ILALO(1) = -(KSEC2(7)) + 8388608
                  IF (KSEC2(8).LT.0) ILALO(2) = -(KSEC2(8)) + 8388608
                ENDIF
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,ILALO(1),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 508
                    WRITE (*,9508) KRET
                    GO TO 900
                ENDIF
C
C            When decoding data, if sign bit is 1, value is
C            negative.
C
             IF (YFUNC.EQ.'D')
     C          THEN
                  KSEC2(7) = ILALO(1)
                  KSEC2(8) = ILALO(2)
                  IF (KSEC2(7).GT.8388608)KSEC2(7) = -(KSEC2(7)-8388608)
                  IF (KSEC2(8).GT.8388608)KSEC2(8) = -(KSEC2(8)-8388608)
                ENDIF
C
C*           Octets 24 - 25 : Di - i direction increment.
C            One 16 bit field.
C
C            Quasi-regular grids not catered for.
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                  If field not given, set to all bits to 1.
C
                   IF (KSEC2(6).EQ.0) KSEC2(9) = 65535
                ENDIF
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(9),1,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 509
                    WRITE (*,9509) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C          THEN
C
C                   When decoding, change 1 bits to missing data value.
C
                    IF (KSEC2(9).EQ.65535) KSEC2(9) = IMISNG
                ENDIF
C
C
C*           Octets 26 - 27 : Dj - j direction increment.
C            One 16 bit field.
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                  If field not given, set to all bits to 1.
C
                   IF (KSEC2(6).EQ.0) KSEC2(10) = 65535
                ENDIF
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(10),1,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 513
                    WRITE (*,9513) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C          THEN
C
C                   When decoding, change 1 bits to missing data value.
C
                    IF (KSEC2(10).EQ.65535) KSEC2(10) = IMISNG
                ENDIF
C
C
C*           Octet 28 : Scanning mode flags.
C            One 8 bit field.
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(11),1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 511
                    WRITE (*,9511) KRET
                    GO TO 900
                ENDIF
C
C            Fix-up for flag which was different in Experimental
C            Edition.
C
             IF (KSEC0(2).EQ.-1.AND.KSEC2(11).EQ.1) KSEC2(11) = 0
C
C*           Octets 29 - 32 : Reserved.
C            Two 16 bit fields.
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                   All bits already set to 0.
C                   No insertion, only update bit pointer.
C
                    INSPT = INSPT + 32
C
                ELSE
C
C                   No extraction, only update bit pointer.
C
                    INSPT = INSPT + 32
                ENDIF
C
             GO TO 520
      ENDIF
C
C
C
C
C
C
C
C
C
C
C*    Spherical Harmonic format.
C
      IF (KSEC2(1).EQ.50.OR.KSEC2(1).EQ.60.OR.KSEC2(1).EQ.70
     C      .OR.KSEC2(1).EQ.80)
     C   THEN
C
C*           Octets 7 - 8   : J pentagonal resolution parameter.
C            Octets 9 - 10  : K pentagonal resolution parameter.
C            Octets 11 - 12 : M pentagonal resolution parameter.
C            Three 16 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(2),3,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 514
                    WRITE (*,9514) KRET
                    GO TO 900
                ENDIF
C
C*           Octet 13 : Representation type.
C            Octet 14 : Representation mode.
C            Two 8 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(5),2,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 515
                    WRITE (*,9515) KRET
                    GO TO 900
                ENDIF
C
C
C*           Octets 15 - 32 : Reserved.
C            Nine 16 bit fields.
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                   All bits already set to 0.
C                   No insertion, only update bit pointer.
C
                    INSPT = INSPT + 144
C
                ELSE
C
C                   No extraction, only update bit pointer.
C                   KSEC2(7) to KSEC2(11) already set to 0.
C
                    INSPT = INSPT + 144
                ENDIF
C
             GO TO 520
      ENDIF
C
C
C
C
C
C
C
C
C
C
C*    Polar Stereographic.
C
      IF (KSEC2(1).EQ.5)
     C   THEN
C
C*           Octets 7 - 8  : Ni - number of points along X-axis.
C            Octets 9 - 10 : Nj - number of points along Y-axis.
C            Two 16 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(2),2,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 523
                    WRITE (*,9523) KRET
                    GO TO 900
                ENDIF
C
C*           Octets 11 - 13 : La1 - latitude of first grid point.
C            Octets 14 - 16 : Lo1 - longitude of first grid point.
C            Two 24 bit fields.
C
C            When coding data, set sign bit to 1, if value is
C            negative.
C
             IF (YFUNC.EQ.'C')
     C          THEN
                  ILALO(1) = KSEC2(4)
                  ILALO(2) = KSEC2(5)
                  IF (KSEC2(4).LT.0) ILALO(1) = -(KSEC2(4)) + 8388608
                  IF (KSEC2(5).LT.0) ILALO(2) = -(KSEC2(5)) + 8388608
                ENDIF
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,ILALO(1),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 506
                    WRITE (*,9506) KRET
                    GO TO 900
                ENDIF
C
C            When decoding data, if sign bit is 1, value is
C            negative.
C
             IF (YFUNC.EQ.'D')
     C          THEN
                  KSEC2(4) = ILALO(1)
                  KSEC2(5) = ILALO(2)
                  IF (KSEC2(4).GT.8388608)KSEC2(4) = -(KSEC2(4)-8388608)
                  IF (KSEC2(5).GT.8388608)KSEC2(5) = -(KSEC2(5)-8388608)
                ENDIF
C
C*           Octet 17 : Resolution and components flag.
C            One 8 bit field.
C
C            Resolution flag ( KSEC2(6) ) is not applicable.
C
             KSEC2(6) = 0
             IF (YFUNC.EQ.'C') IRESOL = KSEC2(18)+KSEC2(19)
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IRESOL,1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 507
                    WRITE (*,9507) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C          THEN
C
C                   All flag fields are already set to 0, so
C
                    IF (IRESOL.EQ.0) GO TO 513
C
C                   Fix up for flag which was different in Experimental
C                   edition.
C
                    IF (KSEC0(2).EQ.-1.AND.(IRESOL.EQ.1.OR.IRESOL.EQ.
     C                            3)) IRESOL = 128
C
C                   Resolution flag is not applicable.
C
                    IF (IRESOL.GE.128) IRESOL = IRESOL - 128
C
C                   Set earth flag.
C
                    IF (IRESOL.GE.64)
     C                 THEN
                           KSEC2(18) = 64
                           IRESOL    = IRESOL - 64
                       ENDIF
C
C                   Set components flag.
C
                    KSEC2(19) = IRESOL
C
                ENDIF
C
  513        CONTINUE
C
C            Insert / extract field.
C
C             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(6),1,IBITS,
C     C             8,YFUNC,KRET)
C             IF (KRET.NE.0)
C     C          THEN
C                    KRET = 507
C                    WRITE (*,9507) KRET
C                   GO TO 900
C                ENDIF
C
C*           Octets 18 - 20 : LoV - orientation of the grid.
C            One 24 bit field.
C
C            When coding data, set sign bit to 1, if value is
C            negative.
C
             IF (YFUNC.EQ.'C')
     C          THEN
                  ILALO(1) = KSEC2(7)
                  IF (KSEC2(7).LT.0) ILALO(1) = -(KSEC2(7)) + 8388608
                ENDIF
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,ILALO(1),1,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 508
                    WRITE (*,9508) KRET
                    GO TO 900
                ENDIF
C
C            When decoding data, if sign bit is 1, value is
C            negative.
C
             IF (YFUNC.EQ.'D')
     C          THEN
                  KSEC2(7) = ILALO(1)
                  IF (KSEC2(7).GT.8388608)KSEC2(7) = -(KSEC2(7)-8388608)
                ENDIF
C
C*           Octets 21 - 23 : Dx - X direction grid length.
C*           Octets 24 - 26 : Dy - Y direction grid length.
C            Two 24 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(9),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 524
                    WRITE (*,9524) KRET
                    GO TO 900
                ENDIF
C
C*           Octet 27 : Projection centre flag.
C            One 8-bit field.
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(13),1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 525
                    WRITE (*,9525) KRET
                    GO TO 900
                ENDIF
C
C*           Octet 28 : Scanning mode flags.
C            One 8 bit field.
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(11),1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 511
                    WRITE (*,9511) KRET
                    GO TO 900
                ENDIF
C
C            Fix-up for flag which was different in Experimental
C            Edition.
C
             IF (KSEC0(2).EQ.-1.AND.KSEC2(11).EQ.1) KSEC2(11) = 0
C
C*           Octets 29 - 32 : Reserved.
C            Two 16 bit fields.
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                   All bits already set to 0.
C                   No insertion, only update bit pointer.
C
                    INSPT = INSPT + 32
C
                ELSE
C
C                   No extraction, only update bit pointer.
C
                    INSPT = INSPT + 32
C
                ENDIF
C
             GO TO 520
      ENDIF
C
C
C
C
C
C
C
C
C
C
C*    Space view perspective or orthographic.
C
      IF (KSEC2(1).EQ.90)
     C   THEN
C
C*           Octets 7 - 8  : Nx - number of points along X-axis.
C            Octets 9 - 10 : Ny - number of points along Y-axis.
C            Two 16 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(2),2,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 523
                    WRITE (*,9523) KRET
                    GO TO 900
                ENDIF
C
C*           Octets 11 - 13 : Lap - latitude of sub-satellite point.
C            Octets 14 - 16 : Lop - longitude of sub-satellite point.
C            Two 24 bit fields.
C
C            When coding data, set sign bit to 1, if value is
C            negative.
C
             IF (YFUNC.EQ.'C')
     C          THEN
                  ILALO(1) = KSEC2(4)
                  ILALO(2) = KSEC2(5)
                  IF (KSEC2(4).LT.0) ILALO(1) = -(KSEC2(4)) + 8388608
                  IF (KSEC2(5).LT.0) ILALO(2) = -(KSEC2(5)) + 8388608
                ENDIF
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,ILALO(1),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 526
                    WRITE (*,9526) KRET
                    GO TO 900
                ENDIF
C
C            When decoding data, if sign bit is 1, value is
C            negative.
C
             IF (YFUNC.EQ.'D')
     C          THEN
                  KSEC2(4) = ILALO(1)
                  KSEC2(5) = ILALO(2)
                  IF (KSEC2(4).GT.8388608)KSEC2(4) = -(KSEC2(4)-8388608)
                  IF (KSEC2(5).GT.8388608)KSEC2(5) = -(KSEC2(5)-8388608)
                ENDIF
C
C*           Octet 17 : Resolution and components flag.
C            One 8 bit field.
C
C            Resolution flag ( KSEC2(6) ) is not applicable.
C
             IF (YFUNC.EQ.'C') IRESOL = KSEC2(18)+KSEC2(19)
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IRESOL,1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 507
                    WRITE (*,9507) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C          THEN
C
C                   All flag fields are already set to 0, so
C
                    IF (IRESOL.EQ.0) GO TO 514
C
C                   Resolution flag is not applicable.
C
                    IF (IRESOL.GE.128) IRESOL = IRESOL - 128
C
C                   Set earth flag.
C
                    IF (IRESOL.GE.64)
     C                 THEN
                           KSEC2(18) = 64
                           IRESOL    = IRESOL - 64
                       ENDIF
C
C                   Set components flag.
C
                    KSEC2(19) = IRESOL
                ENDIF
C
  514        CONTINUE
C
C*           Octets 18 - 20 : dx Apparent diameter of earth in grid
C                             lengths in x direction.
C            Octets 21 - 23 : dy Apparent diameter of earth in grid
C                             lengths in y direction.
C            Two 24 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(7),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 527
                    WRITE (*,9527) KRET
                    GO TO 900
                ENDIF
C
C*           Octets 24 - 25 : Xp X-coordinate of sub-satellite point.
C            Octets 26 - 27 : Yp Y-coordinate of sub-satellite point.
C            Two 16 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(9),2,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 528
                    WRITE (*,9528) KRET
                    GO TO 900
                ENDIF
C
C*           Octet 28 : Scanning mode flags.
C            One 8 bit field.
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(11),1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 511
                    WRITE (*,9511) KRET
                    GO TO 900
                ENDIF
C
C*           Octets 29 - 31 : The orientation of the grid.
C            Octets 32 - 34 : nr the altitude of the camera.
C            Two 24 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(13),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 529
                    WRITE (*,9529) KRET
                    GO TO 900
                ENDIF
C
C*           Octets 35 - 36 : Xo - X coordinate of origin of sector
C                               image.
C            Octets 37 - 38 : Yo - Y coordinate of origin of sector
C                               image.
C            Two 16 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(15),2,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 530
                    WRITE (*,9530) KRET
                    GO TO 900
                ENDIF
C
C*           Octets 39 - 40 : Reserved.   !!!!!!! 42 ?????????
C            One 16 bit fields.
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                   All bits already set to 0.
C                   No insertion, only update bit pointer.
C
                    INSPT = INSPT + 16
C
                ELSE
C
C                   No extraction, only update bit pointer.
C
                    INSPT = INSPT + 16
C
                ENDIF
C
             GO TO 520
C
         ENDIF
C
C
C
C
C
C
C
C
C
C
C*    Other representation types not yet catered for.
C
      KRET = 598
      WRITE (*,9598) KSEC2(1) , KRET
      GO TO 900
C
C
C
C
C
C
C
C
C
C
C*    Rotation parameters for rotated or stretched and rotated grids.
C     (Gaussian, Latitude/longitude or Spherical Harmonics)
C
  520 CONTINUE
C
      IF (KSEC2(1).EQ.10.OR.KSEC2(1).EQ.30.OR.
     C    KSEC2(1).EQ.14.OR.KSEC2(1).EQ.34.OR.
     C    KSEC2(1).EQ.60.OR.KSEC2(1).EQ.80)
     C   THEN
C
C*           Octets 33 - 35 : Latitude of the southern pole.
C            Octets 36 - 38 : Longitude of the southern pole.
C            Two 24 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(13),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 517
                    WRITE (*,9517) KRET
                    GO TO 900
                ENDIF
C
C*           Octets 39 - 42 : Angle of rotation.
C            One 8 bit and one 24 bit field.
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                   Convert floating point to GRIB representation.
C
                    ITRND = 1
                    CALL CONFP3 (PSEC2(1),IEXP,IMANT,IBITS,ITRND)
                ENDIF
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IEXP,1,IBITS,
     C                    8,YFUNC,KRETA)
             CALL INXBIT (KGRIB,KLENG,INSPT,IMANT,1,IBITS,
     C                    24,YFUNC,KRETB)
             KRET = KRET + KRETB
             IF (KRET.NE.0)
     C          THEN
                    KRET = 518
                    WRITE (*,9518) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C          THEN
C
C                   Convert GRIB representation to floating point.
C
                    CALL DECFP2 (PSEC2(1),IEXP,IMANT)
C
                ENDIF
         ENDIF
C
C*    Stretching parameters for stretched grids.
C     (Gaussian, Latitude/longitude or Spherical Harmonics)
C
      IF (KSEC2(1).EQ.20.OR.KSEC2(1).EQ.24.OR.
     C    KSEC2(1).EQ.70)
     C   THEN
C
C*           Octets 33 - 35 : Latitude of pole of stretching.
C            Octets 36 - 38 : Longitude of pole of stretching.
C            Two 24 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(15),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 519
                    WRITE (*,9519) KRET
                    GO TO 900
                ENDIF
C
C*           Octets 39 - 42 : Stretching factor.
C            One 8 bit and one 24 bit field.
C
             ITRND = 1
             IF (YFUNC.EQ.'C')
C
C               Convert floating point to GRIB representation.
C
     C          CALL CONFP3 (PSEC2(2),IEXP,IMANT,IBITS,ITRND)
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IEXP,1,IBITS,
     C             8,YFUNC,KRETA)
             CALL INXBIT (KGRIB,KLENG,INSPT,IMANT,1,IBITS,
     C             24,YFUNC,KRETB)
             KRET = KRETA + KRETB
             IF (KRET.NE.0)
     C          THEN
                    KRET = 520
                    WRITE (*,9520) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
C
C               Convert GRIB representation to floating point.
C
     C          CALL DECFP2 (PSEC2(2),IEXP,IMANT)
C
         ENDIF
C
C*    Stretching parameters for stretched and rotated grids.
C     (Gaussian, Latitude/longitude or Spherical Harmonics)
C
      IF (KSEC2(1).EQ.30.OR.KSEC2(1).EQ.34.OR.
     C    KSEC2(1).EQ.80)
     C   THEN
C
C*           Octets 43 - 45 : Latitude of pole of stretching.
C            Octets 46 - 48 : Longitude of pole of stretching.
C            Two 24 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(15),2,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 519
                    WRITE (*,9519) KRET
                    GO TO 900
                ENDIF
C
C*           Octets 49 - 52 : Stretching factor.
C            One 8 bit and one 24 bit field.
C
             ITRND = 1
             IF (YFUNC.EQ.'C')
C
C               Convert floating point to GRIB representation.
C
     C          CALL CONFP3 (PSEC2(2),IEXP,IMANT,IBITS,ITRND)
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IEXP,1,IBITS,
     C             8,YFUNC,KRETA)
             CALL INXBIT (KGRIB,KLENG,INSPT,IMANT,1,IBITS,
     C             24,YFUNC,KRETB)
             KRET = KRETA + KRETB
             IF (KRET.NE.0)
     C          THEN
                    KRET = 520
                    WRITE (*,9520) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
C
C               Convert GRIB representation to floating point.
C
     C          CALL DECFP2 (PSEC2(2),IEXP,IMANT)
C
         ENDIF
C
C*    Vertical coordinate parameters, if any.
C
      IF (KSEC2(12).NE.0)
     C   THEN
             ITRND = 1
             DO 530 J530 = 1 , KSEC2(12)
C
C            One 8 bit and one 24 bit field.
C
             IF (YFUNC.EQ.'C')
C
C               Convert floating point to GRIB representation.
C
     C          CALL CONFP3 (PSEC2(J530+10),IEXP,IMANT,IBITS,ITRND)
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IEXP,1,IBITS,
     C             8,YFUNC,KRETA)
             CALL INXBIT (KGRIB,KLENG,INSPT,IMANT,1,IBITS,
     C             24,YFUNC,KRETB)
             KRET = KRETA + KRETB
             IF (KRET.NE.0)
     C          THEN
                    KRET = 521
                    WRITE (*,9521) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
C
C               Convert GRIB representation to floating point.
C
     C          CALL DECFP2 (PSEC2(J530+10),IEXP,IMANT)
C
  530        CONTINUE
         ENDIF
C
C*    List of number of points, if any.
C     Number of 16 bit fields.
C
      IF (KSEC2(17).EQ.1)
     C   THEN
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC2(23),KSEC2(3),IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 522
                    WRITE (*,9522) KRET
                    GO TO 900
                ENDIF
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 6 . Bit Map Section (section 3) of GRIB code.
C     ----------------------------------------------------------------
C
  600 CONTINUE
C
      IF (NDBG.EQ.1) WRITE (*,*) ' GRIBEX : Section 6.'
C
C*    Go to section 9, if decoding of identification sections only and
C     GRIB Code Edition is higher than 0. If Edition is lower the
C     length of the GRIB message needs to be calculated, so change
C     function to 'L' to complete decoding of section 0.
C     Number of data values decoded ( KSEC4(1) ) already set to 0.
C
      IF (HOPER(1:1).EQ.'I')
     C   THEN
             IF (KSEC0(2).GT.0)
     C          THEN
                    GO TO 900
                ELSE
                    YFUNC = 'L'
                ENDIF
         ENDIF
C
C*    Go to section 7, if no bit map required.
C
      IF (KSEC1(5).EQ.0.OR.KSEC1(5).EQ.128) GO TO 700
C
C*    Set bit-map flag and attempt no decoding of bit-map, if
C     routine has been called by the DECOGB interface routine,
C     which is provided for upward compatibility with old software.
C
      IF (HOPER.EQ.'Z')
     C   THEN
             ISBMAP = -5
             WRITE (*,9606) ISBMAP
             GO TO 900
         ENDIF
C
C*    Check consistency of values given, with GRIB code, if required.
C
      IF (NVCK.EQ.1.AND.YFUNC.EQ.'C')
     C   THEN
             CALL GRCHK3 (KSEC1,KSEC3,PSEC3,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 699
                    WRITE (*,9699) KRET
                    GO TO 900
                ENDIF
         ENDIF
C
C*    When coding data, calculate the length of section and number
C     of unused bits.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
             IF (KSEC3(1).NE.0)
     C          THEN
C
C                   Predetermined bit-map table included.
C                   Length of section is 6 octets, number of unused
C                   bits is 0.
C
                    ILEN3 = 6
                    INUB  = 0
C
                ELSE
C
C                   Bit-map included in section 3.
C                   Length of section = 6 octets of header + length of
C                   bit-map, rounded to a multiple of 2 octets.
C
C                   Set IVALS to the number of bits in the bit-map.
C
                    IF (KSEC4(8).EQ.0)
     C                 THEN
C
C                          Each bit in the bit-map represents a single
C                          value.
C
                           IVALS = ILENF
                       ELSE
C
C                          Each bit in the bit-map represents a
C                          matrix of values.
C
                           IVALS = ILENF / (KSEC4(50)*KSEC4(51))
                       ENDIF
C
                    ITEMP = 48 + IVALS
                    ILEN3 = ( ITEMP + 15 ) / 16
                    ILEN3 = ILEN3 * 2
C
C                   Number of unused bits.
C
                    INUB = ILEN3 * 8 - ITEMP
C
                ENDIF
C
         ENDIF
C
C*    Octets 1 - 3 : Length of section.
C     One 24 bit field.
C
C     Insert/extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,ILEN3,1,IBITS,
     C             24,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 601
             WRITE (*,9601) KRET
             GO TO 900
         ENDIF
C
C*    Print length of Section 3, if required.
C
      IF (NDBG.EQ.1) WRITE (*,9103) ILEN3
C
C     If only length is required, update bit-pointer and jump
C     to extraction of length of section 4.
C
      IF (YFUNC.EQ.'L')
     C   THEN
             INSPT = INSPT -24 + ILEN3 * 8
             GO TO 700
         ENDIF
C
C*    Octet 4 : Number of unused bits at end of section.
C     One 8 bit field.
C
C     Insert/extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,INUB,1,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 602
             WRITE (*,9602) KRET
             GO TO 900
         ENDIF
C
C*    Octets 5-6 : Bit-map table reference.
C     One 16 bit field.
C
C     Insert/extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC3(1),1,IBITS,
     C             16,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 603
             WRITE (*,9603) KRET
             GO TO 900
         ENDIF
C
C*    Finished if a predetermined bit-map table is given.
C
      IF (KSEC3(1).NE.0) GO TO 700
C
C*    Set integer or real missing data value.
C
      IF (KSEC4(5).EQ.0)
     C   THEN
             ZMSVAL = PSEC3(2)
         ELSE
             ZMSVAL = FLOAT (KSEC3(2))
         ENDIF
C
C*    Bit-map definition included.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            Insert primary bit-map. Set function for fixed length
C            messages if required.
C
             YTEMP = YFUNC
             IF (HOPER.EQ.'M') YTEMP = 'M'
C
             IF (KSEC4(8).EQ.64)
     C          THEN
C
C                   Matrix of values at a point.
C
                    ITEMP = KSEC4(50) * KSEC4(51)
                ELSE
C
C                   Single value at each point.
C
                    ITEMP = 1
                ENDIF
C
             CALL INSMP1 (KGRIB,KLENG,INSPT,KSEC4(9),PSEC4,
     C              ILENF,IBITS,ZMSVAL,YTEMP,ITEMP,NDBG,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 604
                    WRITE (*,9604) KRET
                    GO TO 900
                ENDIF
C
C            Number of data values remaining to be handled
C            is now in ILENF, which is used when finding maximum and
C            minimum values etc. When a matrix of values is present
C            PSEC4 may still contain missing data indicators for each
C            matrix.
C
C*           Unused bits at end of section.
C            These bits are already set to 0, so update bit-pointer
C            only.
C
             INSPT = INSPT + INUB
C
         ELSE
C
C            Retain pointer to bit-map location.
C
             IBMAP = INSPT
C
C            IVALS is the number of bits in the bit-map. It is the same
C            as the number of data values (including missing data
C            values to be decoded) when each point represents a single
C            data value. When each bit in the bit-map represents a
C            matrix of values, it is the number of matrices.
C
             IVALS = (ILEN3 - 6) * 8 - INUB
C
C            Update bit-pointer to start of section 4 of Grib message.
C
             INSPT = INSPT - 48 + ILEN3 * 8
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 7 . Binary Data Section (section 4) of GRIB code.
C     ----------------------------------------------------------------
C
  700 CONTINUE
C
      IF (NDBG.EQ.1) WRITE (*,*) ' GRIBEX : Section 7.'
C
C*    Check consistency of values given, with GRIB code, if required.
C
      IF (NVCK.EQ.1.AND.YFUNC.EQ.'C')
     C   THEN
             CALL GRCHK4 (KSEC1,KSEC4,PSEC4,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 799
                    WRITE (*,9799) KRET
                    GO TO 900
                ENDIF
         ENDIF
C
C*    Retain value of the pointer to the first bit in Section 4.
C     When coding data, this is needed later to insert the length
C     of Section 4 and the number of unused bits.
C     When decoding data, this is used later to calculate the
C     number of packed data values which have to be decoded.
C
      IPLEN = INSPT
C
C*    Octets 1 - 3 : Length of section.
C     One 24 bit field.
C
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            Increment pointer.
C
             INSPT = INSPT + 24
         ELSE
C
C            Extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,ILEN4,1,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 701
                    WRITE (*,9701) KRET
                    GO TO 900
                ENDIF
C
C            Print length of Section 4, if required.
C
             IF (NDBG.EQ.1) WRITE (*,9104) ILEN4
C
C            Set length if required, by updating bit-pointer and
C            adding length of section 5 (32 bits). Length in bytes.
C            Finished if length only required, so go to section 9.
C
             IF (YFUNC.EQ.'L'.OR.HOPER.EQ.'X')
     C          THEN
                    KSEC0(1) = (INSPT - 24 + ILEN4 * 8 + 32) / 8
                    IF (YFUNC.EQ.'L') GO TO 900
                ENDIF
C
         ENDIF
C
C*    Octet 4 : 4 bit flag field and 4 bit unused bit count field.
C     One 8 bit field for insertion/extraction purposes.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            Type of data (spherical harmonic coefficients or grid
C            point) is taken from KSEC4(3) only if no Section 2 is
C            included. This allows coding of data without the use
C            of Section 2.
C
             IF (KSEC1(5).EQ.128.OR.KSEC1(5).EQ.192)
     C          THEN
                    KSEC4(3) = 0
                    IF ( KSEC2(1).EQ.50.OR.KSEC2(1).EQ.60.OR.
     C                KSEC2(1).EQ.70.OR.KSEC2(1).EQ.80) KSEC4(3) = 128
                ENDIF
C
             IFLAG = KSEC4(3) + KSEC4(4) + KSEC4(5) + KSEC4(6)
C
C            When coding data, field is inserted later, when
C            number of unused bits is known and added to it.
C            Increment pointer.
C
             INSPT = INSPT + 8
C
         ELSE
C
C            Extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IFLAG,1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 706
                    WRITE (*,9706) KRET
                    GO TO 900
                ENDIF
C
C            All flags already preset to 0.
C
             IF (KSEC0(2).EQ.-1)
     C          THEN
C
C                   In the Experimental Edition flag field was
C                   0000 for grid point data.
C                   0001 for spherical harmonic data.
C
                    ITEMP = IFLAG / 16
                    INIL  = IFLAG - ITEMP * 16
                    IF (ITEMP.NE.0) KSEC4(3) = 128
                    GO TO 710
                ENDIF
C
             IF (KSEC0(2).EQ.0)
     C          THEN
C
C                   In Edition 0 flag field was
C                   0000 for grid point data.
C                   1000 for spherical harmonic data.
C
                    ITEMP = IFLAG / 128
                    INIL  = IFLAG - ITEMP * 128
                    IF (ITEMP.NE.0) KSEC4(3) = 128
                    GO TO 710
                ENDIF
C
             IF (KSEC0(2).EQ.1)
     C          THEN
C
C                   In Edition 1 flag field all 4 bits have
C                   significance.
C
C                   0--- for grid point data.
C                   1--- for spherical harmonic data.
C                   -0-- for simple packing.
C                   -1-- for complex or second order packing.
C                   --0- for floating point values.
C                   --1- for integer values.
C                   ---0 for no additional flags at Octet 14.
C                   ---1 for additional flags at Octet 14.
C
                   IF (IFLAG.GE.128)
     C                THEN
                          KSEC4(3) = 128
                          IFLAG    = IFLAG - 128
                      ENDIF
C
                   IF (IFLAG.GE.64)
     C                THEN
                          KSEC4(4) = 64
                          IFLAG    = IFLAG - 64
                      ENDIF
C
                   IF (IFLAG.GE.32)
     C                THEN
                          KSEC4(5) = 32
                          IFLAG    = IFLAG - 32
                      ENDIF
C
                   IF (IFLAG.GE.16)
     C                THEN
                          KSEC4(6) = 16
                          IFLAG    = IFLAG - 16
                      ENDIF
C
                   INIL  = IFLAG
                ENDIF
C
  710        CONTINUE
C
C            Print number of unused bits, if required.
C
             IF (NDBG.EQ.1) WRITE (*,9107) INIL
C
         ENDIF
C
C*    Complex packing (spherical harmonics or grid point)
C     and second order packing (grid point) are not supported.
C
      IF (KSEC4(4).NE.0)
     C   THEN
             KRET = 705
             WRITE (*,9705) KRET
             GO TO 900
         ENDIF
C
C*    Set IFPT to the number of data values stored in floating point
C     rather than packed format.
C     For simple packing of data in spherical harmonic
C     format the first word contains the real (0,0) coefficient,
C     which is treated separately. IFPT is 1 for spherical
C     harmonics, 0 for other data.
C
      IF (KSEC4(3).EQ.0)
     C   THEN
             IFPT = 0
         ELSE
             IFPT = 1
         ENDIF
C
C*    Octets 5 - 6 : Scale factor.
C     One 16 bit field.
C
C     Calculate scale factor, if coding data.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            Change units of data values , if required.
C
             IF (KSEC1(23).NE.0)
     C          THEN
                    DO 711 J711 = 1 , ILENF
                        PSEC4(J711) = PSEC4(J711)*(10.0**KSEC1(23))
  711               CONTINUE
                ENDIF
C
C            Find maximum and minimum values in data array, ignoring
C            any missing-data values, if secondary bit-maps are
C            indicated. Values not being packed are skipped.
C
             ILEN = ILENF - IFPT
C
             IF (KSEC4(9).EQ.32)
     C          THEN
C
C                   Secondary bit maps present.
C
                    CALL MAXMN2 (PSEC4(IFPT+1),ILEN,ZMSVAL,ZMAX,ZMIN)
                ELSE
C
C                   No secondary bit maps present.
C
                    CALL MAXMIN (PSEC4(IFPT+1),ILEN,ZMAX,ZMIN)
                ENDIF
C
             IF (NDBG.EQ.1) WRITE (*,9106) ZMAX , ZMIN
C
C            Calculate and pack scale factor.
C            If user has supplied a reference value, use it
C            unless it exceeds the minimum value. Otherwise
C            use the minimum value.
C
             IF (NFREF.EQ.1)
     C          THEN
                    ZREF = FREF
C
C                   If integer data being packed, ensure that
C                   reference value represents an integer.
C
                    IF (KSEC4(5).EQ.32)
     C                 THEN
                           ITEMP = NINT (ZREF)
                           ZREF  = FLOAT (ITEMP)
                       ENDIF
C
                    IF (ZREF.LT.ZMIN)
     C                 THEN
                           WRITE (*,9718) ZREF , ZMIN
                           ZREF = ZMIN
                       ENDIF
                ELSE
                     ZREF = ZMIN
                ENDIF
C
             ZS = (ZMAX-ZREF) / (2**(KSEC4(2)+1)-1)
             IF (ZS.NE.0.0) ZS = ALOG(ZS) / ALOG(2.) + 2.
             ISCALE = MIN (INT(ZS),INT(ZS+SIGN(1.,ZS)))
             ZSCALE = 2.**ISCALE
C
C            Set sign bit.
C
             IF (ISCALE.LT.0)
     C          THEN
                    ISCALE = -ISCALE
                    ISIGN  = 32768
                    ISCALE = ISCALE + ISIGN
                ENDIF
C
C            Scale factor has all bits set to 1 for
C            missing fields. (ECMWF convention only).
C
             IF (IMISS.EQ.1) ISCALE = 65535
C
         ENDIF
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,ISCALE,1,IBITS,
     C             16,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 707
             WRITE (*,9707) KRET
             GO TO 900
         ENDIF
C
C     If decoding, set scale factor.
C
      IF (YFUNC.EQ.'D')
     C   THEN
             ISKALE = ISCALE
             IF (ISKALE.GE.32768)
     C          THEN
                    ISCALE = ISCALE - 32768
                    ISCALE = - ISCALE
                ENDIF
             ZSCALE = 2.**ISCALE
         ENDIF
C
C*    Octets 7 - 10 : Reference value.
C     One 8 bit and one 24 bit field.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
             IF (IMISS.EQ.1)
     C          THEN
C
C                   For missing data fields are set to all 1 bits.
C
                    IEXP   = 255
                    IMANT  = 16777215
                ELSE
C
C                   Convert floating point to GRIB representation.
C
                    ITRND = 1
                    IF (NDBG.EQ.1) ITRND = 11
                    ZTEMP = ZREF
                    CALL CONFP3 (ZREF,IEXP,IMANT,IBITS,ITRND)
C
C                   Set reference value to that actually stored
C                   in the GRIB code.
C
                    CALL DECFP2 (ZREF,IEXP,IMANT)
C
C                   If the nearest number which can be represented in
C                   GRIB format is greater than the reference value,
C                   find the nearest number in GRIB format lower
C                   than the reference value.
C
                    IF (ZTEMP.LT.ZREF)
     C                 THEN
C
C                          Convert floating point to GRIB representation
C                          using truncation to ensure that the converted
C                          number is smaller than the original one.
C
                           ITRND = ITRND - 1
                           ZREF  = ZTEMP
                           CALL CONFP3 (ZREF,IEXP,IMANT,IBITS,ITRND)
C
C                          Set reference value to that actually stored
C                          in the GRIB code.
C
                           CALL DECFP2 (ZREF,IEXP,IMANT)
C
                           IF (ZTEMP.LT.ZREF)
     C                        THEN
                                  WRITE (*,*) 'Reference value error.'
                                  WRITE (*,*) 'Notify J. Hennessy.'
                                  ZREF = ZTEMP
                              ENDIF
                       ENDIF
C
                ENDIF
C
         ENDIF
C
C     Insert / extract fields.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,IEXP,1,IBITS,
     C             8,YFUNC,KRETA)
      CALL INXBIT (KGRIB,KLENG,INSPT,IMANT,1,IBITS,
     C             24,YFUNC,KRETB)
      KRET = KRETA + KRETB
      IF (KRET.NE.0)
     C   THEN
             KRET = 708
             WRITE (*,9708) KRET
             GO TO 900
         ENDIF
C
C     Conversion from GRIB format, if decoding.
C
      IF (YFUNC.EQ.'D')
     C   THEN
C
C            Set IMISS to 1 if entire field is missing ie scale
C            factor, exponent and mantissa with all bits set to 1.
C
             IMISS = 0
             IF (ISKALE.EQ.65535.AND.IEXP.EQ.255.AND.
     C            IMANT.EQ.16777215) IMISS = 1
C
C            Convert GRIB representation to floating point.
C
             IF (IMISS.EQ.0)
     C          THEN
C
C                   Field is present.
C
                    CALL DECFP2 (ZREF,IEXP,IMANT)
                ELSE
C
C                   Field is missing. Print warning message and
C                   field identification sections of Grib code,
C                   forcing field data values to 0.
C
                    WRITE (*,9719)
                    CALL GRPRS1 (KSEC0,KSEC1)
                    ZREF   = 0
                    ZSCALE = 0
                ENDIF
             IF (NDBG.EQ.1) WRITE (*,9105) ZREF
         ENDIF
C
C*    Octet 11 : Number of bits containing each packed value.
C     One 8 bit field.
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,KSEC4(2),1,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 709
             WRITE (*,9709) KRET
             GO TO 900
         ENDIF
C
C*    Octets 12 et sequentia can contain further header
C     information, depending on data representation type.
C
C*    For grid point data, simple packing, single value at each
C     grid point there is no further header information and
C     packed data begins in octet 12.
C
C*    For grid point data, simple packing, with a matrix of
C     values at each grid point further information is added.
C
      IF (KSEC4(3).EQ.0.AND.KSEC4(6).EQ.16.
     C          AND.KSEC4(4).EQ.0)
     C   THEN
C
C            Octets 12 - 13. N - octet number at which packed
C            data begins.
C            One 16 bit field.
C
C            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C            !                                                !
C            ! This is the WMO definition, but it is entirely !
C            ! inadequate when secondary bit maps are present !
C            ! eg 3x3 global grid with a matrix of values     !
C            ! 12x26 at each point. This gives a bit map with !
C            ! a length of 285480 octets which cannot be given!
C            ! in 16 bits.                                    !
C            !                                                !
C            ! ECMWF uses the following definition  for its   !
C            ! wave model data.                               !
C            ! N - Number of secondary bit maps.              !
C            !     This definition will accommodate a 1x1     !
C            !     degree global grid.                        !
C            !                                                !
C            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
             IF (YFUNC.EQ.'C')
     C          THEN
C
C                   Octet number = 25 + NC1 + NC2
C
                    IBYTEX = 25 + KSEC4(53) + KSEC4(55)
C
C                   Add in length of bit-maps, if present.
C                   Length in bits is the number of values
C                   remaining to be packed rounded
C                   up to a number of octets.
C
                    IF (KSEC4(9).EQ.32) IBYTEX = IBYTEX +
     C                  (ILENF+7) / 8
C
C                   ECMWF wave model usage.
C                   ECMWF is centre number 98, and local code table
C                   2 used for wave models is 140.
C
                    IF (KSEC1(2).EQ.98.AND.KSEC1(1).EQ.140)
     C                 THEN
                           IBYTEX = ILENF / (KSEC4(50) * KSEC4(51))
                       ENDIF
                ENDIF
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IBYTEX,1,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 720
                    WRITE (*,9720) KRET
                    GO TO 900
                ENDIF
C
C            Octet 14. Extended flags.
C            One 8 bit field.
C
             IF (YFUNC.EQ.'C')
     C            IFLAGX = KSEC4(8) + KSEC4(9) + KSEC4(10)
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IFLAGX,1,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 721
                    WRITE (*,9721) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C         THEN
C
C                  In Edition 1 only 3 bits are used.
C
C                  -0------ for single datum at each grid point.
C                  -1------ for matrix of values at each point.
C                  --0----- for no secondary bit-maps.
C                  --1----- for secondary bit-maps present.
C                  ---0---- for second order values constant width.
C                  ---1---- for second order values different widths.
C
                   IF (IFLAGX.GE.64)
     C                THEN
                          KSEC4(8) = 64
                          IFLAGX   = IFLAGX - 64
                      ENDIF
                   IF (IFLAGX.GE.32)
     C                THEN
                          KSEC4(9) = 32
                          IFLAGX   = IFLAGX - 32
                      ENDIF
                   IF (IFLAGX.GE.16)
     C                THEN
                          KSEC4(9) = 16
                          IFLAGX   = IFLAGX - 16
                      ENDIF
               ENDIF
C
C            Octets 15 - 16. NR - first dimension (rows) of
C            each matrix.
C            Octets 17 - 18. NC - second dimension (columns) of
C            each matrix.
C            Two 16 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC4(50),2,IBITS,
     C             16,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 722
                    WRITE (*,9722) KRET
                    GO TO 900
                ENDIF
C
C            Octet 19. First dimension coordinate values
C            definition.
C            Octet 20. NC1 - Number of coefficients or values
C            used to specify first dimension coordinate function.
C            Octet 21. Second dimension coordinate values
C            definition.
C            Octet 22. NC2 - Number of coefficients or values
C            used to specify second dimension coordinate function.
C            Octet 23. First dimension physical significance.
C            Octet 24. Second dimension physical significance.
C            Six 8 bit fields.
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,KSEC4(52),6,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 723
                    WRITE (*,9723) KRET
                    GO TO 900
                ENDIF
C
C            Octets 25 - (24+NC1).
C            Coefficients to define first dimension coordinate
C            values in functional form, or the explicit
C            coordinate values.
C            Octets (25+NC1) - (24+NC1+NC2).
C            Coefficients to define second dimension coordinate
C            values in functional form, or the explicit
C            coordinate values.
C            (NC1+NC2) 8 bit fields.
C
C            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C            !                                                !
C            ! This is the WMO definition, but it is very     !
C            ! limited and can only accommodate small integer !
C            ! fields values.                                 !
C            !                                                !
C            ! ECMWF needs to use floating point numbers and  !
C            ! for the wave models the definition is NC1+NC2  !
C            ! (8 bit and 24 bit) fields.
C            !                                                !
C            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
             ITEMP = KSEC4(53) + KSEC4(55)
C
C            ECMWF wave model usage.
C            ECMWF is centre number 98, and local code table
C            2 used for wave models is 140.
C
             IF (KSEC1(2).EQ.98.AND.KSEC1(1).EQ.140)
     C          THEN
                    ITRND = 1
                    DO 720 J720=1,ITEMP
C
C                      One 8 bit and one 24 bit field.
C
                       IF (YFUNC.EQ.'C')
     C                    THEN
C
C                             Convert floating point to GRIB
C                             representation.
C
                              ISINT = KSEC4(J720+59)
                              CALL CONFP3 (ZREAL,IEXP,IMANT,
     C                                 IBITS,ITRND)
                          ENDIF
C
C                      Insert / extract fields.
C
                       CALL INXBIT (KGRIB,KLENG,INSPT,IEXP,1,IBITS,
     C                       8,YFUNC,KRETA)
                       CALL INXBIT (KGRIB,KLENG,INSPT,IMANT,1,IBITS,
     C                       24,YFUNC,KRETB)
                       KRET = KRETA + KRETB
                       IF (KRET.NE.0)
     C                    THEN
                              KRET = 724
                              WRITE (*,9724) KRET
                              GO TO 900
                          ENDIF
C
                       IF (YFUNC.EQ.'D')
     C                    THEN
C
C                              Convert GRIB representation to floating
C                              point.
C
                               CALL DECFP2 (ZREAL,IEXP,IMANT)
                               KSEC4(J720+59) = ISINT
                          ENDIF
C
  720               CONTINUE
                ELSE
C
C                   Insert / extract fields.
C
                    CALL INXBIT (KGRIB,KLENG,INSPT,KSEC4(57),ITEMP,
     C                    IBITS,8,YFUNC,KRET)
                    IF (KRET.NE.0)
     C                 THEN
                           KRET = 724
                           WRITE (*,9724) KRET
                           GO TO 900
                       ENDIF
                ENDIF
C
C            Matrix bit-maps may follow.
C
             IF (KSEC4(9).EQ.32)
     C          THEN
                    ITEMP = KSEC4(50) * KSEC4(51)
                    IF (YFUNC.EQ.'C')
     C                 THEN
                           CALL INSMP2 (KGRIB,KLENG,INSPT,PSEC4,
     C                          ILENF,IBITS,ZMSVAL,YFUNC,
     C                          ITEMP,NDBG,KRET)
                           IF (KRET.NE.0)
     C                        THEN
                                  KRET = 725
                                  WRITE (*,9725) KRET
                                  GO TO 900
                              ENDIF
                           ILEN = ILENF
                       ELSE
C
C                          Retain pointer to bit-map location.
C
                           IBMAP2 = INSPT
C
C                          Set pointer to start of packed data.
C
                           IF (KSEC1(2).EQ.98.AND.KSEC1(1).EQ.140)
     C                        THEN
                                  ITEMP = KSEC4(50)*KSEC4(51)*IBYTEX
                                  ITEMP = (ITEMP+7) / 8
                                  INSPT = INSPT + ITEMP * 8
                              ELSE
                                  INSPT = INSPT + (IBYTEX-25-KSEC4(53)
     C                                             -KSEC4(55)) * 8
                              ENDIF
C
                       ENDIF
                ENDIF
C
         ENDIF
C
C*    For spherical harmonic data (simple packing), real (0,0)
C     coefficient is in floating point representation in
C     octets 12-15.
C     One 8 bit and one 24 bit field.
C
      IF (IFPT.EQ.1.AND.KSEC4(4).EQ.0)
     C   THEN
             ITRND = 1
             IF (YFUNC.EQ.'C')
C
C               Convert floating point to GRIB representation.
C
     C          CALL CONFP3 (PSEC4(1),IEXP,IMANT,IBITS,ITRND)
C
C            Insert / extract fields.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IEXP,1,IBITS,
     C             8,YFUNC,KRETA)
             CALL INXBIT (KGRIB,KLENG,INSPT,IMANT,1,IBITS,
     C             24,YFUNC,KRETB)
             KRET = KRETA + KRETB
             IF (KRET.NE.0)
     C          THEN
                    KRET = 711
                    WRITE (*,9711) KRET
                    GO TO 900
                ENDIF
C
             IF (YFUNC.EQ.'D')
     C          THEN
C
C               Convert GRIB representation to floating point.
C
                IF (IMISS.EQ.1)
     C             THEN
                       PSEC4(1) = 0.0
                   ELSE
                       CALL DECFP2 (PSEC4(1),IEXP,IMANT)
                   ENDIF
                ENDIF
         ENDIF
C
C*    Octet N onwards - Packed data.
C
C     If decoding , calculate number of data values, unless
C     number has been given by user for 'X' function.
C
      IF (YFUNC.EQ.'D')
     C   THEN
             IF (HOPER.EQ.'X')
     C          THEN
                    ILEN = KSEC4(34)
                ELSE
                    ILEN = (IPLEN+(ILEN4*8)-INSPT-INIL)/KSEC4(2)
                ENDIF
C
C            Total number of values = packed + unpacked.
C
             KSEC4(1) = ILEN + IFPT
C
C            Check length of output array.
C
             IF (KSEC4(1).GT.KLENP)
     C          THEN
                    KRET = 710
                    WRITE (*,9710) KLENP , KSEC4(1) , KRET
                    GO TO 900
                ENDIF
C
         ENDIF
C
C
C*    Scale and store, or extract and scale data values.
C
C     Only a few points to be unpacked.
C
      IF (HOPER.EQ.'X')
     C   THEN
C
C            Check that no bit-map is included.
C
             IF (KSEC1(5).EQ.64.OR.KSEC1(5).EQ.192)
     C          THEN
                    KRET = 717
                    WRITE (*,9717) KRET
                    GO TO 900
                ENDIF
C
C            Check that field is Gaussian or latitude/longitude grid.
C
             IF (KSEC2(1).NE.0.AND.KSEC2(1).NE.4.AND.
     C           KSEC2(1).NE.10.AND.KSEC2(1).NE.14.AND.
     C           KSEC2(1).NE.20.AND.KSEC2(1).NE.24.AND.
     C           KSEC2(1).NE.30.AND.KSEC2(1).NE.34)
     C          THEN
                    KRET = 716
                    WRITE (*,9716) KRET
                    GO TO 900
                ENDIF
C
C            Check that scanning mode is West to East and North to
C            South.
C
             IF (KSEC2(11).NE.0)
     C          THEN
                    KRET = 715
                    WRITE (*,9715) KRET
                    GO TO 900
                ENDIF
C
C            Check that number of points required does not exceed
C            maximum or minimum allowed.
C
             IF (KSEC4(34).GT.4.OR.KSEC4(34).LT.1)
     C          THEN
                    KRET = 714
                    WRITE (*,9714) KSEC4(34) , KRET
                    GO TO 900
                ENDIF
C
             ITEMP = 1
C
             DO 733 J733=1,KSEC4(34)
C
C               Skip down latitude rows.
C
                IF (KSEC2(17).EQ.0)
     C             THEN
C
C                      Regular grid.
C
                       ISKIP = (KSEC4(34+ITEMP)-1) * KSEC2(2)
                   ELSE
C
C                      Quasi-regular grid.
C
                       ISKIP = 0
                       DO 732 J732=1,KSEC4(34+ITEMP) - 1
                          ISKIP = ISKIP + KSEC2(22+J732)
  732                  CONTINUE
                   ENDIF
C
C               Skip any points not required on this latitude row.
C
                ISKIP = ISKIP + KSEC4(34+ITEMP+1) - 1
C
C               Calculate number of bits in these values and add
C               to current value of bit-pointer.
C
                ISKIP = ISKIP * KSEC4(2) + INSPT
C
C               Extract value from 1 point.
C
                CALL INXBIT (KGRIB,KLENG,ISKIP,PSEC4(J733),1,
     C             IBITS,KSEC4(2),YFUNC,KRET)
                IF (KRET.NE.0)
     C             THEN
                       KRET = 712
                       WRITE (*,9712) KRET
                       GO TO 900
                   ENDIF
                ITEMP = ITEMP + 2
  733        CONTINUE
C
             GO TO 735
         ENDIF
C
C     All data to be unpacked or packed.
C
      IF (YFUNC.EQ.'C')
     C   CALL INSCAL (PSEC4(IFPT+1),PSEC4(IFPT+1),ILEN,ZREF,ZSCALE)
C
C     Insert / extract fields.
C
      CALL INXBIT (KGRIB,KLENG,INSPT,PSEC4(IFPT+1),ILEN,IBITS,
     C             KSEC4(2),YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 712
             WRITE (*,9712) KRET
             GO TO 900
         ENDIF
C
  735 CONTINUE
C
      IF (YFUNC.EQ.'D')
     C   THEN
C
             CALL EXSCAL (PSEC4(IFPT+1),PSEC4(IFPT+1),ILEN,
     C                    ZREF,ZSCALE)
C
C            Change units of data values, if required.
C
             IF (KSEC1(23).NE.0)
     C          THEN
                    DO 736 J736 = 1 , KSEC4(1)
                       PSEC4(J736) = PSEC4(J736)/10.0**KSEC1(23)
  736               CONTINUE
                ENDIF
C
C               Finish, if only a few points extracted.
C
                IF (HOPER.EQ.'X')
     C             THEN
C
C                      Convert to integer if original data was integer.
C
                       IF (KSEC4(5).EQ.32)
     C                     CALL RORINT (PSEC4,PSEC4,KSEC4(1),'I')
                       GO TO 900
                   ENDIF
        ENDIF
C
C*    Enter length of binary data section, ensuring that the
C     length is an even number of octets, padding with binary
C     zeroes as required.
C     One 24 bit field.
C
      IF (YFUNC.NE.'C') GO TO 800
C
C     Length of section 4, in bits.
C
      ILEN4 = INSPT - IPLEN
      IL    = ILEN4 / 16
      IL    = ILEN4 - ( IL * 16 )
      INIL  = 0
      IF (IL.NE.0)
     C   THEN
             INIL = 16 - IL
             INSPT = INSPT + INIL
             ILEN4 = ILEN4 + INIL
         ENDIF
C
      ILEN4 = ILEN4 / 8
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,IPLEN,ILEN4,1,IBITS,
     C             24,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 701
             WRITE (*,9701) KRET
             GO TO 900
         ENDIF
C
C*    Enter flag / unused bits field.
C     One 8 bit field.
C     Two 4 bit fields.
C
      IFLAG = IFLAG + INIL
C
C     Print number of unused bits, if required.
C
      IF (NDBG.EQ.1) WRITE (*,9107) INIL
C
C     Insert / extract field.
C
      CALL INXBIT (KGRIB,KLENG,IPLEN,IFLAG,1,IBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 713
             WRITE (*,9713) KRET
             GO TO 900
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 8 . Code/decode End Section (Section 5) of GRIB code.
C     ----------------------------------------------------------------
C
  800 CONTINUE
C
      IF (NDBG.EQ.1) WRITE (*,*) ' GRIBEX : Section 8.'
C
C*    Ascii 7 7 7 7 at end of coded data.
C     Four 8 bit fields.
C
      IF (YFUNC.EQ.'C')
     C   THEN
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,INSPT,I7777(1),4,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 801
                    WRITE (*,9801) KRET
                    GO TO 900
                ENDIF
C
C*           Length of GRIB message.
C
             KSEC0(1) = INSPT / 8
             ITEMP = 32
C
C            Insert / extract field.
C
             CALL INXBIT (KGRIB,KLENG,ITEMP,KSEC0(1),1,IBITS,
     C             24,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 802
                    WRITE (*,9802) KRET
                    GO TO 900
                ENDIF
C
         ELSE
C
C            Skip padding.
C
             INSPT = INSPT + INIL
C
             CALL INXBIT (KGRIB,KLENG,INSPT,IPARM(1),4,IBITS,
     C             8,YFUNC,KRET)
             IF (KRET.NE.0)
     C          THEN
                    KRET = 801
                    WRITE (*,9801) KRET
                    GO TO 900
                ENDIF
C
C            Check that 7777 group is found where expected.
C
             ICOUNT = 0
             DO 802 J802 = 1 , 4
                IF (IPARM(J802).NE.55) ICOUNT = ICOUNT + 1
  802        CONTINUE
             IF (ICOUNT.NE.0)
     C          THEN
                    KRET = 805
                    WRITE (*,9805) KRET
                    GO TO 900
                ENDIF
C
C*           Final handling when bit-maps included.
C
             IF (KSEC1(5).EQ.64.OR.KSEC1(5).EQ.192)
     C          THEN
C
                    IF (KSEC3(1).EQ.0)
     C                 THEN
C
C                          Bit-map included in GRIB message.
C
                           IF (KSEC4(8).EQ.64)
     C                        THEN
C
C                                 Matrix of values at a point.
C
                                  ITEMP = KSEC4(50) * KSEC4(51)
                              ELSE
C
C                                 Single value at each point.
C
                                  ITEMP = 1
                              ENDIF
C
C                          Pointer IBMAP2 is set negative if there
C                          are no secondary bit-maps.
C
                           IF (KSEC4(9).EQ.0) IBMAP2 = -1
C
                           CALL EXTMAP (KGRIB,KLENG,IBMAP,IBMAP2,
     C                                   PSEC4,IVALS,IBITS,ISBMAP,
     C                                   ZMSVAL,ITEMP,NDBG,KRET)
                           IF (KRET.NE.0)
     C                        THEN
                                  KRET = 806
                                  WRITE (*,9806) KRET
                                  GO TO 900
                              ENDIF
                           KSEC4(1) = IVALS*ITEMP
C
                       ELSE
C
C                          Predetermined bit-map reference only.
C
                           ISBMAP = -3
C
                       ENDIF
                ENDIF
C
C
C*           If required, convert quasi-regular Gaussian grid to
C            regular.
C
             IF (HOPER.EQ.'R'.AND.KSEC2(1).EQ.4.AND.KSEC2(17).EQ.1)
     C          THEN
C
C                   Cannot handle data with bit-map.
C
                    IF (KSEC1(5).EQ.64.OR.KSEC1(5).EQ.192)
     C                 THEN
                           KRET = 605
                           WRITE (*,9605) KRET
                           GO TO 900
                       ENDIF
C
                    INOLAT    = KSEC2(10) * 2
                    INOLNG    = KSEC2(10) * 4
                    CALL QU2REG (PSEC4,KSEC2(23),INOLAT,INOLNG,1)
                    KSEC4(1)  = INOLAT * INOLNG
                    KSEC2(2)  = 4 * KSEC2(10)
                    KSEC2(17) = 0
                ENDIF
C
C            Convert to integer if original data was integer.
C
             IF (KSEC4(5).EQ.32)
     C              CALL RORINT (PSEC4,PSEC4,KSEC4(1),'I')
C
C            Set number of values decoded negative, if missing data.
C
             IF (IMISS.EQ.1) KSEC4(1) = - KSEC4(1)
C
C            If GRIB Edition number is -1 or 0, set GRIB message
C            length for return to user.
C
             IF (KSEC0(2).EQ.-1.OR.KSEC0(2).EQ.0)
     C              KSEC0(1) = INSPT / 8
C
             GO TO 900
         ENDIF
C
C*    Any unused part of last word is already set to binary zeroes.
C     Increment pointers as necessary.
C
      KWORD    = INSPT / IBITS
      ITEMP    = KWORD * IBITS
      IOFF     = INSPT - ITEMP
      IF (IOFF.NE.0)
     C   THEN
             INSPT = INSPT + IBITS - IOFF
             KWORD = KWORD + 1
         ENDIF
C
C*    Round length to a multiple of 120 octets, if required,
C     any additional words are already set to 0.
C
      IF (NRND.EQ.1)
     C   THEN
             I = INSPT / 960
             I = I * 960
             I = INSPT - I
             IF (I.NE.0) I = (960 - I) / IBITS
             KWORD = KWORD + I
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Abort/return to calling routine. Format statements.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
      IF (NDBG.EQ.1)
     C   THEN
             WRITE (*,*) ' GRIBEX : Section 9.'
             WRITE (*,*) '          Output values set -'
             IF (YFUNC.EQ.'D')
     C          THEN
                    CALL GRPRS0 (KSEC0)
                    CALL GRPRS1 (KSEC0,KSEC1)
C
C                   Print section 2 if present.
C
                    IF (KSEC1(5).EQ.128.OR.KSEC1(5).EQ.192)
     C                 CALL GRPRS2 (KSEC0,KSEC2,PSEC2)
C
C                   Print section 3 if present.
C
                    IF (KSEC1(5).EQ.64.OR.KSEC1(5).EQ.192)
     C                 CALL GRPRS3 (KSEC0,KSEC3,PSEC3)
                    CALL GRPRS4 (KSEC0,KSEC4,PSEC4)
                ENDIF
         ENDIF
C
C*    If no error has been encountered, set return code to informative
C     value, if required.
C
C     Set pseudo-GRIB data encountered.
C
      IF (KRET.EQ.0.AND.IPSEUD.NE.0) KRET = IPSEUD
C
C     Set data with bit-map encountered.
C
      IF (KRET.EQ.0.AND.ISBMAP.NE.0) KRET = ISBMAP
C
C*    Abort if an error has been encountered and user has requested
C     an abort. Informative values are negative and do not cause an
C     abort.
C
      IF (IRET.EQ.0.AND.KRET.GT.0)
     C   THEN
             CALL ABORTX ('GRIBEX')
         ELSE
             RETURN
         ENDIF
C
 9001 FORMAT (1H ,'         KLENG = ',I10)
 9002 FORMAT (1H ,'         KLENP = ',I10)
 9101 FORMAT (1H ,'GRIBEX : Length of Section 1 of GRIB code is ',I4,
     C            ' octets.')
 9102 FORMAT (1H ,'GRIBEX : Length of Section 2 of GRIB code is ',I4,
     C            ' octets.')
 9103 FORMAT (1H ,'GRIBEX : Length of Section 3 of GRIB code is ',I8,
     C            ' octets.')
 9104 FORMAT (1H ,'GRIBEX : Length of Section 4 of GRIB code is ',I8,
     C            ' octets.')
 9105 FORMAT (1H ,'GRIBEX : Decoded reference value = ',F30.20)
 9106 FORMAT (1H ,'GRIBEX : Maximum and minimum values = ',F30.20,
     C            2X,F30.20)
 9107 FORMAT (1H ,'GRIBEX : Number of unused bits is ',I2,'.')
 9201 FORMAT (1H ,'GRIBEX : Invalid function requested - ',A,
     C  '. Return code = ',I3)
 9202 FORMAT (1H ,'GRIBEX : Number of bits per data value, ',
     C  I3,' exceeds word length ',I3,'. Return code = ',I3)
 9203 FORMAT (1H ,'GRIBEX : Non-zero value in missing data field',
     C  '. Return code = ',I3)
 9301 FORMAT (1H ,'GRIBEX : Error inserting/extracting letters GRIB',
     C  '. Return code = ',I3)
 9302 FORMAT (1H ,'GRIBEX : Error extracting length of GRIB message',
     C  '. Return code = ',I3)
 9303 FORMAT (1H ,'GRIBEX : Error inserting/extracting GRIB Edition',
     C  ' Number. Return code = ',I3)
 9304 FORMAT (1H ,'GRIBEX : Error extracting octets 22 and 23 for ',
     C  'Experimental Edition check. Return code = ',I3)
 9305 FORMAT (1H ,'GRIBEX : Input data is not GRIB or ',
     C  'pseudo-grib. Return code = ',I3)
 9401 FORMAT (1H ,'GRIBEX : Error inserting/extracting length of ',
     C  ' Section 1. Return code = ',I3)
 9402 FORMAT (1H ,'GRIBEX : Error inserting/extracting Parameter Table',
     C  ' Version Number. Return code = ',I3)
 9403 FORMAT (1H ,'GRIBEX : Error inserting/extracting six fields ',
     C  'from Identification of Centre to Indicator of type of level.',
     C  ' Return code = ',I3)
 9404 FORMAT (1H ,'GRIBEX : Error inserting/extracting Height, ',
     C  ' pressure, etc of levels. Return code = ',I3)
 9405 FORMAT (1H ,'GRIBEX : Error inserting/extracting six fields ',
     C  'from Year of century to Indicator of unit of time range.',
     C  ' Return code = ',I3)
 9406 FORMAT (1H ,'GRIBEX : Error inserting/extracting Period of time.',
     C  ' Return code = ',I3)
 9407 FORMAT (1H ,'GRIBEX : Error inserting/extracting time range ',
     C  'indicator. Return code = ',I3)
 9408 FORMAT (1H ,'GRIBEX : Error inserting/extracting number ',
     C  'averaged. Return code = ',I3)
 9409 FORMAT (1H ,'GRIBEX : Error inserting/extracting number ',
     C  'missing from averages etc. Return code = ',I3)
 9410 FORMAT (1H ,'GRIBEX : Error inserting/extracting century of ',
     C  'data or reserved field. Return code = ',I3)
 9411 FORMAT (1H ,'GRIBEX : Error inserting/extracting units ',
     C  'decimal scale factor. Return code = ',I3)
 9412 FORMAT (1H ,'GRIBEX : Error inserting/extracting ECMWF ',
     C  'local data. Return code = ',I3)
 9499 FORMAT (1H ,'GRIBEX : Error found when checking values for ',
     C  'Section 1 against valid GRIB values. Return code = ',I3)
 9501 FORMAT (1H ,'GRIBEX : Error inserting/extracting length of ',
     C  ' Section 2. Return code = ',I3)
 9502 FORMAT (1H ,'GRIBEX : Error inserting/extracting number of ',
     C  ' Vertical coordinate parameters. Return code = ',I3)
 9503 FORMAT (1H ,'GRIBEX : Error inserting/extracting location of ',
     C  'List of vertical coordinate parameters',/,
     C  '         or List of numbers of points. Return code = ',I3)
 9504 FORMAT (1H ,'GRIBEX : Error inserting/extracting data ',
     C  'representation type. Return code = ',I3)
 9505 FORMAT (1H ,'GRIBEX : Error inserting/extracting number of ',
     C  'points along a parallel or meridian. Return code = ',I3)
 9506 FORMAT (1H ,'GRIBEX : Error inserting/extracting latitude or ',
     C  'longitude of first grid point. Return code = ',I3)
 9507 FORMAT (1H ,'GRIBEX : Error inserting/extracting components',
     C  ' flag. Return code = ',I3)
 9508 FORMAT (1H ,'GRIBEX : Error inserting/extracting latitude or ',
     C  'longitude of last grid point. Return code = ',I3)
 9509 FORMAT (1H ,'GRIBEX : Error inserting/extracting i direction',
     C  ' increment. Return code = ',I3)
 9510 FORMAT (1H ,'GRIBEX : Error inserting/extracting number of ',
     C  'parallels between pole and Equator. Return code = ',I3)
 9511 FORMAT (1H ,'GRIBEX : Error inserting/extracting scanning ',
     C  'mode flags. Return code = ',I3)
 9513 FORMAT (1H ,'GRIBEX : Error inserting/extracting j direction',
     C  ' increment. Return code = ',I3)
 9514 FORMAT (1H ,'GRIBEX : Error inserting/extracting J,K,M ',
     C  'pentagonal resolution parameters. Return code = ',I3)
 9515 FORMAT (1H ,'GRIBEX : Error inserting/extracting representation',
     C  ' type or mode. Return code = ',I3)
 9517 FORMAT (1H ,'GRIBEX : Error inserting/extracting latitude or ',
     C  'longitude of southern pole. Return code = ',I3)
 9518 FORMAT (1H ,'GRIBEX : Error inserting/extracting angle ',
     C  'of rotation. Return code = ',I3)
 9519 FORMAT (1H ,'GRIBEX : Error inserting/extracting latitude or ',
     C  'of pole of stretching. Return code = ',I3)
 9520 FORMAT (1H ,'GRIBEX : Error inserting/extracting ',
     C  'stretching factor. Return code = ',I3)
 9521 FORMAT (1H ,'GRIBEX : Error inserting/extracting ',
     C  'vertical coordinate parameters. Return code = ',I3)
 9522 FORMAT (1H ,'GRIBEX : Error inserting/extracting list of ',
     C  'numbers of points. Return code = ',I3)
 9523 FORMAT (1H ,'GRIBEX : Error inserting/extracting number of ',
     C  'points along X or Y axis. Return code = ',I3)
 9524 FORMAT (1H ,'GRIBEX : Error inserting/extracting X or Y axis',
     C  ' grid length. Return code = ',I3)
 9525 FORMAT (1H ,'GRIBEX : Error inserting/extracting Projection',
     C  ' centre flag. Return code = ',I3)
 9526 FORMAT (1H ,'GRIBEX : Error inserting/extracting latitude',
     C  ' or longitude of sub-satellite point. Return code = ',I3)
 9527 FORMAT (1H ,'GRIBEX : Error inserting/extracting diameter',
     C  ' of the earth in x or y direction. Return code = ',I3)
 9528 FORMAT (1H ,'GRIBEX : Error inserting/extracting X or Y',
     C  ' coordinate of sub-satellite point. Return code = ',I3)
 9529 FORMAT (1H ,'GRIBEX : Error inserting/extracting orientation ',
     C  'of the grid or camera angle. Return code = ',I3)
 9530 FORMAT (1H ,'GRIBEX : Error inserting/extracting X or Y ',
     C  'coordinates of origin of sector. Return code = ',I3)
 9598 FORMAT (1H ,'GRIBEX : Representation type not catered for - ',I3,
     C  '. Return code = ',I3)
 9599 FORMAT (1H ,'GRIBEX : Error found when checking values for ',
     C  'Section 2 against valid GRIB values. Return code = ',I3)
 9601 FORMAT (1H ,'GRIBEX : Error inserting/extracting length of ',
     C  ' Section 3. Return code = ',I3)
 9602 FORMAT (1H ,'GRIBEX : Error inserting/extracting number',
     C  ' of unused bits at the end of Section 3. Return code = ',I3)
 9603 FORMAT (1H ,'GRIBEX : Error inserting/extracting bit-map',
     C  ' reference table. Return code = ',I3)
 9604 FORMAT (1H ,'GRIBEX : Error inserting primary ',
     C  'bit map. Return code = ',I3)
 9605 FORMAT (1H ,'GRIBEX : Cannot convert Quasi-regular Gaussian',
     C  ' grid with bit-map. Return code = ',I3)
 9606 FORMAT (1H ,'GRIBEX : Bit-map found. No data decoded.',
     C  ' Return code = ',I3)
 9699 FORMAT (1H ,'GRIBEX : Error found when checking values for ',
     C  'Section 3 against valid GRIB values. Return code = ',I3)
 9701 FORMAT (1H ,'GRIBEX : Error inserting/extracting length of ',
     C  ' Section 4. Return code = ',I3)
 9705 FORMAT (1H ,'GRIBEX : Only simple packing of data (real or ',
     C  'integer) allowed. Return code = ',I3)
 9706 FORMAT (1H ,'GRIBEX : Error in extracting section 4 flag field.',
     C  ' Return code = ',I3)
 9707 FORMAT (1H ,'GRIBEX : Error inserting/extracting scale factor.',
     C  ' Return code = ',I3)
 9708 FORMAT (1H ,'GRIBEX : Error inserting/extracting reference',
     C  ' value. Return code = ',I3)
 9709 FORMAT (1H ,'GRIBEX : Error inserting/extracting number of bits',
     C  ' per data value. Return code = ',I3)
 9710 FORMAT (1H ,'GRIBEX : Output array too small. Length is ',I8,
     C  ' words. Number of values is ',I8,' Return code = ',I3)
 9711 FORMAT (1H ,'GRIBEX : Error inserting/extracting real ',
     C  'coefficient. Return code = ',I3)
 9712 FORMAT (1H ,'GRIBEX : Error inserting/extracting data ',
     C  'values. Return code = ',I3)
 9713 FORMAT (1H ,'GRIBEX : Error inserting/extracting flag ',
     C  'and unused bit field. Return code = ',I3)
 9714 FORMAT (1H ,'GRIBEX : Function is X and ',
     C  'number of values is ',I3,'. Return code = ',I3)
 9715 FORMAT (1H ,'GRIBEX : Function is X and scanning mode is not',
     C  'North to South and West to East. Return code = ',I3)
 9716 FORMAT (1H ,'GRIBEX : Function is X and field is not ',
     C  'Gaussian or Latitude/longitude field. Return code = ',I3)
 9717 FORMAT (1H ,'GRIBEX : Function is X and a bit-map is included.',
     C  ' Return code = ',I3)
 9718 FORMAT (1H ,'GRIBEX : User supplied reference value ',F20.10,
     C  ' exceeds minimum value ',F20.10,'. Minimum value used.')
 9719 FORMAT (1H ,'GRIBEX : Following field is missing ***********')
 9720 FORMAT (1H ,'GRIBEX : Error inserting/extracting octet number',
     C  'at which packed data begins.',
     C  ' Return code = ',I3)
 9721 FORMAT (1H ,'GRIBEX : Error inserting/extracting ',
     C  'extended flag field.',
     C  ' Return code = ',I3)
 9722 FORMAT (1H ,'GRIBEX : Error inserting/extracting first or',
     C  'second dimension of matrix.',
     C  ' Return code = ',I3)
 9723 FORMAT (1H ,'GRIBEX : Error inserting/extracting six fields ',
     C  'from first dimension coordinate value onwards.',
     C  ' Return code = ',I3)
 9724 FORMAT (1H ,'GRIBEX : Error inserting/extracting first or ',
     C  'or second dimension coefficients.',
     C  ' Return code = ',I3)
 9725 FORMAT (1H ,'GRIBEX : Error inserting secondary ',
     C  'bit map. Return code = ',I3)
 9799 FORMAT (1H ,'GRIBEX : Error found when checking values for ',
     C  'Section 4 against valid GRIB values. Return code = ',I3)
 9801 FORMAT (1H ,'GRIBEX : Error inserting/extracting 7777 group.',
     C  ' Return code = ',I3)
 9802 FORMAT (1H ,'GRIBEX : Error inserting/extracting length of GRIB',
     C  ' message. Return code = ',I3)
 9805 FORMAT (1H ,'GRIBEX : End of message 7777 group not found.',
     C  ' Return code = ',I3)
 9806 FORMAT (1H ,'GRIBEX : Error extracting primary ',
     C  ' or secondary bit map. Return code = ',I3)
C
      END
      SUBROUTINE INSCAL (PDATA,KDATA,KLEN,PREF,PSCALE)
C
C**** INSCAL - Vectorise calculation of increments.
C
C     Purpose.
C     --------
C
C           Vectorise calculation of increments.
C
C**   Interface.
C     ----------
C
C           CALL INSCAL (PDATA,KDATA,KLEN,PREF,PSCALE)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               PDATA      - Array of floating point values.
C               KLEN       - Number of values to be converted.
C               PREF       - Reference value.
C               PSCALE     - Scale factor.
C
C               Output Parameters.
C               -----------------
C
C               KDATA      - Array of integer increments
C
C     Method.
C     -------
C
C           The reference value is subtracted from each value,
C           and the result is then divided by the scale factor.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes re GRIB representation.
C
C     Comments.
C     --------
C
C           PDATA and KDATA are really the same array. This routine
C           is just a device to force vectorisation on the Cray,
C           without the necessity of using another array.
C
C           Routine contains section 0 , 1 and 9.
C
C     Author.
C     -------
C
C           J. Hennessy     ECMWF     25.06.91
C
C     Modifications.
C     _____________
C
C           None.
C
C     -----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER KDATA
      INTEGER KLEN
      INTEGER J101
C
      REAL PDATA
      REAL PREF
      REAL PSCALE
C
      DIMENSION PDATA(KLEN)
      DIMENSION KDATA(KLEN)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Calculation of increments.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
      DO 101 J101 = 1,KLEN
         KDATA(J101) = NINT ( (PDATA(J101) - PREF) / PSCALE )
  101 CONTINUE
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
      RETURN
      END
      SUBROUTINE EXSCAL (PDATA,KDATA,KLEN,PREF,PSCALE)
C
C**** EXSCAL - Vectorise calculation of values.
C
C     Purpose.
C     --------
C
C           Vectorise calculation of values.
C
C**   Interface.
C     ----------
C
C           CALL EXSCAL (PDATA,KDATA,KLEN,PREF,PSCALE)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KDATA      - Array of integer increments
C               KLEN       - Number of values to be converted.
C               PREF       - Reference value.
C               PSCALE     - Scale factor.
C
C               Output Parameters.
C               -----------------
C
C               PDATA      - Array of floating point values.
C
C     Method.
C     -------
C
C           The reference value is added to each increment,
C           and the result is then multiplied by the scale factor.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes re GRIB representation.
C
C     Comments.
C     --------
C
C           PDATA and KDATA are really the same array. This routine
C           is just a device to force vectorisation on the Cray,
C           without the necessity of using another array.
C
C           Routine contains section 0 , 1 and 9.
C
C     Author.
C     -------
C
C           J. Hennessy     ECMWF     25.06.91
C
C     Modifications.
C     _____________
C
C           None.
C
C     -----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER KDATA
      INTEGER KLEN
      INTEGER J101
C
      REAL PDATA
      REAL PREF
      REAL PSCALE
C
      DIMENSION PDATA(KLEN)
      DIMENSION KDATA(KLEN)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Calculation of values.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
      DO 101 J101 = 1,KLEN
         PDATA(J101) = PREF + KDATA(J101) * PSCALE
  101 CONTINUE
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
C
      RETURN
      END
      SUBROUTINE RORINT (PDATA,KDATA,KLEN,HDIR)
C
C**** RORINT - Conversion of arrays between data types.
C
C     Purpose.
C     --------
C
C           Converts real arrays to integer and vice versa.
C
C**   Interface.
C     ----------
C
C           CALL RORINT (PDATA,KDATA,KLEN,HDIR)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KDATA      - Array of integer increments
C                            Input for 'R' function.
C               PDATA      - Array of floating point values.
C                            Input for 'I' function.
C               KLEN       - Number of values to be converted.
C               HDIR       - 'R', convert integer to real.
C                            'I', convert real to integer.
C
C               Output Parameters.
C               -----------------
C
C               KDATA      - Array of integer increments
C                            Output for 'I' function.
C               PDATA      - Array of floating point values.
C                            Output for 'R' function.
C
C     Method.
C     -------
C
C           Data types converted.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           None.
C
C     Comments.
C     --------
C
C           PDATA and KDATA are really the same array. This routine
C           is just a device to force vectorisation on the Cray,
C           without the necessity of using another array.
C
C           Routine contains section 0 , 1 and 9.
C
C     Author.
C     -------
C
C           J. Hennessy     ECMWF     27.09.91
C
C     Modifications.
C     _____________
C
C           None.
C
C     -----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      CHARACTER*(1) HDIR
C
      INTEGER KDATA
      INTEGER KLEN
      INTEGER J101
      INTEGER J102
C
      REAL PDATA
C
      DIMENSION PDATA(KLEN)
      DIMENSION KDATA(KLEN)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Conversion of data types.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
      IF (HDIR.EQ.'I')
     C   THEN
             DO 101 J101 = 1,KLEN
                KDATA(J101) = NINT (PDATA(J101))
  101        CONTINUE
         ELSE
             DO 102 J102 = 1,KLEN
                PDATA(J102) = FLOAT (KDATA(J102))
  102        CONTINUE
         ENDIF
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
      RETURN
      END
      SUBROUTINE DECFP2 (PVAL,KEXP,KMANT)
C
C**** DECFP2 - GRIB representation to floating point representation.
C
C     Purpose.
C     --------
C
C           Convert GRIB representation of a floating point
C           number to machine representation.
C
C**   Interface.
C     ----------
C
C           CALL DECFP2 (PVAL,KEXP,KMANT)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KEXP    - 8 Bit signed exponent.
C
C               KMANT   - 24 Bit mantissa.
C
C               Output Parameters.
C               -----------------
C
C               PVAL    - Floating point number represented
C                         by KEXP and KMANT.
C
C     Method.
C     -------
C
C           Floating point number represented as 8 bit exponent
C           and 24 bit mantissa in integer values converted to
C           machine floating point format.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes re GRIB representation.
C
C     Comments.
C     ---------
C
C           Rewritten from DECFP, to conform to programming standards.
C           Sign bit on 0 value now ignored, if present.
C
C           Routine contains sections 0 to 2 and section 9.
C
C     Author.
C     -------
C
C           John Hennessy   ECMWF   18.06.91
C
C     Modifications.
C     --------------
C
C           None.
C
C     -----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER IEXP
      INTEGER ISIGN
C
      INTEGER KEXP
      INTEGER KMANT
C
      REAL    PVAL
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Convert value of 0.0. Ignore sign bit.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
      IF ( (KEXP.EQ.128.OR.KEXP.EQ.0).AND.KMANT.EQ.0)
     C   THEN
             PVAL = 0.0
             GO TO 900
         ENDIF
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 . Convert other values.
C     -----------------------------------------------------------------
C
  200 CONTINUE
C
C
C     Sign of value.
C
      IEXP  = KEXP
      ISIGN = 1
C
      IF (IEXP.GE.128)
     C     THEN
               IEXP  = IEXP - 128
               ISIGN = -1
           END IF
C
C     Decode value.
C
      PVAL = ISIGN*2.**(-24)*KMANT*16.**(IEXP-64)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
      RETURN
C
      END
      SUBROUTINE GRCHK1 (KSEC1,KRET)
C
C**** GRCHK1 - Check parameters for Section 1 of GRIB code.
C
C     Purpose.
C     --------
C
C           Check parameters for Section 1 of GRIB code against
C           valid values for GRIB Code Edition 1.
C
C**   Interface.
C     ----------
C
C           CALL GRCHK1 (KSEC1,KRET)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KSEC1      - Array containing parameters for section
C                            1 of GRIB code.
C
C               Output Parameters.
C               ------------------
C
C               KRET       - Return code.
C                            0   , No error encountered.
C                            1   , Error in GRIB code parameter.
C
C     Method.
C     -------
C
C           Values checked against current code/flag tables
C           and against maximum or minimum permitted values.
C           They are also checked against the current status
C           of the implementation of GRIBEX and ECMWF usage.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes for GRIB code.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 2 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      18.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      30.08.91
C           Checks for bit-map present removed.
C           Check for negative value for century removed.
C
C           J. Hennessy      ECMWF      02.12.91
C           Changes to Table 2 and Parameter number checks.
C
C           J. Hennessy      ECMWF      22.07.92
C           Missing data value (255) allowed for originating centre
C           and parameter number.
C           Additional checks for experimental space view
C           perspective added.
C
C           J. Hennessy      ECMWF      09.11.92
C           Checks for ECMWF local use added.
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER IAC
      INTEGER IAVAC
      INTEGER IRET
      INTEGER ISTRE
      INTEGER ITAB1
      INTEGER ITAB3
      INTEGER ITAB4
      INTEGER ITAB5
      INTEGER ITEMP
      INTEGER ITYPE
C
      INTEGER JPAVAC
      INTEGER JPTYP
      INTEGER JPSTR
      INTEGER JP1
      INTEGER JP3
      INTEGER JP4
      INTEGER JP5
C
      INTEGER J208
      INTEGER J210
      INTEGER J220
      INTEGER J230
      INTEGER J232
      INTEGER J233
      INTEGER J235
C
      INTEGER KRET
      INTEGER KSEC1
C
      PARAMETER (JPAVAC=9)
      PARAMETER (JP1=4)
      PARAMETER (JP3=22)
      PARAMETER (JP4=9)
      PARAMETER (JP5=14)
      PARAMETER (JPTYP=20)
      PARAMETER (JPSTR=17)
C
      DIMENSION KSEC1(*)
C
      DIMENSION ITAB1(JP1)
      DIMENSION ITAB3(JP3)
      DIMENSION ITAB4(JP4)
      DIMENSION ITAB5(JP5)
      DIMENSION IAVAC(JPAVAC)
      DIMENSION ITYPE(JPTYP)
      DIMENSION ISTRE(JPSTR)
C
      SAVE ITAB1
      SAVE ITAB3
      SAVE ITAB4
      SAVE ITAB5
      SAVE IAVAC
      SAVE ITYPE
      SAVE ISTRE
C
C     Valid values given in Code Table 1.
C
      DATA ITAB1  /0,128,64,192/
C
C     Valid values given in Code Table 3.
C
      DATA ITAB3 /1,2,3,4,5,6,7,
     C            100,101,102,103,104,105,106,109,110,111,112,
     C            121,128,141,160/
C
C     Valid values given in Code Table 4.
C
      DATA ITAB4 /0,1,2,3,4,5,6,7,
     C            254/
C
C     Valid values given in Code Table 5.
C
      DATA ITAB5 /0,1,2,3,4,5,
     C            10,
     C            113,114,115,116,117,
     C            123,124/
C
C     Valid values given in Code Table 5, for averages and
C     accumulations.
C
      DATA IAVAC /3,4,
     C            113,114,115,116,117,
     C            123,124/
C
C     Valid values for type.
C
      DATA ITYPE /1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,
     C            20,30,31,32,40/
C
C     Valid values for stream.
C
      DATA ISTRE /51,201,251,1025,1035,1041,1042,
     C            1043,1044,1045,1050,1051,1052,1053,
     C            1054,1055,1060/
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set initial values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
C     Reset return code.
C
      KRET = 0
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 . Check values against code tables and extreme values.
C     ----------------------------------------------------------------
C
  200 CONTINUE
C
C*    Check Parameter Table version number.
C
      IF (KSEC1(1).LT.1.OR.KSEC1(1).GT.254)
     C   THEN
             WRITE (*,9001) KSEC1(1)
             KRET = 1
         ENDIF
C
C*    Check Identification of centre. Code Table 0.
C     Currently only values 1 to 98 inclusive are used.
C     Missing value indicator (255) is allowed.
C
      IF (KSEC1(2).LT.1.OR.KSEC1(2).GT.98)
     C   THEN
             IF (KSEC1(2).NE.255)
     C          THEN
                    WRITE (*,9002) KSEC1(2)
                    KRET = 1
                ENDIF
         ENDIF
C
C*    Check Generating process identification number.
C
      IF (KSEC1(3).LT.1.OR.KSEC1(3).GT.255)
     C   THEN
             WRITE (*,9003) KSEC1(3)
             KRET = 1
         ENDIF
C
C*    Check Grid definition.
C
      IF (KSEC1(4).LT.1.OR.KSEC1(4).GT.255)
     C   THEN
             WRITE (*,9004) KSEC1(4)
             KRET = 1
         ENDIF
C
C*    Check Flag. Code Table 1.
C
      DO 208 J208=1,JP1
         IF (KSEC1(5).EQ.ITAB1(J208)) GO TO 209
  208 CONTINUE
C
      WRITE (*,9005) KSEC1(5)
      KRET = 1
C
  209 CONTINUE
C
C*    Cross check that, if uncatalogued grid is specified, Section
C     2, Grid description section, is included.
C
      IF (KSEC1(4).EQ.255.AND.(KSEC1(5).EQ.0.OR.KSEC1(5).EQ.64))
     C   THEN
             KRET = 1
             WRITE (*,9014)
         ENDIF
C
C*    Check Parameter indicator. Code Table 2.
C
      IF (KSEC1(6).LT.1.OR.KSEC1(6).GT.255)
     C   THEN
             WRITE (*,9006) KSEC1(6)
             KRET = 1
         ENDIF
C
C*    Check ECMWF Parameter Table Number and Parameter Indicators.
C
      IF (KSEC1(1).GT.127.AND.KSEC1(6).LT.129.AND.KSEC1(2).EQ.98)
     C   THEN
             WRITE (*,9007) KSEC1(1) , KSEC1(6)
             KRET = 1
         ENDIF
C
C*    Check International Table useage.
C
      IF (KSEC1(1).LT.127.AND.KSEC1(6).GT.127)
     C   THEN
             WRITE (*,9024) KSEC1(6) , KSEC1(1)
         ENDIF
C
C*    Check Indicator of type of level. Code Table 3.
C     Experimental space view uses this field as satellite
C     identification.
C
      IF (KSEC1(6).NE.127)
     C   THEN
C
C            Type of level.
C
             IRET = 0
C
             DO 210 J210=1,JP3
                IF (KSEC1(7).EQ.ITAB3(J210)) GO TO 211
  210        CONTINUE
C
             IRET = 1
C
  211        CONTINUE
C
C            ECMWF uses 200 for pseudo-levels.
C
             IF (KSEC1(7).EQ.200.AND.KSEC1(2).EQ.98) IRET = 0
             IF (IRET.EQ.1)
     C          THEN
                    WRITE (*,9015) KSEC1(7)
                    KRET = 1
                ENDIF
         ELSE
C
C            Satellite identification.
C
             IF (KSEC1(7).NE.120.AND.KSEC1(7).NE.130.AND.
     C         KSEC1(7).NE.140.AND.KSEC1(7).NE.150)
     C           THEN
                     KRET = 1
                     WRITE (*,9027) KSEC1(7)
                 ENDIF
         ENDIF
C
C     For certain level types no description is necessary and
C     those fields should be 0.
C
      IF (KSEC1(7).LT.8.OR.KSEC1(7).EQ.102)
     C   THEN
             ITEMP = KSEC1(8) + KSEC1(9)
             IF (ITEMP.NE.0)
     C          THEN
                    KRET = 1
                    WRITE (*,9023) KSEC1(7) , KSEC1(8) , KSEC1(9)
                ENDIF
         ENDIF
C
C*    Check Year of century.
C
      IF (KSEC1(10).LT.0.OR.KSEC1(10).GT.99)
     C   THEN
             WRITE (*,9008) KSEC1(10)
             KRET = 1
         ENDIF
C
C*    Month check.
C
      IF (KSEC1(11).LT.1.OR.KSEC1(11).GT.12)
     C   THEN
             WRITE (*,9009) KSEC1(11)
             KRET = 1
         ENDIF
C
C*    Day check.
C
      IF (KSEC1(12).LT.1.OR.KSEC1(12).GT.31)
     C   THEN
             WRITE (*,9010) KSEC1(12)
             KRET = 1
         ENDIF
C
C*    Hour check.
C
      IF (KSEC1(13).LT.0.OR.KSEC1(13).GT.23)
     C   THEN
             WRITE (*,9011) KSEC1(13)
             KRET = 1
         ENDIF
C
C*    Minute check.
C
      IF (KSEC1(14).LT.0.OR.KSEC1(14).GT.59)
     C   THEN
             WRITE (*,9012) KSEC1(14)
             KRET = 1
         ENDIF
C
C*    Indicator of unit of time check. Code Table 4.
C
      DO 220 J220=1,JP4
         IF (KSEC1(15).EQ.ITAB4(J220)) GO TO 221
  220 CONTINUE
C
      WRITE (*,9013) KSEC1(15)
      KRET = 1
C
  221 CONTINUE
C
C*    Time range indicator check. Code Table 5.
C
      DO 230 J230=1,JP5
         IF (KSEC1(18).EQ.ITAB5(J230)) GO TO 231
  230 CONTINUE
C
      WRITE (*,9019) KSEC1(18)
      KRET = 1
C
  231 CONTINUE
C
C*    Cross check Time range indicator and Number averaged or
C     accumulated.
C
      IAC = 0
      DO 232 J232=1,JPAVAC
         IF (KSEC1(18).EQ.IAVAC(J232)) IAC = 1
  232 CONTINUE
C
C     If average or accumulation check for valid numbers
C     of included and missing values.
C
      IF (IAC.EQ.1.)
     C   THEN
             IF (KSEC1(19).LT.2)
     C          THEN
                    WRITE (*,9016) KSEC1(18) , KSEC1(19)
                    KRET = 1
                ENDIF
             IF (KSEC1(20).LT.0.OR.KSEC1(20).GE.KSEC1(19))
     C          THEN
                    WRITE (*,9020) KSEC1(18) , KSEC1(20)
                    KRET = 1
                ENDIF
         ENDIF
C
C*    Century check.
C
C     ECMWF data starts in 20th century.
C
      IF (KSEC1(21).LT.20.AND.KSEC1(2).EQ.98)
     C   THEN
             WRITE (*,9021) KSEC1(21)
             KRET = 1
         ENDIF
C
C*    Decimal scale factor check.
C
C     At ECMWF the scale factor is always 0.
C
      IF (KSEC1(23).NE.0.AND.KSEC1(2).EQ.98)
     C   THEN
             WRITE (*,9022) KSEC1(23)
             KRET = 1
         ENDIF
C
C*    Flag field, indicating local ECMWF usage.
C
      IF (KSEC1(24).NE.0.AND.KSEC1(24).NE.1)
     C   THEN
             WRITE (*,9025)
             KRET = 1
         ENDIF
C
C*    Reserved field.
C
      IF (KSEC1(25).NE.0) WRITE (*,9026)
C
C*    Check validity of values for ECMWF local use.
C
      IF (KSEC1(24).EQ.1.AND.KSEC1(2).EQ.98)
     C   THEN
C
C            Check local definition number.
C
             IF (KSEC1(37).NE.1.AND.KSEC1(37).NE.2)
     C          THEN
                    KRET = 1
                    WRITE (*,9101) KSEC1(37)
                ENDIF
C
C            Check Class.
C
             IF (KSEC1(38).NE.1.AND.KSEC1(38).NE.2)
     C          THEN
                    KRET = 1
                    WRITE (*,9102) KSEC1(38)
                ENDIF
C
C            Check Type.
C
             DO 233 J233=1,JPTYP
                IF (KSEC1(39).EQ.ITYPE(J233)) GO TO 234
  233        CONTINUE
C
             WRITE (*,9103)
             KRET = 1
C
  234        CONTINUE
C
C            Check Stream.
C
             DO 235 J235=1,JPSTR
                IF (KSEC1(40).EQ.ISTRE(J235)) GO TO 236
  235        CONTINUE
C
             WRITE (*,9104)
             KRET = 1
C
  236        CONTINUE
C
C            Check Version Number.
C
C
C            Check ECMWF local definition 1.
C
             IF (KSEC1(37).EQ.1)
     C          THEN
C
C                   Check ensemble forecast number.
C
                    IF (KSEC1(42).LT.0.OR.KSEC1(42).GT.255)
     C                 THEN
                           KRET = 1
                           WRITE (*,9105)
                       ENDIF
C
C                   Check total forecasts number.
C
                    IF (KSEC1(43).LT.1.OR.KSEC1(43).GT.255)
     C                 THEN
                           KRET = 1
                           WRITE (*,9106)
                       ENDIF
                ENDIF
C
C            Check ECMWF local definition 2.
C
             IF (KSEC1(37).EQ.2)
     C          THEN
C
C                   Check cluster number.
C
                    IF (KSEC1(42).LT.1.OR.KSEC1(42).GT.255)
     C                 THEN
                           KRET = 1
                           WRITE (*,9107)
                       ENDIF
C
C                   Check total number of clusters.
C
                    IF (KSEC1(43).LT.1.OR.KSEC1(43).GT.255)
     C                 THEN
                           KRET = 1
                           WRITE (*,9108)
                       ENDIF
C
C                   Check clustering method.
C
                    IF (KSEC1(44).LT.1.OR.KSEC1(44).GT.3)
     C                 THEN
                           KRET = 1
                           WRITE (*,9109)
                       ENDIF
C
C                   Check start time step.
C
C                   Check end time step.
C
C                   Check northern latitude of domain of clustering.
C
C                   Check western longitude of domain of clustering.
C
C                   Check southern latitude of domain of clustering.
C
C                   Check eastern longitude of domain of clustering.
C
C                   Check cluster number of operational forecast.
C
C                   Check cluster number of control forecast.
C
C                   Check number of forecasts in the cluster.
C
                ENDIF
C
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine. Format statements.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
 9001 FORMAT (1H ,'GRCHK1 : Invalid Parameter Table version number - ',
     C             I5)
 9002 FORMAT (1H ,'GRCHK1 : Invalid Identification of Centre - ',I5)
 9003 FORMAT (1H ,'GRCHK1 : Invalid Generating Process - ',I5)
 9004 FORMAT (1H ,'GRCHK1 : Invalid Grid Definition - ',I5)
 9005 FORMAT (1H ,'GRCHK1 : Invalid flag field - ',I5,' decimal.')
 9006 FORMAT (1H ,'GRCHK1 : Invalid Indicator of parameter - ',I5)
 9007 FORMAT (1H ,'GRCHK1 : Inconsistent version number ECMWF Code ',
     C            'Table 2 - ',I5,' and Indicator of parameter - ',I5)
 9008 FORMAT (1H ,'GRCHK1 : Invalid year of century - ',I5)
 9009 FORMAT (1H ,'GRCHK1 : Invalid month - ',I5)
 9010 FORMAT (1H ,'GRCHK1 : Invalid day - ',I5)
 9011 FORMAT (1H ,'GRCHK1 : Invalid hour - ',I5)
 9012 FORMAT (1H ,'GRCHK1 : Invalid minute - ',I5)
 9013 FORMAT (1H ,'GRCHK1 : Invalid Indicator of unit of time - ',I5)
 9014 FORMAT (1H ,'GRCHK1 : Uncatalogued grid and no Section 2.')
 9015 FORMAT (1H ,'GRCHK1 : Invalid indicator of type of level - ',I5)
 9016 FORMAT (1H ,'GRCHK1 : Inconsistent Time Range Indicator',
     C            ' - ',I5,' and number included in averages - ',I5)
 9019 FORMAT (1H ,'GRCHK1 : Invalid Time Range Indicator - ',I5)
 9020 FORMAT (1H ,'GRCHK1 : Inconsistent Time Range Indicator',
     C            ' - ',I5,' and number missing from averages - ',I5)
 9021 FORMAT (1H ,'GRCHK1 : Invalid century of reference time - ',I5)
 9022 FORMAT (1H ,'GRCHK1 : Invalid decimal scale factor - ',I5)
 9023 FORMAT (1H ,'GRCHK1 : For level type ',I3,' descriptions are',
     C            'invalid - ',I5,3X,I5)
 9024 FORMAT (1H ,'GRCHK1 : ** WARNING ** Parameter number ',I3,' is',
     C            ' not defined in International Table number ',I3,'.')
 9025 FORMAT (1H ,'GRCHK1 : Local use flag KSEC1(24) should be',
     C                      ' 0 or 1.')
 9026 FORMAT (1H ,'GRCHK1 : Reserved field KSEC1(25) should be 0 to ',
     C                      'avoid problems with future releases.')
 9027 FORMAT (1H ,'GRCHK1 : Invalid satellite identifier - ',I5)
C
 9101 FORMAT (1H ,'GRCHK1 : Invalid local use definition - ',I5)
C
 9102 FORMAT (1H ,'GRCHK1 : Invalid class - ',I5)
C
 9103 FORMAT (1H ,'GRCHK1 : Invalid type - ',I5)
C
 9104 FORMAT (1H ,'GRCHK1 : Invalid stream - ',I5)
C
 9105 FORMAT (1H ,'GRCHK1 : Invalid ensemble forecast number - ',I5)
C
 9106 FORMAT (1H ,'GRCHK1 : Invalid total number of forecasts - ',I5)
C
 9107 FORMAT (1H ,'GRCHK1 : Invalid cluster number - ',I5)
C
 9108 FORMAT (1H ,'GRCHK1 : Invalid total number of clusters - ',I5)
C
 9109 FORMAT (1H ,'GRCHK1 : Invalid clustering method - ',I5)
C
      RETURN
C
      END
      SUBROUTINE GRCHK2 (KSEC1,KSEC2,PSEC2,KRET)
C
C**** GRCHK2 - Check parameters for Section 2 of GRIB Code.
C
C     Purpose.
C     --------
C
C           Check parameters for Section 2 of GRIB code against
C           valid values for GRIB Edition 1.
C
C**   Interface.
C     ----------
C
C           CALL GRCHK2 (KSEC1,KSEC2,PSEC2,KRET)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KSEC1      - Array containing integer parameters for
C                            section 1 of GRIB code.
C
C               KSEC2      - Array containing integer parameters for
C                            section 2 of GRIB code.
C
C               PSEC2      - Array containing real parameters for
C                            section 2 of GRIB code.
C
C               Output Parameters.
C               ------------------
C
C               KRET       - Return code.
C                            0   , No error encountered.
C                            1   , Error in GRIB Code parameter.
C
C     Method.
C     -------
C
C           Values checked against current code/flag tables
C           and against maximum or minimum permitted values.
C           They are also checked against the current status
C           of the implementation of GRIBEX and ECMWF usage.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes for GRIB Code.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 5 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      18.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      30.08.91
C           Polar stereographic representation type allowed.
C
C           J. Hennessy      ECMWF      01.10.91
C           Space view or orthographic representation allowed.
C           Additional parameters KSEC1 and PSEC2 added.
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER ITAB6
      INTEGER ITAB6X
      INTEGER ITAB8
C
      INTEGER JP6
      INTEGER JP6X
      INTEGER JP8
C
      INTEGER J201
      INTEGER J203
      INTEGER J301
      INTEGER J401
C
      INTEGER KRET
      INTEGER KSEC1
      INTEGER KSEC2
C
      REAL    PSEC2
C
      PARAMETER (JP6=22)
      PARAMETER (JP6X=14)
      PARAMETER (JP8=8)
C
      DIMENSION KSEC1(*)
      DIMENSION KSEC2(*)
C
      DIMENSION ITAB6(JP6)
      DIMENSION ITAB6X(JP6X)
      DIMENSION ITAB8(JP8)
C
      DIMENSION PSEC2(*)
C
C     Valid values given in Code Table 6.
C
      DATA ITAB6 /0,1,2,3,4,5,6,7,8,9,10,13,14,
     C            20,24,30,34,50,60,70,80,90/
C
C     Code Table 6 values currently (04.10.91) supported by GRIBEX.
C
      DATA ITAB6X /0,4,5,10,14,
     C            20,24,30,34,50,60,70,80,90/
C
C     Valid values given in Code Table 8.
C
      DATA ITAB8 /0,128,64,192,32,160,96,224/
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set initial values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
C     Reset return code.
C
      KRET = 0
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 . Check values against code tables and extreme values.
C     ----------------------------------------------------------------
C
  200 CONTINUE
C
C*    Number of vertical coordinate parameters.
C
      IF (KSEC2(12).LT.0.OR.KSEC2(12).GT.255)
     C   THEN
             KRET = 1
             WRITE (*,9019) KSEC2(12)
         ENDIF
C
C*    Check Data Representation Type.
C
      DO 201 J201=1,JP6
         IF (KSEC2(1).EQ.ITAB6(J201)) GO TO 202
  201 CONTINUE
C
      KRET = 1
      WRITE (*,9001) KSEC2(1)
C
  202 CONTINUE
C
C*    Check Data Representation Type currently supported.
C
      DO 203 J203=1,JP6X
         IF (KSEC2(1).EQ.ITAB6X(J203)) GO TO 204
  203 CONTINUE
C
      KRET = 1
      WRITE (*,9002) KSEC2(1)
      GO TO 900
C
  204 CONTINUE
C
C*    Earth flag.
C
      IF (KSEC2(18).NE.0.AND.KSEC2(18).NE.64)
     C   THEN
             KRET = 1
             WRITE (*,9005) KSEC2(18)
         ENDIF
C
C*    Check ECMWF usage.(0 except for space view perspective)
C
      IF (KSEC2(18).NE.0.AND.KSEC1(2).EQ.98.AND.KSEC2(1).NE.90)
     C   THEN
             KRET = 1
             WRITE (*,9007)
         ENDIF
C
C*     Components flag.
C
      IF (KSEC2(19).NE.0.AND.KSEC2(19).NE.8)
     C   THEN
             KRET = 1
             WRITE (*,9006) KSEC2(19)
         ENDIF
C
C*    Check ECMWF usage.
C
      IF (KSEC2(19).NE.0.AND.KSEC1(2).EQ.98)
     C   THEN
             KRET = 1
             WRITE (*,9008)
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 3. Checks on latitude/longitude grids.
C     ----------------------------------------------------------------
C
  300 CONTINUE
C
      IF (KSEC2(1).EQ.0.OR.KSEC2(1).EQ.10.OR.KSEC2(1).EQ.20.
     C                 OR.KSEC2(1).EQ.30)
     C   THEN
C
C*           Number of points along a parallel.
C
             IF (KSEC2(2).LT.1.OR.KSEC2(2).GT.65535)
     C          THEN
                    KRET = 1
                    WRITE (*,9022) KSEC2(2)
                ENDIF
C
C*           Number of points along a meridian.
C
             IF (KSEC2(3).LT.1.OR.KSEC2(3).GT.65535)
     C          THEN
                    KRET = 1
                    WRITE (*,9023) KSEC2(3)
                ENDIF
C
C
C*           Latitude of first grid point.
C
             IF (KSEC2(4).LT.-90000.OR.KSEC2(4).GT.90000)
     C          THEN
                    KRET = 1
                    WRITE (*,9015) KSEC2(4)
                ENDIF
C
C*           Longitude of first grid point.
C
             IF (KSEC2(5).LT.-360000.OR.KSEC2(5).GT.360000)
     C          THEN
                    KRET = 1
                    WRITE (*,9016) KSEC2(5)
                ENDIF
C
C*           Resolution flag.
C
             IF (KSEC2(6).NE.0.AND.KSEC2(6).NE.128)
     C          THEN
                    KRET = 1
                    WRITE (*,9003) KSEC2(6)
                ENDIF
C
C*           Latitude of last grid point.
C
             IF (KSEC2(7).LT.-90000.OR.KSEC2(7).GT.90000)
     C          THEN
                    KRET = 1
                    WRITE (*,9020) KSEC2(7)
                ENDIF
C
C*           Longitude of last grid point.
C
             IF (KSEC2(8).LT.-360000.OR.KSEC2(8).GT.360000)
     C          THEN
                    KRET = 1
                    WRITE (*,9021) KSEC2(8)
                ENDIF
C
C*           Direction increments, if included.
C
             IF (KSEC2(6).EQ.128)
     C          THEN
                    IF (KSEC2(9).LT.1.OR.KSEC2(9).GT.65535)
     C                 THEN
                           KRET = 1
                           WRITE (*,9024) KSEC2(9)
                       ENDIF
C
                    IF (KSEC2(10).LT.1.OR.KSEC2(10).GT.65535)
     C                 THEN
                           KRET = 1
                           WRITE (*,9025) KSEC2(10)
                       ENDIF
                ENDIF
C
C*           Scanning mode flag.
C
             DO 301 J301=1,JP8
                IF (KSEC2(11).EQ.ITAB8(J301)) GO TO 302
  301        CONTINUE
C
             KRET = 1
             WRITE (*,9004) KSEC2(11)
C
  302        CONTINUE
C
C*           Regular / Quasi-regular grid check.
C
             IF (KSEC2(17).NE.0.AND.KSEC2(17).NE.1)
     C          THEN
                    KRET = 1
                    WRITE (*,9009) KSEC2(17)
                ENDIF
C
C*           Check currently supported values.
C
             IF (KSEC2(17).NE.0)
     C          THEN
                    KRET = 1
                    WRITE (*,9010)
                ENDIF
C
             GO TO 900
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 4. Checks on Gaussian grids.
C     ----------------------------------------------------------------
C
  400 CONTINUE
C
      IF (KSEC2(1).EQ.4.OR.KSEC2(1).EQ.14.OR.KSEC2(1).EQ.24.
     C                 OR.KSEC2(1).EQ.34)
     C   THEN
C
C*           Latitude of first grid point.
C
             IF (KSEC2(4).LT.-90000.OR.KSEC2(4).GT.90000)
     C          THEN
                    KRET = 1
                    WRITE (*,9015) KSEC2(4)
                ENDIF
C
C*           Longitude of first grid point.
C
             IF (KSEC2(5).LT.-360000.OR.KSEC2(5).GT.360000)
     C          THEN
                    KRET = 1
                    WRITE (*,9016) KSEC2(5)
                ENDIF
C
C*           Latitude of last grid point.
C
             IF (KSEC2(7).LT.-90000.OR.KSEC2(7).GT.90000)
     C          THEN
                    KRET = 1
                    WRITE (*,9020) KSEC2(7)
                ENDIF
C
C*           Longitude of last grid point.
C
             IF (KSEC2(8).LT.-360000.OR.KSEC2(8).GT.360000)
     C          THEN
                    KRET = 1
                    WRITE (*,9021) KSEC2(8)
                ENDIF
C
C*           i-direction increment, if included.
C
             IF (KSEC2(6).EQ.128)
     C          THEN
                    IF (KSEC2(9).LT.1.OR.KSEC2(9).GT.65535)
     C                 THEN
                           KRET = 1
                           WRITE (*,9024) KSEC2(9)
                       ENDIF
                ENDIF
C
C*           Number of parallels beween pole and equator.
C
             IF (KSEC2(10).LT.1.OR.KSEC2(10).GT.65535)
     C          THEN
                    KRET = 1
                    WRITE (*,9026) KSEC2(10)
                ENDIF
C
C*           Increment flag.
C
             IF (KSEC2(6).NE.0.AND.KSEC2(6).NE.128)
     C          THEN
                    KRET = 1
                    WRITE (*,9003) KSEC2(6)
                ENDIF
C
C*           Scanning mode flag.
C
             DO 401 J401=1,JP8
                IF (KSEC2(11).EQ.ITAB8(J401)) GO TO 402
  401        CONTINUE
C
             KRET = 1
             WRITE (*,9004) KSEC2(11)
C
  402        CONTINUE
C
C*           Regular / Quasi-regular grid check.
C
             IF (KSEC2(17).NE.0.AND.KSEC2(17).NE.1)
     C          THEN
                    KRET = 1
                    WRITE (*,9009) KSEC2(17)
                ENDIF
C
C*           Cross-check increments flag and quasi-regular indicator.
C
             IF (KSEC2(17).EQ.1.AND.KSEC2(6).EQ.128)
     C          THEN
                    KRET = 1
                    WRITE (*,9011)
                ENDIF
C
             GO TO 900
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 5. Checks on Polar Stereographic data.
C
C     ----------------------------------------------------------------
C
  500 CONTINUE
C
      IF (KSEC2(1).EQ.5)
     C   THEN
C
C*           Number of points along X-axis.
C
             IF (KSEC2(2).LT.1.OR.KSEC2(2).GT.65535)
     C          THEN
                    KRET = 1
                    WRITE (*,9027) KSEC2(2)
                ENDIF
C
C*           Number of points along Y-axis.
C
             IF (KSEC2(3).LT.1.OR.KSEC2(3).GT.65535)
     C          THEN
                    KRET = 1
                    WRITE (*,9028) KSEC2(3)
                ENDIF
C
C*           Latitude of first grid point.
C
             IF (KSEC2(4).LT.-90000.OR.KSEC2(4).GT.90000)
     C          THEN
                    KRET = 1
                    WRITE (*,9015) KSEC2(4)
                ENDIF
C
C*           Longitude of first grid point.
C
             IF (KSEC2(5).LT.-360000.OR.KSEC2(5).GT.360000)
     C          THEN
                    KRET = 1
                    WRITE (*,9016) KSEC2(5)
                ENDIF
C
C*           Orientation of the grid.
C
             IF (KSEC2(7).LT.-360000.OR.KSEC2(7).GT.360000)
     C          THEN
                    KRET = 1
                    WRITE (*,9017) KSEC2(7)
                ENDIF
C
C*           Grid lengths.
C
             IF (KSEC2(9).LT.1.OR.KSEC2(9).GT.16777215)
     C          THEN
                    KRET = 1
                    WRITE (*,9029) KSEC2(9)
                ENDIF
C
             IF (KSEC2(10).LT.1.OR.KSEC2(10).GT.16777215)
     C          THEN
                    KRET = 1
                    WRITE (*,9030) KSEC2(10)
                ENDIF
C
C*           Projection centre. The use of 1 in this octet is
C            inconsistent with Lambert conformal et al representation
C            where bit 1 is set 1 to indicate North pole. !!!!!!!!!
C
             IF (KSEC2(13).NE.0.AND.KSEC2(13).NE.1)
     C          THEN
                    KRET = 1
                    WRITE (*,9018) KSEC2(13)
                ENDIF
C
             GO TO 900
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 6. Checks on spherical harmonic data.
C     ----------------------------------------------------------------
C
  600 CONTINUE
C
      IF (KSEC2(1).EQ.50.OR.KSEC2(1).EQ.60.OR.KSEC2(1).EQ.70.
     C                 OR.KSEC2(1).EQ.80)
     C   THEN
C
C*           Spectral data representation type.
C
             IF (KSEC2(5).NE.1)
     C          THEN
                    KRET = 1
                    WRITE (*,9012) KSEC2(5)
                ENDIF
C
C*           Spectral data representation mode.
C
             IF (KSEC2(6).NE.1.AND.KSEC2(6).NE.2)
     C          THEN
                    KRET = 1
                    WRITE (*,9013) KSEC2(6)
                ENDIF
             IF (KSEC2(6).NE.1) WRITE (*,9014)
C
             GO TO 900
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 7 . Checks on space view perspective.
C     ----------------------------------------------------------------
C
  700 CONTINUE
C
      IF (KSEC2(1).EQ.90)
     C   THEN
             GO TO 900
         ENDIF
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine. Format statements.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
 9001 FORMAT (1H ,'GRCHK2 : Invalid data representation type - ',I3)
 9002 FORMAT (1H ,'GRCHK2 : Unsupported data representation type - ',I3)
 9003 FORMAT (1H ,'GRCHK2 : Invalid increments flag - ',I3)
 9004 FORMAT (1H ,'GRCHK2 : Invalid scanning mode flag - ',I3)
 9005 FORMAT (1H ,'GRCHK2 : Invalid earth flag - ',I3)
 9006 FORMAT (1H ,'GRCHK2 : Invalid components flag - ',I3)
 9007 FORMAT (1H ,'GRCHK2 : Earth flag - ECMWF usage is 0.')
 9008 FORMAT (1H ,'GRCHK2 : Components flag - ECMWF usage is 0.')
 9009 FORMAT (1H ,'GRCHK2 : Invalid quasi / regular indicator - ',I3)
 9010 FORMAT (1H ,'GRCHK2 : Quasi-regular latitude/longitude grids',
     C            ' not catered for.')
 9011 FORMAT (1H ,'GRCHK2 : Quasi-regular Gaussian grid cannot have',
     C            ' direction increments included.')
 9012 FORMAT (1H ,'GRCHK2 : Invalid spectral representation type - ',I3)
 9013 FORMAT (1H ,'GRCHK2 : Invalid spectral representation mode - ',I3)
 9014 FORMAT (1H ,'GRCHK2 : Complex spectral representation mode ',
     C            'not catered for.')
 9015 FORMAT (1H ,'GRCHK2 : Invalid latitude of first grid point - ',
     C               I10)
 9016 FORMAT (1H ,'GRCHK2 : Invalid longitude of first grid point - ',
     C               I10)
 9017 FORMAT (1H ,'GRCHK2 : Invalid orientation of the grid - ',
     C               I10)
 9018 FORMAT (1H ,'GRCHK2 : Invalid projection centre flag - ',I3)
 9019 FORMAT (1H ,'GRCHK2 : Invalid number of vertical coordinate ',
     C            'parameters - ',I8)
 9020 FORMAT (1H ,'GRCHK2 : Invalid latitude of last grid point - ',
     C               I10)
 9021 FORMAT (1H ,'GRCHK2 : Invalid longitude of last grid point - ',
     C               I10)
 9022 FORMAT (1H ,'GRCHK2 : Invalid number of points along a parallel',
     C              ' - ', I10)
 9023 FORMAT (1H ,'GRCHK2 : Invalid number of points along a meridian',
     C              ' - ', I10)
 9024 FORMAT (1H ,'GRCHK2 : Invalid i-direction increment - ',I10)
 9025 FORMAT (1H ,'GRCHK2 : Invalid j-direction increment - ',I10)
 9026 FORMAT (1H ,'GRCHK2 : Invalid number of parallels - ',I10)
 9027 FORMAT (1H ,'GRCHK2 : Invalid number of points along X-axis',
     C              ' - ', I10)
 9028 FORMAT (1H ,'GRCHK2 : Invalid number of points along Y-axis',
     C              ' - ', I10)
 9029 FORMAT (1H ,'GRCHK2 : Invalid X-direction grid length - ',I10)
 9030 FORMAT (1H ,'GRCHK2 : Invalid Y-direction grid length - ',I10)
C
      RETURN
C
      END
      SUBROUTINE QU2REG (PFIELD,KPOINT,KLAT,KLON,KCODE)
C
C**** QU2REG - Convert quasi-regular grid data to regular.
C
C     Purpose.
C     --------
C
C           Convert quasi-regular grid data to regular,
C           using either a linear or cubic interpolation.
C
C**   Interface.
C     ----------
C
C           CALL QU2REG (PFIELD,KPOINT,KLAT,KLON,KCODE)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               PFIELD     - Array containing quasi-regular grid
C                            data.
C
C               KPOINT     - Array containing list of the number of
C                            points on each latitude (or longitude) of
C                            the quasi-regular grid.
C
C               KLAT       - Number of latitude lines
C
C               KLON       - Number of longitude lines
C
C               KCODE      - Interpolation required.
C                            1 , linear - data quasi-regular on
C                                         latitude lines.
C                            3 , cubic - data quasi-regular on
C                                         latitude lines.
C                            11, linear - data quasi-regular on
C                                         longitude lines.
C                            13, cubic - data quasi-regular on
C                                         longitude lines.
C
C               Output Parameters.
C               ------------------
C
C               PFIELD     - Array containing regular grid data.
C
C     Method.
C     -------
C
C           Data is interpolated and expanded into a temporary array,
C           which is then copied back into the user's array.
C           Routine aborts if an invalid interpolation is requested or
C           field size exceeds array dimensions.
C
C     Externals.
C     ----------
C
C           ROWINA
C           ABORTX
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes for GRIB code specifications of
C           quasi-regular grids.
C
C     Comments.
C     ---------
C
C           This routine is an adaptation of INTPGRR and runs
C           on the Cray only.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      18.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      08.10.91
C           Call to ROWINT changed to call to ROWINA.
C           ROWINA called if only number of values required is not
C           the same as the input number.
C
C           J. Hennessy      ECMWF      07.01.92
C           Call to ABORT changed to ABORTX.
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0. Definition of variables. Data statements.
C     -----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER ICODE
      INTEGER ILII
      INTEGER ILIO
      INTEGER IQUANO
      INTEGER IREGNO
C
      INTEGER JPMAX
C
      INTEGER J210
      INTEGER J220
      INTEGER J225
      INTEGER J230
      INTEGER J240
C
      INTEGER KCODE
      INTEGER KLAT
      INTEGER KLON
      INTEGER KPOINT
C
      REAL    PFIELD
C
      REAL    ZLINE
      REAL    ZTEMP
      REAL    ZWORK
C
C     Maximum number of latitudes (or longitudes), for which arrays
C     are dimensioned.
C
      PARAMETER (JPMAX=320)
C
      DIMENSION PFIELD(*)
      DIMENSION ZTEMP(JPMAX*JPMAX*2)
      DIMENSION ZLINE(JPMAX*2)
      DIMENSION ZWORK(0:JPMAX*2+2,3)
C
      DIMENSION KPOINT(*)
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1. Set initial values.
C     ------------------------------------------------------------------
C
  100 CONTINUE
C
C     Check input parameters.
C
      IF (KCODE.NE.1.AND.KCODE.NE.3.AND.
     C    KCODE.NE.11.AND.KCODE.NE.13)
     C   THEN
             WRITE (*,9001) KCODE
             CALL ABORTX ('QU2REG')
         ENDIF
C
      IF (KLAT.GT.JPMAX)
     C   THEN
             WRITE (*,9002) KLAT , JPMAX
             CALL ABORTX ('QU2REG')
         ENDIF
C
      IF (KLON.GT.JPMAX*2)
     C   THEN
             WRITE (*,9003) KLAT , JPMAX*2
             CALL ABORTX ('QU2REG')
         ENDIF
C
C     Set array indices to 0.
C
      ILII  = 0
      ILIO  = 0
C
C     Establish values of loop parameters.
C
      IF (KCODE.GT.10)
     C   THEN
C
C            Quasi-regular along longitude lines.
C
             IQUANO = KLON
             IREGNO = KLAT
             ICODE  = KCODE - 10
         ELSE
C
C            Quasi-regular along latitude lines.
C
             IQUANO = KLAT
             IREGNO = KLON
             ICODE  = KCODE
         ENDIF
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2. Interpolate field from quasi to regular grid.
C     ------------------------------------------------------------------
C
  200 CONTINUE
C
      DO 230 J230=1,IQUANO
C
         IF (IREGNO.NE.KPOINT(J230))
     C      THEN
C
C               Line contains less values than required,so
C               extract quasi-regular grid values for a line
C
                DO 210 J210=1,KPOINT(J230)
                   ILII        = ILII+1
                   ZLINE(J210) = PFIELD(ILII)
  210           CONTINUE
C
C               and interpolate this line.
C
                CALL ROWINA (ZLINE,IREGNO,KPOINT(J230),ZWORK,ICODE)
C
C               Add regular grid values for this line to the temporary
C               array.
C
                DO 220 J220=1,IREGNO
                   ILIO        = ILIO+1
                   ZTEMP(ILIO) = ZLINE(J220)
  220           CONTINUE
C
            ELSE
C
C               Line contains the required number of values, so add
C               this line to the temporary array.
C
                DO 225 J225=1,IREGNO
                   ILIO        = ILIO+1
                   ILII        = ILII+1
                   ZTEMP(ILIO) = PFIELD(ILII)
  225           CONTINUE
C
            ENDIF
C
  230 CONTINUE
C
C     Copy temporary array to user array.
C
      DO 240 J240=1,KLON*KLAT
         PFIELD(J240) = ZTEMP(J240)
  240 CONTINUE
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9. Return to calling routine. Format statements.
C     ------------------------------------------------------------------
C
  900 CONTINUE
C
 9001 FORMAT (1H ,'QU2REG : Invalid interpolation type code = ',I3)
C
 9002 FORMAT (1H ,'QU2REG : Number of latitudes is ',I4,', maximum ',
     C                      'allowed is ',I3,'.')
C
 9003 FORMAT (1H ,'QU2REG : Number of longitudes is ',I4,', maximum ',
     C                      'allowed is ',I3,'.')
C
      RETURN
C
      END
      SUBROUTINE SCM0   (PDL,PDR,PFL,PFR,KLG)
C
C**** SCM0   - Apply SCM0 limiter to derivative estimates.
C
C    M. HORTAL    ECMWF February 1991  closely following D. WILLIAMSON
C
C    Apply SCM0 limiter to derivative estimates.
C
C   output:
C     pdl   = the limited derivative at the left edge of the interval
C     pdr   = the limited derivative at the right edge of the interval
C
C   inputs
C     pdl   = the original derivative at the left edge
C     pdr   = the original derivative at the right edge
C     pfl   = function value at the left edge of the interval
C     pfr   = function value at the right edge of the interval
C     klg  = number of intervals where the derivatives are limited
C
      DIMENSION PDL(KLG),PDR(KLG),PFL(KLG),PFR(KLG)
  100 CONTINUE
C
C    define constants
C
      ZEPS=1.E-12
      ZFAC=3.*(1.-ZEPS)
C
      DO 200 JL=1,KLG
      IF(ABS(PFR(JL)-PFL(JL)).GT.ZEPS) THEN
          ZALPHA=PDL(JL)/(PFR(JL)-PFL(JL))
          ZBETA =PDR(JL)/(PFR(JL)-PFL(JL))
          IF(ZALPHA.LE.0.) PDL(JL)=0.
          IF(ZBETA .LE.0.) PDR(JL)=0.
          IF(ZALPHA.GT.ZFAC) PDL(JL)=ZFAC*(PFR(JL)-PFL(JL))
          IF(ZBETA .GT.ZFAC) PDR(JL)=ZFAC*(PFR(JL)-PFL(JL))
      ELSE
          PDL(JL)=0.
          PDR(JL)=0.
      ENDIF
  200 CONTINUE
      END
      SUBROUTINE CONFP3 (PVAL,KEXP,KMANT,KBITS,KROUND)
C
C**** CONFP3 - Convert floating point number to GRIB representation.
C
C     Purpose.
C     --------
C
C           Convert floating point number from machine
C           representation to GRIB representation.
C
C**   Interface.
C     ----------
C
C           CALL CONFP3 (PVAL,KEXP,KMANT,KBITS,KROUND)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               PVAL    - Floating point number to be converted.
C
C               KBITS   - Number of bits in computer word.
C
C               KROUND  - Conversion type.
C                         0 , Closest number in GRIB format less than
C                             original number.
C                         1 , Closest number in GRIB format to the
C                             original number (equal to, greater than or
C                             less than original number).
C                         10 , as for 0 but with debug printout.
C                         11 , as for 1 but with debug printout.
C
C               Output Parameters.
C               -----------------
C
C               KEXP    - 8 Bit signed exponent.
C
C               KMANT   - 24 Bit mantissa.
C
C     Method.
C     -------
C
C           Floating point number represented as 8 bit signed
C           exponent and 24 bit mantissa in integer values.
C
C     Externals.
C     ----------
C
C           DECFP2
C           ABORTX
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes re GRIB representation.
C
C     Comments.
C     ---------
C
C           Routine aborts if an invalid conversion type
C           parameter is used or if a 24 bit mantissa is not
C           produced.
C
C           Routine contains sections 0 to 2 and section 9.
C
C     Author.
C     -------
C
C           John Hennessy   ECMWF   18.06.91
C
C     Modifications.
C     --------------
C
C           John Hennessy   ECMWF   24.09.91
C           Corrections made to descriptions of input parameter KROUND.
C           Changes to comments and format statements.
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Set initial values.
C     -----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER IEXP
      INTEGER IPR
      INTEGER IROUND
      INTEGER ISIGN
C
      INTEGER KBITS
      INTEGER KEXP
      INTEGER KMANT
      INTEGER KROUND
C
      REAL PVAL
C
      REAL ZEPS
      REAL ZREF
      REAL ZVAL
C
C     Debug print switch.
C
      IF (KROUND.GE.10)
     C   THEN
             IPR    = 1
             IROUND = KROUND - 10
         ELSE
             IPR    = 0
             IROUND = KROUND
        ENDIF
C
C     Check conversion type parameter.
C
      IF (IROUND.NE.0.AND.IROUND.NE.1)
     C   THEN
             WRITE (*,9004) KROUND
             CALL ABORTX ('CONFP3')
         ENDIF
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Convert value of 0.0.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
      IF (PVAL.EQ.0.0)
     C   THEN
             KEXP  = 0
             KMANT = 0
             IEXP  = 0
             ISIGN = 0
             GO TO 900
         ENDIF
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 . Convert other values.
C     -----------------------------------------------------------------
C
  200 CONTINUE
C
      ZEPS = 1.0E-12
      IF (KBITS.EQ.32) ZEPS = 1.0E-8
      ZREF = PVAL
C
C     Sign of value.
C
      ISIGN = 0
      IF (ZREF.LT.0.)
     C   THEN
             ISIGN = 128
             ZREF  = - ZREF
         ENDIF
C
C     Exponent.
C
      IEXP = INT(ALOG(ZREF)*(1.0/ALOG(16.0))+64.0+1.0+ZEPS)
C
      IF (IEXP.LT.0  ) IEXP = 0
      IF (IEXP.GT.127) IEXP = 127
C
C     Mantissa.
C
      IF (IROUND.EQ.0)
     C   THEN
C
C            Closest number in GRIB format less than original number.
C
             IF (ISIGN.EQ.0)
     C          THEN
C
C                   Truncate for positive numbers.
C
                    KMANT = INT (ZREF/16.0**(IEXP-70))
                ELSE
C
C                   Round up for negative numbers.
C
                    KMANT = NINT (ZREF/16.0**(IEXP-70)+0.5)
                ENDIF
         ELSE
C
C            Closest number in GRIB format to the original number
C            (equal to, greater than or less than original number).
C
             KMANT = NINT (ZREF/16.0**(IEXP-70))
         ENDIF
C
C     Check that mantissa value does not exceed 24 bits.
C     16777215 = 2**24 - 1
C
      IF (KMANT.GT.16777215)
     C   THEN
             IEXP = IEXP + 1
             IF (IROUND.EQ.0)
     C          THEN
C
C                   Closest number in GRIB format less than original
C                   number.
C
                     IF (ISIGN.EQ.0)
     C                 THEN
C
C                          Truncate for positive numbers.
C
                           KMANT = INT (ZREF/16.0**(IEXP-70))
                       ELSE
C
C                          Round up for negative numbers.
C
                           KMANT = NINT (ZREF/16.0**(IEXP-70)+0.5)
                       ENDIF
                ELSE
C
C                   Closest number in GRIB format to the original number
C                   (equal to, greater or less than original number).
C
                    KMANT = NINT (ZREF/16.0**(IEXP-70))
                ENDIF
C
                IF (KMANT.GT.16777215)
     C             THEN
                       WRITE (*,9001)
                       WRITE (*,9002) PVAL
                       WRITE (*,9003) ISIGN , IEXP , KMANT
                       CALL ABORTX ('CONFP3')
                   ELSE
                       WRITE (*,9005)
                   ENDIF
         ENDIF
C
C     Add sign bit to exponent.
C
      KEXP = IEXP + ISIGN
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9. Format statements. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
C     Print generated values if required.
C
      IF (IPR.EQ.1)
     C   THEN
             WRITE (*,9006) KROUND
             WRITE (*,9002) PVAL
             CALL DECFP2 (ZVAL,KEXP,KMANT)
             WRITE (*,9007) ZVAL
             WRITE (*,9003) ISIGN , IEXP , KMANT
         ENDIF
C
      RETURN
C
 9001 FORMAT (1H ,'CONFP3 : Mantissa overflow fatal error.')
C
 9002 FORMAT (1H ,'CONFP3 : Original number = ',F30.20)
C
 9003 FORMAT (1H ,'CONFP3 : Sign = ',I3,', Exponent = ',I3,
     C            ', Mantissa = ',I12)
C
 9004 FORMAT (1H ,'CONFP3 : Invalid conversion type parameter = ',
     C             I4)
C
 9005 FORMAT (1H ,'CONFP3 : Mantissa overflow recoverable error.')
C
 9006 FORMAT (1H ,'CONFP3 : Conversion type parameter = ',I4)
C
 9007 FORMAT (1H ,'CONFP3 : Converted to      ',F30.20)
C
      END
      SUBROUTINE MAXMN2 (PARRAY,KLEN,PMISS,PMAX,PMIN)
C
C**** MAXMN2 - Get max/minimum values, ignoring missing data value.
C
C     Purpose.
C     --------
C
C           Get maximum and minimum values from an array of
C           floating point numbers, ignoring missing data value.
C
C**   Interface.
C     ----------
C
C           CALL MAXMN2 (PARRAY,KLEN,PMISS,PMAX,PMIN)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               PARRAY     - Array of numbers.
C
C               KLEN       - Last word of this array.
C
C               PMISS      - Value indicating missing data in array
C                            element.
C
C               Output Parameters.
C               ------------------
C
C               PMAX       - Maximum value.
C               PMIN       - Minimum value.
C
C     Method.
C     -------
C
C           Intrinsic functions MAX and MIN are used.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           None.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      18:06:91
C
C     Modifications.
C     --------------
C
C           None.
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
      IMPLICIT NONE
C
      INTEGER J110
      INTEGER J130
C
      INTEGER KLEN
C
      REAL PARRAY
      REAL PMAX
      REAL PMIN
      REAL PMISS
C
      DIMENSION PARRAY(*)
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Get maximum and minimum values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
C     Set initial values to first data value which is not
C     a missing data indicator.
C
      DO 110 J110 = 1 , KLEN
          IF (PARRAY(J110).NE.PMISS)
     C       THEN
                 PMAX = PARRAY(J110)
                 PMIN = PARRAY(J110)
                 GO TO 120
             ENDIF
  110 CONTINUE
C
  120 CONTINUE
C
C     Extract maximum and minimum values.
C
      DO 130 J130 = 1 , KLEN
          IF (PARRAY(J130).NE.PMISS)
     C       THEN
                 PMAX = MAX (PMAX,PARRAY(J130))
                 PMIN = MIN (PMIN,PARRAY(J130))
             ENDIF
  130 CONTINUE
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9. Return to calling routine.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
      RETURN
C
      END
      SUBROUTINE GRCHK4 (KSEC1,KSEC4,PSEC4,KRET)
C
C**** GRCHK4 - Check parameters for Section 4 of GRIB Code.
C
C     Purpose.
C     --------
C
C           Check parameters for Section 4 of GRIB code against
C           valid values for GRIB Edition 1.
C
C**   Interface.
C     ----------
C
C           CALL GRCHK4 (KSEC1,KSEC4,PSEC4,KRET)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KSEC1      - Array containing integer parameters for
C                            section 1 of GRIB code.
C
C               KSEC4      - Array containing integer parameters for
C                            section 4 of GRIB code.
C
C               PSEC4      - Array containing real parameters for
C                            section 4 of GRIB code.
C
C               Output Parameters.
C               ------------------
C
C               KRET       - Return code.
C                            0   , No error encountered.
C                            1   , Error in GRIB Code parameter.
C
C     Method.
C     -------
C
C           Values checked against current code/flag tables
C           and against maximum or minimum permitted values.
C           They are also checked against the current status
C           of the implementation of GRIBEX.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes for GRIB Code.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 2 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      18.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      01.10.91
C           Additional parameters KSEC1 and PSEC4 added.
C
C           J. Hennessy      ECMWF      17.07.92
C           Additional flag and matrix of values checks added.
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER KRET
      INTEGER KSEC1
      INTEGER KSEC4
C
      REAL    PSEC4
C
      DIMENSION KSEC1(*)
      DIMENSION KSEC4(*)
C
      DIMENSION PSEC4(*)
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set initial values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
C     Reset return code.
C
      KRET = 0
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 . Check values against code tables and extreme values.
C     ----------------------------------------------------------------
C
  200 CONTINUE
C
C*    Check number of values to be encoded.
C
      IF (KSEC4(1).EQ.0)
     C   THEN
             KRET = 1
             WRITE (*,9001)
         ENDIF
C
C*    Check number of bits per data value.
C
      IF (KSEC4(2).LT.1.OR.KSEC4(2).GT.32)
     C   THEN
             KRET = 1
             WRITE (*,9002) KSEC4(2)
         ENDIF
C
C*    Check on type of data (grid or spherical harmonics).
C
      IF (KSEC4(3).NE.0.AND.KSEC4(3).NE.128)
     C   THEN
             WRITE (*,9003) KSEC4(3)
         ENDIF
C
C*    Check type of packing.
C
      IF (KSEC4(4).NE.0)
     C   THEN
             IF (KSEC4(4).EQ.64)
     C          THEN
                    KRET = 1
                    WRITE (*,9004)
                ELSE
                    KRET = 1
                    WRITE (*,9005) KSEC4(4)
                ENDIF
         ENDIF
C
C*    Check data representation.
C
      IF (KSEC4(5).NE.0.AND.KSEC4(5).NE.32)
     C   THEN
             KRET = 1
             WRITE (*,9006) KSEC4(5)
         ENDIF
C
C*    Check additional flag field.
C
      IF (KSEC4(6).NE.0.AND.KSEC4(6).NE.16)
     C   THEN
             KRET = 1
             WRITE (*,9007) KSEC4(6)
         ENDIF
C
C*    Check reserved field.
C
      IF (KSEC4(7).NE.0)
     C   THEN
             WRITE (*,9008)
         ENDIF
C
C*    Check number of values indicator.
C
      IF (KSEC4(8).NE.0.AND.KSEC4(8).NE.64)
     C   THEN
             KRET = 1
             WRITE (*,9009) KSEC4(8)
         ENDIF
C
C*    Check secondary bit maps indicator.
C
      IF (KSEC4(9).NE.0.AND.KSEC4(9).NE.32)
     C   THEN
             KRET = 1
             WRITE (*,9010) KSEC4(9)
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine. Format statements.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
 9001 FORMAT (1H ,'GRCHK4 : Number of data values to be encoded is 0.')
 9002 FORMAT (1H ,'GRCHK4 : Invalid number of bits for packed data',
     C            ' values - ',I3)
 9003 FORMAT (1H ,'GRCHK4 : Invalid type of data - ',I3)
 9004 FORMAT (1H ,'GRCHK4 : Only simple packing supported.')
 9005 FORMAT (1H ,'GRCHK4 : Invalid type of packing - ',I3)
 9006 FORMAT (1H ,'GRCHK4 : Invalid data representation - ',I3)
 9007 FORMAT (1H ,'GRCHK4 : Invalid additional flag field - ',I3)
 9008 FORMAT (1H ,'GRCHK4 : Reserved field not 0. May cause trouble',
     C                      ' in future releases of GRIBEX.')
 9009 FORMAT (1H ,'GRCHK4 : Invalid number of fields indicator - ',I3)
 9010 FORMAT (1H ,'GRCHK4 : Invalid secondary bit map indicator - ',I3)
C
      RETURN
C
      END
      SUBROUTINE GRSDBG (KDBG)
C
C**** GRSDBG - Debug print switch setting for routine GRIBEX.
C
C     Purpose.
C     --------
C
C           Switch debug printout on or off for routine GRIBEX.
C
C**   Interface.
C     ----------
C
C           CALL GRSDBG (KDBG)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KDGB        - Debug print switch.
C                            0 , No printout.
C                            Non-zero , Debug printout.
C
C               Output Parameters.
C               ------------------
C
C               None.
C
C     Method.
C     -------
C
C           The variable NDBG is set in the common area. All other
C           parameters are also set to default values, if they have
C           not already been set by the user.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           See subroutine GRIBEX.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      25.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      25.06.91
C           Changes to some comments only.
C
C           J. Hennessy      ECMWF      14.11.91
C           Common areas changed.
C
C           J. Hennessy      ECMWF      07.01.92
C           Input parameter returned unchanged.
C
C     ----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER IDBG
C
      INTEGER KDBG
C
      INTEGER NDBG
      INTEGER NFREF
      INTEGER NRND
      INTEGER NUSER
      INTEGER NVCK
C
      REAL    FREF
C
      COMMON /GRBCOM/FREF,NFREF,NRND,NDBG,NVCK,NUSER
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
      IDBG = 0
      IF (KDBG.NE.0) IDBG = 1
C
      IF (NUSER.NE.11041967)
     C   THEN
C
C            Common area variables have not been set, so set NDBG to
C            user supplied value and the others to default values.
C
C            User supplied reference value.
C
             FREF   = 0.0
C
C            Reference value supplied by user flag. Set to off.
C
             NFREF  = 0
C
C            Set rounding to 120 bytes on.
C
             NRND   = 1
C
C            Set debug print to required value.
C
             NDBG   = IDBG
C
C            Set GRIB value checking on.
C
             NVCK   = 1
C
C            Mark common area values set by user.
C
             NUSER  = 11041967
         ELSE
C
C            Common area variables already set, so set only NDBG.
C
C            Set debug print to required value.
C
             NDBG   = IDBG
C
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
      RETURN
C
      END
      SUBROUTINE GRSVCK (KVCK)
C
C**** GRSVCK - Set GRIB code parameter value check for routine GRIBEX.
C
C     Purpose.
C     --------
C
C           Switch parameter value checking on/off for routine GRIBEX.
C
C**   Interface.
C     ----------
C
C           CALL GRSVCK (KVCK)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KVCK        - Value checking switch.
C                            0 , No checking.
C                            Non-zero , Values checked.
C
C               Output Parameters.
C               ------------------
C
C               None.
C
C     Method.
C     -------
C
C           The variable NVCK is set in the common area. All other
C           parameters are also set to default values, if they have
C           not already been set by the user.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           See subroutine GRIBEX.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      25.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      28.08.91
C           Changes to some comments only.
C
C           J. Hennessy      ECMWF      14.11.91
C           Chnages to common area.
C
C           J. Hennessy      ECMWF      30.01.92
C           Input parameter returned unchanged.
C
C     ----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER IVCK
C
      INTEGER KVCK
C
      INTEGER NDBG
      INTEGER NFREF
      INTEGER NRND
      INTEGER NUSER
      INTEGER NVCK
C
      REAL    FREF
C
      COMMON /GRBCOM/FREF,NFREF,NRND,NDBG,NVCK,NUSER
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
      IVCK = 0
      IF (KVCK.NE.0) IVCK = 1
C
      IF (NUSER.NE.11041967)
     C   THEN
C
C            Common area variables have not been set, so set NVCK to
C            user supplied value and the others to default values.
C
C            User supplied reference value.
C
             FREF   = 0.0
C
C            Reference value supplied by user flag. Set to off.
C
             NFREF  = 0
C
C            Set rounding to 120 bytes on.
C
             NRND   = 1
C
C            Set debug print off.
C
             NDBG   = 0
C
C            Set GRIB value checking to required value.
C
             NVCK   = IVCK
C
C            Mark common area values set by user.
C
             NUSER  = 11041967
         ELSE
C
C            Common area variables already set, so set only NVCK.
C
C            Set GRIB value checking to required value.
C
             NVCK   = IVCK
C
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
      RETURN
C
      END
      SUBROUTINE GRSRND (KRND)
C
C**** GRSRND - Set GRIB code rounding/no rounding for routine GRIBEX.
C
C     Purpose.
C     --------
C
C           Switch GRIB length rounding on/off for routine GRIBEX.
C
C**   Interface.
C     ----------
C
C           CALL GRSRND (KRND)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KRND        - Value checking switch.
C                            0 , No rounding.
C                            Non-zero , Values rounded.
C
C               Output Parameters.
C               ------------------
C
C               None.
C
C     Method.
C     -------
C
C           The variable NRND is set in the common area. All other
C           parameters are also set to default values, if they have
C           not already been set by the user.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           See subroutine GRIBEX.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      25.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      28.08.91
C           Changes to some comments only.
C
C           J. Hennessy      ECMWF      14.11.91
C           Changes to common area.
C
C           J. Hennessy      ECMWF      07.01.92
C           Input parameter returned unchanged.
C
C     ----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER IRND
C
      INTEGER KRND
C
      INTEGER NDBG
      INTEGER NFREF
      INTEGER NRND
      INTEGER NUSER
      INTEGER NVCK
C
      REAL    FREF
C
      COMMON /GRBCOM/FREF,NFREF,NRND,NDBG,NVCK,NUSER
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
      IRND = 0
      IF (KRND.NE.0) IRND = 1
C
      IF (NUSER.NE.11041967)
     C   THEN
C
C            Common area variables have not been set, so set NRND to
C            user supplied value and the others to default values.
C
C            User supplied reference value.
C
             FREF   = 0.0
C
C            Reference value supplied by user flag. Set to off.
C
             NFREF  = 0
C
C            Set rounding to 120 bytes to required value.
C
             NRND   = IRND
C
C            Set debug print off.
C
             NDBG   = 0
C
C            Set GRIB value checking on.
C
             NVCK   = 1
C
C            Mark common area values set by user.
C
             NUSER  = 11041967
         ELSE
C
C            Common area variables already set, so set only NRND.
C
C            Set rounding to 120 bytes to required value.
C
             NRND   = IRND
C
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
      RETURN
C
      END
      SUBROUTINE GRSREF (PREF)
C
C**** GRSREF - Set user defined reference value for routine GRIBEX.
C
C     Purpose.
C     --------
C
C           Set user defined reference value for GRIB code for
C           routine GRIBEX.
C
C**   Interface.
C     ----------
C
C           CALL GRSREF (PREF)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               PREF        - Reference value required.
C
C               Output Parameters.
C               ------------------
C
C               None.
C
C     Method.
C     -------
C
C           The flag variable NFREF is set to indicate that the
C           user has supplied a reference value and the variable
C           FREF is set to the required reference value. These
C           variables are in the common area. All other parameters
C           are also set to default values, if they have not already
C           been set by the user.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           See subroutine GRIBEX.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      25.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      28.08.91
C           Changes to some comments only.
C
C           J. Hennessy      ECMWF      14.11.91
C           Changes to common area.
C
C     ----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER NDBG
      INTEGER NFREF
      INTEGER NRND
      INTEGER NUSER
      INTEGER NVCK
C
      REAL    FREF
C
      REAL    PREF
C
      COMMON /GRBCOM/FREF,NFREF,NRND,NDBG,NVCK,NUSER
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
      IF (NUSER.NE.11041967)
     C   THEN
C
C            Common area variables have not been set, so set FREF to
C            user supplied value and the others to default values.
C
C            Set user supplied reference value.
C
             FREF   = PREF
C
C            Reference value supplied by user flag. Set to on.
C
             NFREF  = 1
C
C            Set rounding to 120 bytes on.
C
             NRND   = 1
C
C            Set debug print off.
C
             NDBG   = 0
C
C            Set GRIB value checking on.
C
             NVCK   = 1
C
C            Mark common area values set by user.
C
             NUSER  = 11041967
         ELSE
C
C            Common area variables already set, so only set FREF
C            and flag NFREF.
C
             FREF   = PREF
C
C            Reference value supplied by user flag. Set to on.
C
             NFREF  = 1
C
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
      RETURN
C
      END
      SUBROUTINE GRPRS3 (KSEC0,KSEC3,PSEC3)
C
C**** GRPRS3 - Print information from Section 3 of GRIB code.
C
C     Purpose.
C     --------
C
C           Print the information in the Bit-map section
C           Section (Section 3) of decoded GRIB data.
C
C**   Interface.
C     ----------
C
C           CALL GRPRS3 (KSEC0,KSEC3,PSEC3)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KSEC0 - Array of decoded integers from Section 0.
C
C               KSEC3 - Array of decoded integers from Section 3.
C
C               PSEC3 - Array of decoded reals from Section 3.
C
C               Output Parameters.
C               ------------------
C
C               None.
C
C     Method.
C     -------
C
C           Fields printed as integers or reals.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes re GRIB Code.
C           See also routine GRIBEX.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy    ECMWF 11.09.91
C
C     Modifications.
C     --------------
C
C           None.
C
C     -----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER KSEC0
      INTEGER KSEC3
C
      REAL PSEC3
C
      DIMENSION KSEC0(*)
      DIMENSION KSEC3(*)
C
      DIMENSION PSEC3(*)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Print required information.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
      WRITE (*,9000)
      WRITE (*,9001)
      WRITE (*,9002)
C
      IF (KSEC3(1).NE.0)
     C   THEN
             WRITE (*,9003) KSEC3(1)
         ELSE
             WRITE (*,9004)
         ENDIF
      WRITE (*,9005) KSEC3(2)
C
      WRITE (*,9006) PSEC3(2)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C*    Section 9 . Format statements. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
 9000 FORMAT (1H )
 9001 FORMAT (1H ,'Section 3 - Bit-map Section.')
 9002 FORMAT (1H ,'-------------------------------------')
 9003 FORMAT (1H ,'Predetermined bit-map number.                ',I9)
 9004 FORMAT (1H ,'No predetermined bit-map.')
 9005 FORMAT (1H ,'Missing data value for integer data.         ',I9)
 9006 FORMAT (1H ,'Missing data value for real data.        ',F20.6)
C
      RETURN
C
      END
      SUBROUTINE GRPRS4 (KSEC0,KSEC4,PSEC4)
C
C**** GRPRS4 - Print information from Section 4 of GRIB code.
C
C     Purpose.
C     --------
C
C           Print the information in the Binary data section
C           Section (Section 4) of decoded GRIB data.
C
C**   Interface.
C     ----------
C
C           CALL GRPRS4 (KSEC0,KSEC4,PSEC4)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KSEC0 - Array of decoded integers from Section 0.
C
C               KSEC4 - Array of decoded integers from Section 4.
C
C               PSEC4 - Array of decoded reals from Section 4.
C
C               Output Parameters.
C               ------------------
C
C               None.
C
C     Method.
C     -------
C
C           Fields printed as integers or reals.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes re GRIB Code.
C           See also routine GRIBEX.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy    ECMWF 11.09.91
C
C     Modifications.
C     --------------
C
C
C           J. Hennessy    ECMWF 21.07.92
C
C     -----------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER INUM
C
      INTEGER J210
C
      INTEGER KSEC0
      INTEGER KSEC4
C
      REAL PSEC4
C
      DIMENSION KSEC0(*)
      DIMENSION KSEC4(*)
C
      DIMENSION PSEC4(*)
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Print integer information from KSEC4.
C     -----------------------------------------------------------------
C
  100 CONTINUE
C
      WRITE (*,9000)
      WRITE (*,9001)
      WRITE (*,9002)
C
      WRITE (*,9003) KSEC4(1)
      WRITE (*,9004) KSEC4(2)
      WRITE (*,9005) KSEC4(3)
      WRITE (*,9006) KSEC4(4)
      WRITE (*,9007) KSEC4(5)
      WRITE (*,9008) KSEC4(6)
      WRITE (*,9009) KSEC4(7)
      WRITE (*,9010) KSEC4(8)
      WRITE (*,9011) KSEC4(9)
      WRITE (*,9012) KSEC4(10)
      WRITE (*,9013) KSEC4(11)
C
C     Information on matrix of values , if present.
C
      IF (KSEC4(8).EQ.64)
     C   THEN
             WRITE (*,9020) KSEC4(50)
             WRITE (*,9021) KSEC4(51)
             WRITE (*,9022) KSEC4(52)
             WRITE (*,9023)
             WRITE (*,9024) KSEC4(53)
             WRITE (*,9025) KSEC4(54)
             WRITE (*,9023)
             WRITE (*,9026) KSEC4(55)
             WRITE (*,9027) KSEC4(56)
             WRITE (*,9028) KSEC4(57)
         ENDIF
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C
C*    Section 2. Print real values from PSEC4.
C     -----------------------------------------------------------------
C
  200 CONTINUE
C
      WRITE (*,9000)
C
      INUM = KSEC4(1)
      IF (INUM.LT.0)  INUM = - INUM
      IF (INUM.GT.20) INUM = 20
C
C     Print first INUM values.
C
      WRITE (*,9031) INUM
      DO 210 J210=1,INUM
         WRITE (*,9032) PSEC4(J210)
  210 CONTINUE
C
C     -----------------------------------------------------------------
C
C
C
C
C
C
C
C*    Section 9 . Format statements. Return to calling routine.
C     -----------------------------------------------------------------
C
  900 CONTINUE
C
 9000 FORMAT (1H )
 9001 FORMAT (1H ,'Section 4 - Binary Data  Section.')
 9002 FORMAT (1H ,'-------------------------------------')
 9003 FORMAT (1H ,'Number of data values coded/decoded.         ',I9)
 9004 FORMAT (1H ,'Number of bits per data value.               ',I9)
 9005 FORMAT (1H ,'Type of data indicator.                      ',I9)
 9006 FORMAT (1H ,'Type of packing indicator.                   ',I9)
 9007 FORMAT (1H ,'Type of data representation.                 ',I9)
 9008 FORMAT (1H ,'Additional flags indicator.                  ',I9)
 9009 FORMAT (1H ,'Reserved.                                    ',I9)
 9010 FORMAT (1H ,'Number of values indicator.                  ',I9)
 9011 FORMAT (1H ,'Secondary bit-maps indicator.                ',I9)
 9012 FORMAT (1H ,'Values width indicator.                      ',I9)
 9013 FORMAT (1H ,'Number of bits for second order values.      ',I9)
 9020 FORMAT (1H ,'First dimension (rows) of each matrix.       ',I9)
 9021 FORMAT (1H ,'Second dimension (columns) of each matrix.   ',I9)
 9022 FORMAT (1H ,'First dimension coordinate values definition.',I9)
 9023 FORMAT (1H ,'(Code Table 12)')
 9024 FORMAT (1H ,'NC1 - Number of coefficients for 1st dimension.',I7)
 9025 FORMAT (1H ,'Second dimension coordinate values definition.',I8)
 9026 FORMAT (1H ,'NC2 - Number of coefficients for 2nd dimension.',I7)
 9027 FORMAT (1H ,'1st dimension physical signifance (Table 13). ',I8)
 9028 FORMAT (1H ,'2nd dimension physical signifance (Table 13). ',I8)
 9031 FORMAT (1H ,'First ',I4,' data values.')
 9032 FORMAT (1H ,F30.15)
C
      RETURN
C
      END
      SUBROUTINE GRCHK3 (KSEC1,KSEC3,PSEC3,KRET)
C
C**** GRCHK3 - Check parameters for Section 3 of GRIB Code.
C
C     Purpose.
C     --------
C
C           Check parameters for Section 3 of GRIB code against
C           valid values for GRIB Edition 1.
C
C**   Interface.
C     ----------
C
C           CALL GRCHK3 (KSEC1,KSEC3,PSEC3,KRET)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KSEC1      - Array containing integer parameters for
C                            section 1 of GRIB code.
C
C               KSEC3      - Array containing integer parameters for
C                            section 3 of GRIB code.
C
C               PSEC3      - Array containing real parameters for
C                            section 3 of GRIB code.
C
C               Output Parameters.
C               ------------------
C
C               KRET       - Return code.
C                            0   , No error encountered.
C                            1   , Error in GRIB Code parameter.
C
C     Method.
C     -------
C
C           Values checked against current code/flag tables
C           and against maximum or minimum permitted values.
C           They are also checked against the current status
C           of the implementation of GRIBEX and ECMWF usage.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           WMO Manual on Codes for GRIB Code.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 5 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      16.09.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      01.10.91
C           Additional parameter KSEC1 and PSEC3 added.
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER KRET
      INTEGER KSEC1
      INTEGER KSEC3
C
      REAL    PSEC3
C
      DIMENSION KSEC1(*)
      DIMENSION KSEC3(*)
C
      DIMENSION PSEC3(*)
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set initial values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
C     Reset return code.
C
      KRET = 0
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 . Check values.
C     ----------------------------------------------------------------
C
  200 CONTINUE
C
C*    Check bit-map table reference field.
C
      IF (KSEC3(1).LT.0.OR.KSEC3(1).GT.65535)
     C   THEN
             KRET = 1
             WRITE (*,9001) KSEC3(1)
         ENDIF
C
C*    ECMWF usage is to include the bit-map.
C
      IF (KSEC3(1).NE.0.AND.KSEC1(2).EQ.98)
     C   THEN
             KRET = 1
             WRITE (*,9002)
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine. Format statements.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
 9001 FORMAT (1H ,'GRCHK3 : Invalid bit-map table reference - ',I9)
C
 9002 FORMAT (1H ,'GRCHK3 : ECMWF usage is to include bit-map.')
C
      RETURN
C
      END
      SUBROUTINE ROWINA (P,KO,KI,PW,KCODE)
C
C**** ROWINA - Interpolation of row of values.
C
C     Purpose.
C     --------
C
C           Interpolate a row of values.
C
C**   Interface.
C     ----------
C
C           CALL ROWINA (P,KO,KI,PW,KCODE)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               P     - Row of values to be interpolated.
C                       Dimension must be at least KO.
C
C               KO    - Number of values required.
C
C               KI    - Number of values in P on input.
C
C               PW    - Working array.
C                       Dimension must be at least (0:KO+2,3).
C
C               KCODE - Interpolation required.
C                       1 , linear.
C                       3 , cubic.
C
C               Output Parameters.
C               ------------------
C
C               P     - Now contains KO values.
C
C     Method.
C     -------
C
C           Linear or cubic interpolation performed as required.
C
C     Externals.
C     ----------
C
C           SCM0
C
C     Reference.
C     ----------
C
C           None.
C
C     Comments.
C     ---------
C
C           This is a version of ROWINT which conforms to Ansi
C           standards, achieved by passing the work array as a
C           parameter and changing lower case letters to upper case.
C
C     Author.
C     -------
C
C           J. Hennessy     ECMWF     09.10.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy     ECMWF     07.01.92
C           Call to ABORT changed to ABORTX.
C
C     -----------------------------------------------------------------
C
      DIMENSION P(KO),PW(0:KO+2,3)
C
      IF(KCODE.EQ.1) THEN
         DO 102 JL=1,KI
            PW(JL,1)=P(JL)
  102    CONTINUE
         PW(KI+1,1)=P(1)
         ZRDI=FLOAT(KI)
         ZDO=1./FLOAT(KO)
C
         DO 105 JL=1,KO
            ZPOS=(JL-1)*ZDO
            ZWT=ZPOS*ZRDI
            IP=ZWT
            ZWT=ZWT-IP
            P(JL)=(1.-ZWT)*PW(IP+1,1)+ZWT*PW(IP+2,1)
  105    CONTINUE
C
      ELSEIF(KCODE.EQ.3) THEN
         DO 302 JL=1,KI
            PW(JL,1)=P(JL)
  302    CONTINUE
         PW(0,1)=P(KI)
         PW(KI+1,1)=P(1)
         PW(KI+2,1)=P(2)
         DO 305 JL=1,KI
            PW(JL,2)= - PW(JL-1,1)/3. - 0.5*PW(JL,1)
     1             + PW(JL+1,1)    - PW(JL+2,1)/6.
            PW(JL+1,3)=   PW(JL-1,1)/6. - PW(JL,1)
     1             + 0.5*PW(JL+1,1) + PW(JL+2,1)/3.
  305    CONTINUE
         CALL SCM0(PW(1,2),PW(2,3),PW(1,1),PW(2,1),KI)
         ZRDI=FLOAT(KI)
         ZDO=1./FLOAT(KO)
         DO 310 JL=1,KO
            ZPOS=(JL-1)*ZDO
            ZWT=ZPOS*ZRDI
            IP=ZWT+1
            ZWT=ZWT+1.-IP
            ZWT1 = 1. - ZWT
            P(JL)=((3.-2.*ZWT1)*PW(IP,1) + ZWT*PW(IP,2))*ZWT1*ZWT1
     1       + ((3.-2.*ZWT) *PW(IP+1,1) - ZWT1*PW(IP+1,3))*ZWT*ZWT
  310    CONTINUE
      ELSE
         WRITE (*,9001) KCODE
         CALL ABORTX ('ROWINA')
      ENDIF
C
      RETURN
C
 9001 FORMAT (1H ,'ROWINA : Invalid interpolation code = ',I4)
C
      END
      SUBROUTINE INSMP1 (KGRIB,KLENG,KMAP1,KSECM,PSEC4,KSIZE,KBITS,
     C                     PMISS,HFUNC,KNUM,KPR,KRET)
C
C**** INSMP1 - Insertion of primary bit map for routine GRIBEX.
C
C     Purpose.
C     --------
C
C           Generates a primary bit-map (Section 3 bit-map) and
C           inserts in array of GRIB coded data.
C
C**   Interface.
C     ----------
C
C           CALL INSMP1 (KGRIB,KLENG,KMAP1,KSECM,PSEC4,KSIZE,KBITS,
C    C                     PMISS,HFUNC,KNUM,KPR,KRET)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KGRIB      - Array into which data is being packed
C                            in GRIB code.
C
C               KLENG      - Length of this array.
C
C               KMAP1      - Bit-pointer to start of primary bit-map
C                            (Section 3 bitmap) in array KGRIB.
C
C               KSECM      - Indicator of use of secondary bitmap
C                            (Section 4 bitmap) in array KGRIB.
C                            0 , No secondary bit-map.
C                            32, Secondary bit-map to be added later.
C
C               PSEC4      - Array of data values to be packed in
C                            GRIB code, containing missing data
C                            indicator PMISS where appropriate.
C
C               KSIZE      - Number of values, including missing data
C                            values, in array PSEC4.
C
C               KBITS      - Number of bits in computer word.
C
C               PMISS      - Value indicating missing data in array
C                            PSEC4.
C
C               HFUNC      - 'C' , GRIB data being packed normally.
C                            'M' , GRIB data being packed in fixed
C                                  length messages.
C
C               KNUM       - Number of values at each grid point.
C
C               KPR        - Debug print switch.
C                            0 , No printout.
C                            1 , Debug printout.
C
C               Output Parameters.
C               ------------------
C
C               PSEC4      - Array of data values to be packed in
C                            GRIB code. Changes to contents depend
C                            on function performed eg
C
C                            Rn = Real data value at point n.
C                            M  = Missing data indicator.
C                            On input PSEC4 is R1 R2 M M  M R6
C
C                            On output with function 'C' , single value
C                            at a point.
C                            Bit-map is 1  1  0  0  0  1
C                            PSEC4 is   R1 R2 R6 M  M  M
C                                             ^
C                                             |
C                                           KSIZE
C
C                            On output with function 'C' , matrix
C                            (2x1) of values at a point.
C                            Bit-map is 1  0  1
C                            PSEC4 is   R1 R2 M  R6 M  M  M
C                                                ^
C                                                |
C                                              KSIZE
C
C                            On output with function 'M' with no
C                            secondary bit-maps, single value.
C                            Bit-map is 1  1  0  0  0  1
C                            PSEC4 is   R1 R2 R6 R1 R1 R1
C                                                      ^
C                                                      |
C                                                    KSIZE
C
C                            On output with function 'M' with
C                            secondary bit-maps (2x1 matrix)
C                            Bit-map is 1  1  1
C                            PSEC4 is   R1 R2 M  M  M  R6
C                                                      ^
C                                                      |
C                                                    KSIZE
C
C               KSIZE      - The number of data values remaining in
C                            array PSEC4 to be packed.
C
C               KRET       - Return code.
C                            0 , No error encountered.
C                            1 , Error in routine INXBIT.
C                            2 , Bit-map size exceeds maximum.
C                            3 , Invalid function requested.
C
C     Method.
C     -------
C
C           The bit-map contains 1 where valid data exists and 0
C           where data is missing. The corresponding data array
C           contains valid data and the missing data indicator value.
C
C     Externals.
C     ----------
C
C           INXBIT
C
C     Reference.
C     ----------
C
C           See routine GRIBEX.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 3 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      09:07:92
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      19:10:92
C           Maximum sizes increased to allow for packing
C           of 2D spectra.
C           Number of data values 120*61*12*25
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ------------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      CHARACTER*(*) HFUNC
C
      INTEGER IMAP1
      INTEGER IMISS
      INTEGER INEXT
      INTEGER INOBT
      INTEGER IPT
C
      INTEGER JPMAP1
C
      INTEGER J310
      INTEGER J320
      INTEGER J330
      INTEGER J340
      INTEGER J350
      INTEGER J360
      INTEGER J370
C
      INTEGER KBITS
      INTEGER KGRIB
      INTEGER KLENG
      INTEGER KMAP1
      INTEGER KSECM
      INTEGER KNUM
      INTEGER KPR
      INTEGER KRET
      INTEGER KSIZE
C
      REAL PMISS
      REAL PSEC4
C
      REAL ZSEC4
C
C*    Maximum size of primary bit-map which can be handled.
C
      PARAMETER (JPMAP1=41472)
C-- for 2d spectra      PARAMETER (JPMAP1=2200000)
C
      DIMENSION IMAP1(JPMAP1)
C
      DIMENSION PSEC4(*)
      DIMENSION ZSEC4(JPMAP1)
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set initial values.
C     ------------------------------------------------------------------
C
  100 CONTINUE
C
      IF (KPR.EQ.1)
     C   THEN
             WRITE (*,*) 'INSMP1 : Section 1.'
             WRITE (*,*) '         Input values used -'
             WRITE (*,9004) HFUNC
             WRITE (*,9005) KSIZE
             WRITE (*,9006) KSECM
             WRITE (*,9007) KNUM
         ENDIF
C
C     Reset return code to 0.
C
      KRET  = 0
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 .  Check input parameters.
C     ------------------------------------------------------------------
C
  200 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'INSMP1 : Section 2.'
C
C*    Check that bit-map size does not exceed maximum permitted.
C
      IF (JPMAP1.LT.KSIZE)
     C   THEN
             WRITE (*,9001) KSIZE , JPMAP1
             KRET = 2
             GO TO 900
         ENDIF
C
C*    Check function requested.
C
      IF (HFUNC.NE.'C'.AND.HFUNC.NE.'M')
     C   THEN
             WRITE (*,9002) HFUNC
             KRET = 3
             GO TO 900
         ENDIF
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 3 . Generation of bit-map.
C    -------------------------------------------------------------------
C
  300 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'INSMP1 : Section 3.'
C
C*    Set number of bits in bitmap.
C
      INOBT = KSIZE / KNUM
C
C*    If fixed length records with secondary bit-maps are required
C     insert a primary bit-map of all 1 bits and finish.
C
      IF (HFUNC.EQ.'M'.AND.KSECM.EQ.32)
     C   THEN
             DO 310 J310=1,INOBT
                IMAP1(J310)   = 1
  310        CONTINUE
C
             CALL INXBIT (KGRIB,KLENG,KMAP1,IMAP1,INOBT,KBITS,1,'C',
     C              KRET)
C
             IF (KRET.NE.0)
     C          THEN
                    WRITE (*,9003)
                    KRET = 1
                ENDIF
             GO TO 900
         ENDIF

C
C*    Reset bit-map to all 0 bits.
C
      DO 320 J320=1,INOBT
         IMAP1(J320)   = 0
  320 CONTINUE
C
C*    Generate bit-map in accordance with the missing data values.
C
      INEXT = 0
      IPT = 0
C
C     Set a bit to 1 for every KNUM values which contain at
C     least 1 real data value.
C
      DO 350 J350=1,KSIZE,KNUM
         IPT = IPT + 1
         IMISS = 0
C
         DO 330 J330=J350,J350+KNUM-1
            IF (PSEC4(J330).EQ.PMISS) IMISS = IMISS + 1
  330    CONTINUE
C
C        No real data value found. Bit is already 0.
C
         IF (IMISS.EQ.KNUM) GO TO 350
C
C        Copy data to temporary array and remove missing data
C        indicator in temporary array.
C
         IMAP1(IPT) = 1
C
         DO 340 J340=J350,J350+KNUM-1
            INEXT        = INEXT + 1
            ZSEC4(INEXT) = PSEC4(J340)
  340    CONTINUE
  350 CONTINUE
C
C*    Insert bit-map in GRIB coded data.
C
      CALL INXBIT (KGRIB,KLENG,KMAP1,IMAP1,INOBT,KBITS,1,'C',KRET)
C
      IF (KRET.NE.0)
     C   THEN
             WRITE (*,9003)
             KRET = 1
             GO TO 900
         ENDIF
C
C*    If missing data is indicated transfer data to original array.
C
      IF (INEXT.NE.KSIZE)
     C   THEN
             DO 360 J360=1,INEXT
                PSEC4(J360) = ZSEC4(J360)
  360        CONTINUE
C
             IF (HFUNC.EQ.'M')
     C          THEN
C
C                   Fixed length messages required, even though
C                   a bit map is used. The otherwise unused part
C                   of the array is set to a genuine data value
C                   so that extraction of minimum and maximum
C                   values remain correct. Number of data values
C                   includes these padding values.
C
                    DO 370 J370=INEXT+1,KSIZE
                       PSEC4(J370) = PSEC4(1)
  370               CONTINUE
                ELSE
C
C                   Return number of points with real values
C                   (excluding points with missing data values).
C
                    KSIZE = INEXT
                ENDIF
         ENDIF
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine. Format statements.
C     ------------------------------------------------------------------
C
  900 CONTINUE
C
      IF (KPR.EQ.1)
     C   THEN
             WRITE (*,*) 'INSMP1 : Section 9.'
             WRITE (*,*) '         Output values set -'
                 WRITE (*,9005) KSIZE
         ENDIF
C
 9001 FORMAT (1H ,'INSMP1 : Primary bit-map size is ',I10,
     C            ' , maximum allowed is ',I10,'.')
C
 9002 FORMAT (1H ,'INSMP1 : Invalid function requested - ',A1)
C
 9003 FORMAT (1H ,'INSMP1 : Error reported by routine INXBIT.')
C
 9004 FORMAT (1H ,'         HFUNC  = ',A1)
C
 9005 FORMAT (1H ,'         KSIZE  = ',I10)
C
 9006 FORMAT (1H ,'         KSECM  = ',I10)
C
 9007 FORMAT (1H ,'         KNUM   = ',I10)
C
      RETURN
C
      END
      SUBROUTINE EXTMAP (KGRIB,KLENG,KMAP1,KMAP2,PSEC4,KSIZE,KBITS,
     C                     KSBMAP,PMISS,KNUM,KPR,KRET)
C
C**** EXTMAP - Extraction of bit maps for routine GRIBEX.
C
C     Purpose.
C     --------
C
C           Extracts bit-maps (primary and secondary,if present)
C           from an array of GRIB coded data and inserts the
C           missing data value indicator in appropriate places in
C           the array of already unpacked data values.
C
C**   Interface.
C     ----------
C
C           CALL EXTMAP (KGRIB,KLENG,KMAP1,KMAP2,PSEC4,KSIZE,KBITS,
C    C                     KSBMAP,PMISS,KNUM,KPR,KRET)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KGRIB      - Array from which data is being unpacked
C                            from GRIB code.
C
C               KLENG      - Length of this array.
C
C               KMAP1      - Bit-pointer to start of primary bit-map
C                            (Section 3 bitmap) in array KGRIB.
C
C               KMAP2      - Bit-pointer to start of secondary bitmap
C                            (Section 4 bitmap) in array KGRIB.
C                            Negative value if no secondary bit maps.
C
C               PSEC4      - Array of data values unpacked from GRIB
C                            code.
C
C               KSIZE      - Number of bits in the primary bit map.
C
C               KBITS      - Number of bits in computer word.
C
C               PMISS      - Value to be used to indicate missing data
C                            in array PSEC4.
C
C               KNUM       - Number of values at each grid point. This
C                            is normally 1 except when a matrix of value
C                            is represented.
C
C               KPR        - Debug print switch.
C                            0 , No printout.
C                            1 , Debug printout.
C
C               Output Parameters.
C               ------------------
C
C               KSBMAP     - Bit-map flag.
C                            -2 , All bits in the bit-map set to 1.
C                                 There is no missing data.
C                            -4 , Some points have no data. User
C                                 supplied value for missing data
C                                 indicator in appropriate places in
C                                 the array PSEC4.
C
C               KRET       - Return code.
C                            0 , No error encountered.
C                            1 , Error in routine INXBIT.
C                            2 , Bit-map size exceeds maximum.
C
C     Method.
C     -------
C
C           The bit-map contains 1 where valid data exists and 0
C           where data is missing. The corresponding data array
C           contains valid data and the missing data indicator value.
C
C     Externals.
C     ----------
C
C           INXBIT
C
C     Reference.
C     ----------
C
C           See routine GRIBEX.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 3 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      10:07:92
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      29:10:92
C           Maximum sizes increased to allow for packing of
C           2D spectra.
C           Number of data values 120*61*12*25
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ------------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER IMAP1
      INTEGER IMAP2
      INTEGER IMISS
      INTEGER INEXT
      INTEGER IOCTS
      INTEGER IPT
C
      INTEGER JPMAP1
      INTEGER JPMAP2
C
      INTEGER J310
      INTEGER J320
      INTEGER J330
      INTEGER J340
      INTEGER J350
C
      INTEGER KBITS
      INTEGER KGRIB
      INTEGER KLENG
      INTEGER KMAP1
      INTEGER KMAP2
      INTEGER KNUM
      INTEGER KPR
      INTEGER KRET
      INTEGER KSBMAP
      INTEGER KSIZE
C
      REAL PMISS
      REAL PSEC4
C
      REAL ZSEC4
C
C*    Maximum size of primary bit-map which can be handled.
C
      PARAMETER (JPMAP1=41472)
C-- for 2d spectra      PARAMETER (JPMAP1=2200000)
C
C*    Maximum size of secondary bit-map which can be handled.
C
      PARAMETER (JPMAP2=512)
C
      DIMENSION IMAP1(JPMAP1)
      DIMENSION IMAP2(JPMAP2)
C
      DIMENSION PSEC4(*)
      DIMENSION ZSEC4(JPMAP1)
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set initial values.
C     ------------------------------------------------------------------
C
  100 CONTINUE
C
      IF (KPR.EQ.1)
     C   THEN
             WRITE (*,*) 'EXTMAP : Section 1.'
             WRITE (*,*) '         Input values used -'
             WRITE (*,9004) KSIZE
             WRITE (*,9006) KNUM
         ENDIF
C
C     Reset return code to 0.
C
      KRET  = 0
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 .  Check input parameters.
C     ------------------------------------------------------------------
C
  200 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'EXTMAP : Section 2.'
C
C*    Check that primary bit-map size does not exceed maximum.
C
      IF (JPMAP1.LT.KSIZE)
     C   THEN
             WRITE (*,9000) KSIZE , JPMAP1
             KRET = 2
             GO TO 900
         ENDIF
C
C*    Check that secondary bit-map size does not exceed maximum.
C
      IF (JPMAP2.LT.KNUM)
     C   THEN
             WRITE (*,9001) KNUM , JPMAP2
             KRET = 2
             GO TO 900
         ENDIF
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 3 . Decoding of bit-map and data.
C     ------------------------------------------------------------------
C
  300 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'EXTMAP : Section 3.'
C
C*    Extract primary bit-map from GRIB coded data.
C
      CALL INXBIT (KGRIB,KLENG,KMAP1,IMAP1,KSIZE,KBITS,1,'D',KRET)
C
      IF (KRET.NE.0)
     C   THEN
             WRITE (*,9002)
             KRET = 1
             GO TO 900
         ENDIF
C
C*    Set array to receive unpacked data values to missing data
C     indicator.
C
      DO 310 J310=1,KSIZE*KNUM
         ZSEC4(J310) = PMISS
  310 CONTINUE
C
C*    If no secondary bitmaps present, set up dummy one
C     to indicate no missing data values.
C
      IF (KMAP2.LT.0)
     C   THEN
             DO 320 J320=1,KNUM
                IMAP2(J320) = 1
  320        CONTINUE
         ENDIF
C
C*    Copy data to temporary array and insert real data
C     values in temporary array, in accordance with the
C     bit map values.
C
      INEXT = 0
      IPT = 1
C
      DO 340 J340=1,KSIZE
         IF (IMAP1(J340).EQ.1)
     C      THEN
C
C               Read secondary bitmap, if any.
C
                IF (KMAP2.GT.0)
     C             THEN
                       CALL INXBIT (KGRIB,KLENG,KMAP2,IMAP2,
     C                           KNUM,KBITS,1,'D',KRET)
C
                       IF (KRET.NE.0)
     C                    THEN
                              WRITE (*,9002)
                              KRET = 1
                              GO TO 900
                          ENDIF
                   ENDIF
C
                DO 330 J330=1,KNUM
                   IF (IMAP2(J330).EQ.1)
     C                 THEN
                           INEXT      = INEXT + 1
                           ZSEC4(IPT) = PSEC4(INEXT)
                       ENDIF
                       IPT = IPT + 1
  330           CONTINUE
C
            ELSE
                IPT = IPT + KNUM
            ENDIF
C
  340 CONTINUE
C
C*    Set bit-map flag, and if missing data is indicated
C     transfer data to original array.
C
      IF (INEXT.NE.(KSIZE*KNUM))
     C   THEN
             KSBMAP = -4
             DO 350 J350=1,KSIZE
                PSEC4(J350) = ZSEC4(J350)
  350        CONTINUE
         ELSE
             KSBMAP = -2
         ENDIF
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine. Format statements.
C     ------------------------------------------------------------------
C
  900 CONTINUE
C
      IF (KPR.EQ.1)
     C   THEN
             WRITE (*,*) 'EXTMAP : Section 9.'
             WRITE (*,*) '         Output values set -'
             WRITE (*,9004) KSIZE
             WRITE (*,9005) KSBMAP
         ENDIF
C
 9000 FORMAT (1H ,'EXTMAP : Primary bit-map size is ',I10,
     C            ' , maximum allowed is ',I10,'.')
C
 9001 FORMAT (1H ,'EXTMAP : Secondary bit-map size is ',I10,
     C            ' , maximum allowed is ',I10,'.')
C
 9002 FORMAT (1H ,'EXTMAP : Error reported by routine INXBIT.')
C
 9004 FORMAT (1H ,'         KSIZE  = ',I10)
C
 9005 FORMAT (1H ,'         KSBMAP = ',I10)
C
 9006 FORMAT (1H ,'         KNUM   = ',I10)
C
      RETURN
C
      END
      SUBROUTINE INSMP2 (KGRIB,KLENG,KMAP2,PSEC4,KSIZE,KBITS,
     C                     PMISS,HFUNC,KNUM,KPR,KRET)
C
C**** INSMP2 - Insertion of secondary bit maps for routine GRIBEX.
C
C     Purpose.
C     --------
C
C           Generates secondary bit-maps (Section 4 bit-maps) and
C           inserts in array of GRIB coded data.
C
C**   Interface.
C     ----------
C
C           CALL INSMP2 (KGRIB,KLENG,KMAP2,PSEC4,KSIZE,KBITS,
C    C                     PMISS,HFUNC,KNUM,KPR,KRET)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KGRIB      - Array into which data is being packed
C                            in GRIB code.
C
C               KLENG      - Length of this array.
C
C               KMAP2      - Bit-pointer to start of secondary bit maps
C                            (Section 4 bitmaps) in array KGRIB.
C
C               PSEC4      - Array of data values to be packed in
C                            GRIB code, containing missing data
C                            indicator PMISS where appropriate.
C
C               KSIZE      - Number of values, including missing data
C                            values, in array PSEC4.
C
C               KBITS      - Number of bits in computer word.
C
C               PMISS      - Value indicating missing data in array
C                            PSEC4.
C
C               HFUNC      - 'C' , GRIB data packed normally.
C                            'M' , GRIB data being packed in fixed
C                                  length messages.
C
C               KNUM       - Number of values at each grid point.
C
C               KPR        - Debug print switch.
C                            0 , No printout.
C                            1 , Debug printout.
C
C               Output Parameters.
C               ------------------
C
C               KSIZE      - The number of data values remaining in
C                            array PSEC4 to be packed.
C
C               KRET       - Return code.
C                            0 , No error encountered.
C                            1 , Error in routine INXBIT.
C                            2 , Bit-map size exceeds maximum.
C                            3 , Invalid function requested.
C
C     Method.
C     -------
C
C           The bit-map contains 1 where valid data exists and 0
C           where data is missing. The corresponding data array
C           contains valid data and the missing data indicator value.
C
C     Externals.
C     ----------
C
C           INXBIT
C
C     Reference.
C     ----------
C
C           See routine GRIBEX.
C
C     Comments.
C     ---------
C
C           Routine contains Sections 0 to 3 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      09:07:92
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      19:10:92
C           Maximum sizes increased to allow for packing of
C           2D spectra.
C           Number of data values 120*61*12*25
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ------------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      CHARACTER*(*) HFUNC
C
      INTEGER IMAP
      INTEGER IMISS
      INTEGER INEXT
      INTEGER IPT
      INTEGER ITEMP
C
      INTEGER JPMAP2
      INTEGER JPMAP1
C
      INTEGER J310
      INTEGER J320
      INTEGER J330
      INTEGER J340
      INTEGER J350
      INTEGER J360
C
      INTEGER KBITS
      INTEGER KGRIB
      INTEGER KLENG
      INTEGER KMAP2
      INTEGER KNUM
      INTEGER KPR
      INTEGER KRET
      INTEGER KSIZE
C
      REAL PMISS
      REAL PSEC4
C
      REAL ZSEC4
C
C*    Maximum size of secondary bit-map which can be handled.
C     One secondary bit-map is generated per grid point.
C
      PARAMETER (JPMAP2=512)
C
C*    Maximum size of primary bit-map.
C
      PARAMETER (JPMAP1=41472)
C-- for 2d spectra      PARAMETER (JPMAP1=2200000)
C
      DIMENSION IMAP(JPMAP2)
C
      DIMENSION PSEC4(*)
      DIMENSION ZSEC4(JPMAP1)
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set initial values.
C     ------------------------------------------------------------------
C
  100 CONTINUE
C
      IF (KPR.EQ.1)
     C   THEN
             WRITE (*,*) 'INSMP2 : Section 1.'
             WRITE (*,*) '         Input values used -'
             WRITE (*,9004) HFUNC
             WRITE (*,9005) KSIZE
             WRITE (*,9006) KNUM
         ENDIF
C
C     Reset return code to
C
      KRET  = 0
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 .  Check input parameters.
C     ------------------------------------------------------------------
C
  200 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'INSMP2 : Section 2.'
C
C*    Check that primary bit-map size does not exceed maximum.
C
      IF (JPMAP1.LT.KSIZE)
     C   THEN
             WRITE (*,9000) KSIZE , JPMAP1
             KRET = 2
             GO TO 900
         ENDIF
C
C*    Check that secondary bit-map size does not exceed maximum.
C
      IF (JPMAP2.LT.KNUM)
     C   THEN
             WRITE (*,9001) KNUM , JPMAP2
             KRET = 2
             GO TO 900
         ENDIF
C
C*    Check function requested.
C
      IF (HFUNC.NE.'C'.AND.HFUNC.NE.'M')
     C   THEN
             WRITE (*,9002) HFUNC
             KRET = 3
             GO TO 900
         ENDIF
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 3 . Generation of bit-map.
C    -------------------------------------------------------------------
C
  300 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'INSMP2 : Section 3.'
C
C*    Generate the bit-map in accordance with the missing data
C     values.
C
      DO 330 J330=1,KSIZE,KNUM
         IPT = 0
C
         DO 320 J320=J330,J330+KNUM-1
            IPT = IPT + 1
            IF (PSEC4(J320).EQ.PMISS)
     C         THEN
                   IMAP(IPT) = 0
               ELSE
                   IMAP(IPT) = 1
               ENDIF
  320    CONTINUE
C
C
C*       Insert bit-map in GRIB coded data.
C
         CALL INXBIT (KGRIB,KLENG,KMAP2,IMAP,KNUM,KBITS,1,
     C                     'C',KRET)
C
         IF (KRET.NE.0)
     C      THEN
                WRITE (*,9003)
                KRET = 1
                GO TO 900
            ENDIF
  330 CONTINUE
C
C*    Bit map must be a multiple of 8 bits.
C
      ITEMP = (KMAP2+7) / 8
      ITEMP = ITEMP * 8
      IF (ITEMP.NE.KMAP2)
     C   THEN
             IMAP(1) = 0
             ITEMP = ITEMP - KMAP2
             CALL INXBIT (KGRIB,KLENG,KMAP2,IMAP,1,KBITS,ITEMP,
     C                     'C',KRET)
C
             IF (KRET.NE.0)
     C          THEN
                    WRITE (*,9003)
                    KRET = 1
                    GO TO 900
                ENDIF
         ENDIF
C
C*    Copy data to temporary array and remove missing data
C     indicator in temporary array.
C
      INEXT = 0
      DO 340 J340=1,KSIZE
         IF ( PSEC4(J340).NE.PMISS)
     C      THEN
                INEXT        = INEXT + 1
                ZSEC4(INEXT) = PSEC4(J340)
             ENDIF
  340 CONTINUE
C
C*    If missing data is indicated transfer data to original
C     array.
C
      IF (INEXT.NE.KSIZE)
     C   THEN
             DO 350 J350=1,INEXT
                PSEC4(J350) = ZSEC4(J350)
  350        CONTINUE
C
             IF (HFUNC.EQ.'M')
     C          THEN
C
C                   Fixed length messages required, even though
C                   a bit map is used. The otherwise unused part
C                   of the array is set to a genuine data value.
C                   Number of data values includes these padding values.
C
                    DO 360 J360=INEXT+1,KSIZE
                       PSEC4(J360) = PSEC4(1)
  360               CONTINUE
                ELSE
C
C                   Return number of points with real values
C                   (excluding points with missing data values).
C
                    KSIZE = INEXT
                ENDIF
C
         ENDIF
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine. Format statements.
C     ------------------------------------------------------------------
C
  900 CONTINUE
C
      IF (KPR.EQ.1)
     C   THEN
             WRITE (*,*) 'INSMP2 : Section 9.'
             WRITE (*,*) '         Output values set -'
             WRITE (*,9005) KSIZE
         ENDIF
C
 9000 FORMAT (1H ,'INSMP2 : Primary bit-map size is ',I10,
     C            ' ,maximum allowed is ',I10,'.')
C
 9001 FORMAT (1H ,'INSMP2 : Secondary bit-map size is ',I10,
     C            ' ,maximum allowed is ',I10,'.')
C
 9002 FORMAT (1H ,'INSMP2 : Invalid function requested - ',A1)
C
 9003 FORMAT (1H ,'INSMP2 : Error reported by routine INXBIT.')
C
 9004 FORMAT (1H ,'         HFUNC  = ',A1)
C
 9005 FORMAT (1H ,'         KSIZE  = ',I10)
C
 9006 FORMAT (1H ,'         KNUM   = ',I10)
C
      RETURN
C
      END
      SUBROUTINE ECLOC1  (HFUNC,KSEC1,KGRIB,KLENG,KNSPT,KBITS,
     C                     KPR,KRET)
C
C**** ECLOC1 - GRIB coding/decoding of ECMWF local use of Section 1.
C
C     Purpose.
C     --------
C
C           GRIB coding/decoding of ECMWF local use of Section 1.
C
C**   Interface.
C     ----------
C
C           CALL ECLOC1 (HFUNC,KSEC1,KGRIB,KLENG,KNSPT,KBITS,
C    C                     KPR,KRET)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               HFUNC      - Requested function.
C                            'C' to code data.
C                            'D' to decode data.
C
C               KSEC1      - Array containing Grib Section 1 data.
C
C               KGRIB      - Array containing Grib coded data.
C
C               KLENG      - Length (words) of KGRIB.
C
C               KNSPT      - Bit number after which insertion or
C                            extraction starts.
C
C               KBITS      - Number of bits in computer word.
C
C               KPR        - Debug print switch.
C                            0 , No printout.
C                            1 , Debug printout.
C
C               KRET       - Response to error indicator.
C                            0        , Abort if error encountered.
C                            Non-zero , Return to calling routine
C                                       even if error encountered.
C
C               Output Parameters.
C               ------------------
C
C               KSEC1      - Array containing Grib Section 1 data.
C
C               KGRIB      - Array containing Grib coded data.
C
C               KNSPT      - Bit number after of last bit inserted/extra
C
C               KRET       - Return code.
C                            0   , No error encountered.
C                            1   , Invalid local use definition.
C                            2   , Error reported by routine INXBIT.
C
C     Method.
C     -------
C
C           Input data packed/unpacked in accordance with ECMWF usage of
C           local part of section 1 of Grib code.
C
C     Externals.
C     ----------
C
C           INXBIT
C           ABORTX
C
C     Reference.
C     ----------
C
C           WMO Manual On Codes for Grib Code.
C
C     Comments.
C     ---------
C
C
C           Routine contains Sections 0 to 6 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      03:11:92.
C
C     Modifications.
C     --------------
C
C           None.
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ------------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      CHARACTER*(*) HFUNC
      CHARACTER*1   YFUNC
C
      INTEGER ILALO
      INTEGER INSPT
      INTEGER IRET
C
      INTEGER KBITS
      INTEGER KGRIB
      INTEGER KLENG
      INTEGER KNSPT
      INTEGER KPR
      INTEGER KRET
      INTEGER KSEC1
C
      DIMENSION ILALO(4)
C
      DIMENSION KGRIB(*)
      DIMENSION KSEC1(*)
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set initial values.
C     ------------------------------------------------------------------
C
  100 CONTINUE
C
      IF (KPR.EQ.1)
     C   THEN
             WRITE (*,*) 'ECLOC1 : Section 1.'
             WRITE (*,*) '         Input values used -'
             WRITE (*,9002) HFUNC
             WRITE (*,9003) KNSPT
         ENDIF
C
C     Reset return code to 0, retaining input value to decide
C     on abort / no abort, if error encountered later.
C
      IRET = KRET
      KRET = 0
C
      YFUNC = HFUNC
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 .  Check input parameters.
C     ------------------------------------------------------------------
C
  200 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'ECLOC1 : Section 2.'
C
C     Check valid local definition number.
C
      IF (YFUNC.EQ.'C'.AND.KSEC1(37).NE.1.AND.KSEC1(37).NE.2)
     C   THEN
             KRET = 1
             WRITE (*,9001) KSEC1(37)
             GO TO 900
         ENDIF
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 3 . ECMWF common local use of Grib Section 1.
C     ------------------------------------------------------------------
C
  300 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'ECLOC1 : Section 3.'
C
C*    Octet 41 : Local use definition number.
C     Octet 42 : Class
C     Octet 43 : Type
C     Three 8 bit fields.
C
C     Insert/extract fields.
C
      CALL INXBIT (KGRIB,KLENG,KNSPT,KSEC1(37),3,KBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 2
             WRITE (*,9004)
             GO TO 900
         ENDIF
C
C*    Octets 44-45 : Stream
C     One 16 bit field.
C
C     Insert/extract fields.
C
      CALL INXBIT (KGRIB,KLENG,KNSPT,KSEC1(40),1,KBITS,
     C             16,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 2
             WRITE (*,9004)
             GO TO 900
         ENDIF
C
C*    Octets 46-49 : Version number or experiment identifier.
C     One 32 bit field.
C
C     Insert/extract field.
C
      CALL INXBIT (KGRIB,KLENG,KNSPT,KSEC1(41),1,KBITS,
     C             32,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 2
             WRITE (*,9004)
             GO TO 900
         ENDIF
C
C*    If image data, go to Section 4.
C
      IF (KSEC1(39).EQ.40) GO TO 400
C
C*    If 3d or 4d analysis or gradients go to Section 5.
C
      IF (KSEC1(39).GT.4.AND.KSEC1(39).LT.9) GO TO 500
C
C*    If ensemble forecasts or clusters, go to Section 6.
C
      IF (KSEC1(39).EQ.10.OR.KSEC1(39).EQ.11) GO TO 600
      IF (KSEC1(39).EQ.14.OR.KSEC1(39).EQ.15) GO TO 600
C
C*    Octet 50-52 : Reserved.
C     Already set to 0, so update bit pointer only.
C
      KNSPT = KNSPT + 24
      GO TO 900
C
C    -------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 4 . Image data extensions.
C    -------------------------------------------------------------------
C
  400 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'ECLOC1 : Section 4.'
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 5 . Extensions for 3d or 4d analysis or gradients.
C     ------------------------------------------------------------------
C
  500 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'ECLOC1 : Section 5.'
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 6 .Extensions for Ensemble Forecasts and clusters.
C     ------------------------------------------------------------------
C
  600 CONTINUE
C
      IF (KPR.EQ.1) WRITE (*,*) 'ECLOC1 : Section 6.'
C
C*    Octets 50 : Forecast or cluster number.
C     Octets 51 : Total number of Forecasts or clusters.
C     Two 8 bit fields.
C
C     Insert/extract fields.
C
      CALL INXBIT (KGRIB,KLENG,KNSPT,KSEC1(42),2,KBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 2
             WRITE (*,9004)
             GO TO 900
         ENDIF
C
C*    Octet 52 : Reserved
C
      KNSPT = KNSPT + 8
C
C*    Finished, if forecast.
C
      IF (KSEC1(39).EQ.10.OR.KSEC1(39).EQ.11) GO TO 900
C
C*    Octet 53 : Clustering method.
C     One 8 bit field.
C
C     Insert/extract field.
C
      CALL INXBIT (KGRIB,KLENG,KNSPT,KSEC1(44),1,KBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 2
             WRITE (*,9004)
             GO TO 900
         ENDIF
C
C*    Octets 54-55 : Start timestep when clustering.
C     Octets 56-57 : End timestep when clustering.
C     Two 16 bit fields.
C
C     Insert/extract fields.
C
      CALL INXBIT (KGRIB,KLENG,KNSPT,KSEC1(45),2,KBITS,
     C             16,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 2
             WRITE (*,9004)
             GO TO 900
         ENDIF
C
C*    Octets 58-60 : Northern latitude of domain of clustering
C     Octets 61-63 : Western longitude of domain of clustering
C     Octets 64-66 : Southern latitude of domain of clustering
C     Octets 67-69 : Eastern longitude of domain of clustering
C     Four 24 bit fields.
C
C     When coding values, set sign bit to 1, if value is
C     negative.
C
      IF (YFUNC.EQ.'C')
     C   THEN
             ILALO(1)=KSEC1(47)
             ILALO(2)=KSEC1(48)
             ILALO(3)=KSEC1(49)
             ILALO(4)=KSEC1(50)
             IF (KSEC1(47).LT.0) ILALO(1)=-(KSEC1(47))+8388608
             IF (KSEC1(48).LT.0) ILALO(2)=-(KSEC1(48))+8388608
             IF (KSEC1(49).LT.0) ILALO(3)=-(KSEC1(49))+8388608
             IF (KSEC1(50).LT.0) ILALO(4)=-(KSEC1(50))+8388608
         ENDIF
C
C     Insert/extract fields.
C
      CALL INXBIT (KGRIB,KLENG,KNSPT,ILALO(1),4,KBITS,
     C             24,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 2
             WRITE (*,9004)
             GO TO 900
         ENDIF
C
C     When decoding values, if sign bit is 1, value is
C     negative.
C
      IF (YFUNC.EQ.'D')
     C   THEN
             KSEC1(47) = ILALO(1)
             KSEC1(48) = ILALO(2)
             KSEC1(49) = ILALO(3)
             KSEC1(50) = ILALO(4)
             IF (KSEC1(47).GT.8388608) KSEC1(47)=-(KSEC1(47)-8388608)
             IF (KSEC1(48).GT.8388608) KSEC1(48)=-(KSEC1(48)-8388608)
             IF (KSEC1(49).GT.8388608) KSEC1(49)=-(KSEC1(49)-8388608)
             IF (KSEC1(50).GT.8388608) KSEC1(50)=-(KSEC1(50)-8388608)
         ENDIF
C
C*    Octet 70 : Number of cluster to which operational forecast
C                  belongs.
C     Octet 71 : Number of cluster to which control forecast
C                  belongs.
C     Octet 72 : Number of forecasts belonging to the cluster.
C     Three 8 bit fields.
C
C     Insert/extract fields.
C
      CALL INXBIT (KGRIB,KLENG,KNSPT,KSEC1(51),3,KBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 2
             WRITE (*,9004)
             GO TO 900
         ENDIF
C
C*    The number of forecasts belonging to a cluster may vary,
C     but section 1 is kept a fixed length.
C
      INSPT = KNSPT + 2048
C
C*    Octets 73-328 : List of N ensemble forecast numbers.
C     KSEC1(53) 8 bit fields.
C
C     Insert/extract fields.
C
      CALL INXBIT (KGRIB,KLENG,KNSPT,KSEC1(54),KSEC1(53),KBITS,
     C             8,YFUNC,KRET)
      IF (KRET.NE.0)
     C   THEN
             KRET = 2
             WRITE (*,9004)
             GO TO 900
         ENDIF
C
      KNSPT = INSPT
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Abort/return to calling routine. Format statements.
C     ------------------------------------------------------------------
C
  900 CONTINUE
C
      IF (KPR.EQ.1)
     C   THEN
             WRITE (*,*) 'ECLOC1 : Section 9.'
             WRITE (*,*) '         Output values set -'
             WRITE (*,9003) KNSPT
         ENDIF
C
C
 9001 FORMAT (1H ,'ECLOC1 : Invalid local definition number ',I8)
C
 9002 FORMAT (1H ,'         HFUNC  = ',A1)
C
 9003 FORMAT (1H ,'         KNSPT  = ',I12)
C
 9004 FORMAT (1H ,'Error reported by routine INXBIT.')
C
C     Abort if requested to do so when an error has been encountered.
C
      IF (IRET.EQ.0.AND.KRET.NE.0)
     C   THEN
             CALL ABORTX ('ECLOC1')
         ELSE
             RETURN
         ENDIF
C
      END
      SUBROUTINE INXBIT (KGRIB,KLENG,KNSPT,KPARM,KNUM,KBIT,
     C                   KBLEN,HFUNC,KRET)
C
C**** INXBIT - Insert/extract bits consecutively in/from a given array
C
C     Purpose.
C     --------
C
C           Take rightmost KBLEN bits from KNUM words of KPARM
C           and insert them consecutively in KGRIB, starting at
C           bit after KNSPT or vice versa.
C
C**   Interface.
C     ----------
C
C           CALL INXBIT (KGRIB,KLENG,KNSPT,KPARM,KNUM,KBIT,
C    C                   KBLEN,KRET)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KGRIB      - Array containing bitstream.
C               KLENG      - Length (words) of this array.
C               KNSPT      - Bit number after which insertion or
C                            extraction starts.
C               KPARM      - Array from which bits are taken for
C                            insertion in the bitstream or to which
C                            bits are extracted from the bitstream.
C               KBIT       - Number of bits in computer word.
C               KNUM       - Number of bit fields inserted/extracted.
C               KBLEN      - Number of bits per bit field.
C               HFUNC      - Requested function.
C                            'C' to insert bits in bitstream,
C                            'D' to extract bits from bitstream.
C
C               Output Parameters.
C               ------------------
C
C               KNSPT      - Bit number of last bit inserted/extracted.
C
C               KRET       - Return code.
C                            0 , No error encountered.
C                            1 , Insertion/extraction exceeded
C                                array boundary.
C
C     Method.
C     -------
C
C           Word and offset pointer calculated before calling
C           insertion/extraction routines.
C
C     Externals.
C     ----------
C
C           SBYTES
C           GBYTES
C
C     Reference.
C     ----------
C
C           ECLIB documentation on SBYTES and GBYTES.
C
C     Comments.
C     ---------
C
C           SUN version of routine.
C           Routine contains Sections 0 to 3 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      18.06.91
C
C     Modifications.
C     --------------
C
C           J. Hennessy      ECMWF      08.11.91
C           Parameter KMACH removed from list of input parameters.
C
C           J. Hennessy      ECMWF      12.10.92
C           Dimension of IMASK changed from 64 to 65.
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ----------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
      INTEGER IND
      INTEGER INUM
      INTEGER IOFF
      INTEGER IPR
      INTEGER IWORD
C
      INTEGER KBIT
      INTEGER KBLEN
      INTEGER KGRIB
      INTEGER KLENG
      INTEGER KNSPT
      INTEGER KNUM
      INTEGER KPARM
      INTEGER KRET
C
      INTEGER J901
C
      DIMENSION KGRIB(KLENG)
      DIMENSION KPARM(*)
C
      CHARACTER*1 HFUNC
C
C
C     Debug print switch.
C
      DATA IPR /0/
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Set initial values.
C     ----------------------------------------------------------------
C
  100 CONTINUE
C
      IF (IPR.EQ.1)
     C   THEN
             WRITE (*,*) 'INXBIT : Section 1.'
             WRITE (*,*) '         Input values used -'
             WRITE (*,9009) KLENG
             WRITE (*,9002) KNSPT
             WRITE (*,9004) KBIT
             WRITE (*,9005) HFUNC
         ENDIF
C
      KRET = 0
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 2 . Bit insertion/extraction.
C     ----------------------------------------------------------------
C
  200 CONTINUE
C
      IF (IPR.EQ.1) WRITE (*,*) 'INXBIT : Section 2.'
C
C*    Calculate word pointer and offset.
C
      IWORD = KNSPT / KBIT
      IOFF  = KNSPT - IWORD * KBIT
      IWORD = IWORD + 1
      IF (IPR.EQ.1) WRITE (*,9003) IWORD , IOFF
C
C     Insert/extract bits.
C
      IF (HFUNC.EQ.'C')
     C   THEN
             CALL SBYTES (KGRIB(IWORD),KPARM,IOFF,KBLEN,0,KNUM)
         ELSE
             CALL GBYTES (KGRIB(IWORD),KPARM,IOFF,KBLEN,0,KNUM)
         ENDIF
C
C     Update pointer.
C
      KNSPT = KNSPT + KBLEN * KNUM
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 3 . Check out of range.
C    -----------------------------------------------------------------
C
  300 CONTINUE
C
      IF (IPR.EQ.1) WRITE (*,*) 'INXBIT : Section 3.'
C
      IND = KNSPT / KBIT
      IF (IND.GT.KLENG)
     C   THEN
             KRET = 1
             WRITE (*,9001) IND , KLENG
         ENDIF
C
C     ----------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine. Format statements.
C     ----------------------------------------------------------------
C
  900 CONTINUE
C
      IF (IPR.EQ.1)
     C   THEN
             INUM = KNUM
             IF (INUM.GT.360)
     C          THEN
                    INUM = 360
                    WRITE (*,9007) INUM
                ENDIF
             DO 901 J901=1,INUM
               IF (HFUNC.EQ.'C')
     C             THEN
                       WRITE (*,9006) KPARM(J901)
                   ELSE
                       WRITE (*,9008) KPARM(J901)
                   ENDIF
  901        CONTINUE
             WRITE (*,*) 'INXBIT : Section 9.'
             WRITE (*,*) '         Output values set -'
             WRITE (*,9002) KNSPT
         ENDIF
C
C
 9001 FORMAT (1H ,'INXBIT : Word ',I8,' is outside array bounds ',I8)
C
 9002 FORMAT (1H ,'         KNSPT  = ',I8)
C
 9003 FORMAT (1H ,'INXBIT : Word is',I8,', bit offset is ',I2)
C
 9004 FORMAT (1H ,'         KBIT   = ',I8)
C
 9005 FORMAT (1H ,'         HFUNC  = ',A)
C
 9006 FORMAT (1H ,'         Inserted value = ',I20)
C
 9007 FORMAT (1H ,'         First ',I9,' values.')
C
 9008 FORMAT (1H ,'         Extracted value = ',I20)
C
 9009 FORMAT (1H ,'         KLENG  = ',I20)
C
      RETURN
C
      END
      SUBROUTINE ABORTX (HNAME)
C
C**** ABORTX - Terminates execution of program.
C
C     Purpose.
C     --------
C
C           Terminates execution of program.
C
C**   Interface.
C     ----------
C
C           CALL ABORTX (HNAME)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               HNAME      - Name of calling routine.
C
C               Output Parameters.
C               ------------------
C
C               None.
C
C     Method.
C     -------
C
C           Prints message and terminates.
C
C     Externals.
C     ----------
C
C           ABORT
C
C     Reference.
C     ----------
C
C           None.
C
C     Comments.
C     ---------
C
C           SUN version of routine.
C           Routine contains Sections 0 to 1 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      13.11.91
C
C     Modifications.
C     --------------
C
C           None.
C
C     ------------------------------------------------------------------
C
C
C
C
C
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 arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      CHARACTER*(*) HNAME
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Print message and terminate.
C     ------------------------------------------------------------------
C
  100 CONTINUE
C
      WRITE (*,9001) HNAME
C
      CALL ABORT
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C*    Section 9 . Format statements.
C     ------------------------------------------------------------------
C
  900 CONTINUE
C
 9001 FORMAT (1H ,'ABORTX : Routine ',A,' has requested program',
     C               ' termination.')
C
      RETURN
C
      END
      SUBROUTINE SETPAR (KBIT,KNEG,KPR)
C
C**** SETPAR - Set number of bits in word. Set maximum negative integer.
C
C     Purpose.
C     --------
C
C           Set number of bits in word. Set maximum negative integer.
C
C**   Interface.
C     ----------
C
C           CALL SETPAR (KBIT,KNEG,KPR)
C
C           Integer    K.
C           Real       P.
C           Logical    O.
C           Character  H.
C
C               Input Parameters.
C               -----------------
C
C               KPR        - Debug print switch.
C                            1 , print out.
C                            0 , No print out.
C
C               Output Parameters.
C               ------------------
C
C               KBIT       - Number of bits in computer word.
C
C               KNEG       - Maximum negative integer.
C
C     Method.
C     -------
C
C           Values are assigned.
C
C     Externals.
C     ----------
C
C           None.
C
C     Reference.
C     ----------
C
C           None.
C
C     Comments.
C     ---------
C
C           SUN version of routine.
C           Routine contains Sections 0 to 3 and Section 9.
C
C     Author.
C     -------
C
C           J. Hennessy      ECMWF      28.10.91
C
C     Modifications.
C     --------------
C
C           None.
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 0 . Definition of variables. Data statements.
C     ------------------------------------------------------------------
C
C*    Prefix conventions for variable names.
C
C     Logical      L (but not LP), global or common.
C                  O, dummy arguments.
C                  G, local variable.
C                  LP, parameter.
C     Character    C, Global or common.
C                  H, dummy arguments.
C                  Y (but not YP), local variables.
C                  YP, parameter.
C     Integer      M and N, global or common.
C                  K, dummy arguments.
C                  I, local variables.
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 arguments.
C                  Z, local variables.
C                  PP, parameter.
C
C
      INTEGER KBIT
      INTEGER KNEG
      INTEGER KPR
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C
C*    Section 1 . Assign values.
C     ------------------------------------------------------------------
C
  100 CONTINUE
C
      IF (KPR.EQ.1)  WRITE (*,*) ' SETPAR : Section 1.'
C
      KBIT = 32
      KNEG = -2147483647
C
C     ------------------------------------------------------------------
C
C
C
C
C
C
C
C
C
C*    Section 9 . Return to calling routine. Format statements.
C     ------------------------------------------------------------------
C
  900 CONTINUE
C
      IF (KPR.EQ.1)
     C   THEN
             WRITE (*,*) ' SETPAR : Section 9.'
             WRITE (*,*) '          Output values set -'
             WRITE (*,9001) KBIT
             WRITE (*,9002) KNEG
         ENDIF
C
 9001 FORMAT (1H ,'          KBIT = ',I3)
C
 9002 FORMAT (1H ,'          KNEG = ',I22)
C
      RETURN
C
      END
