#define MISSING -55555.0

      PROGRAM CMPGFS
      IMPLICIT NONE
C
      INTEGER JPACK, JPMXOPT
      PARAMETER (JPACK=1080000)
      PARAMETER (JPMXOPT=10)
C
      INTEGER IS0,IS1,IS2,IS3,IS4,IEDITN,LENGTH
      INTEGER JS0,JS1,JS2,JS3,JS4,JEDITN,IZERO
      INTEGER KRET, LENOUT1, LENOUT2, IWORD, LOOP, N, ICOUNT, ILEVEL
      INTEGER NVALS1, NVALS2, ISTATUS, ITOTAL1, ITOTAL2
      INTEGER NFAILS, NFAIL1
      INTEGER NEXT1, NEXT2, ILIST(36)
      INTEGER ISEC0(2), ISEC1(1024), ISEC2(1024), ISEC3(2), ISEC4(1024)
      INTEGER JSEC0(2), JSEC1(1024), JSEC2(1024), JSEC3(2), JSEC4(1024)
      INTEGER INBUFF1(JPACK), INBUFF2(JPACK)
      REAL ZSEC2(1024), ZSEC3(2), ARRAY1(1500000), ARRAY2(1500000)
      REAL WSEC2(1024)
      REAL V1, V2, DIFF
      LOGICAL LLEVEL, LFAIL, LFAIL1, LRANDOM, LPRINT, LDIFF
      LOGICAL LBIT2BT, LBIT4BT
C
      CHARACTER*128 COMPFILE1, COMPFILE2, OPTIONS(JPMXOPT)
      INTEGER IARGC
      EXTERNAL IARGC, GETENV
      INTEGER FILE1, FILE2, JCOUNT, ILENB, IPUNP
      REAL MAXVAL1,MAXVAL2, MAXDIFF, MAXPERC, MEAN, TOLERNC, MARGIN
      REAL MAXDV1, MAXDV2
      REAL MINVAL1,MINVAL2, AVERAGE1, AVERAGE2
C
C     Externals
C
      INTEGER PBXTOTL, PBXGET, PBXXFIND, JMEMCMP, SOFFSET
C
C     Statement function
C
      REAL A, B
      LOGICAL NOTEQ
      NOTEQ(A,B) = (ABS((A)-(B)).GT.1E-3)
C
C     -----------------------------------------------------------------|
C     Handle command line
C     -----------------------------------------------------------------|
C
      JCOUNT = IARGC()
C
C     Help output (and exit)
C
      IF( JCOUNT.EQ.0 ) THEN
        WRITE(*,*) 'Usage: compareGribFiles [options] file1 file2'
        WRITE(*,*) '       where options are:'
        WRITE(*,*) '     -pN      for printout level N,'
        WRITE(*,*) '              N = 0 for no printout'
        WRITE(*,*) '              N = 1, 2, .. for increasing detail'
        WRITE(*,*) '              Default N = 1'
        WRITE(*,*) '     -tX      to specify a tolerance percentage'
        WRITE(*,*) '              for comparing field values. X must'
        WRITE(*,*) '              be a real number, eg 5.0'
        WRITE(*,*) '              Default X = 0.0'
        WRITE(*,*) '     -fail    if compare to stop after a failing'
        WRITE(*,*) '              comparison.'
        WRITE(*,*) '              Default is to continue.'
        WRITE(*,*) '     -bit2bit for a bit to bit comparison between'
        WRITE(*,*) '              GRIBS headers in the two files'
        WRITE(*,*) '     -bit4bit for a bit for bit comparison between'
        WRITE(*,*) '              GRIBS in the two files'
        WRITE(*,*) '     -random  if the GRIB products are in a'
        WRITE(*,*) '              different order on the two files.'
        WRITE(*,*) '              Default is to assume the same order.'
        WRITE(*,*) ' '
        WRITE(*,*) 'The return status is 0 if the values in the GRIBs'
        WRITE(*,*) 'in are within the given tolerance.'
        WRITE(*,*) 'Otherwise, the return status is 1.'
        WRITE(*,*) ' '
        ISTATUS = 1
        GOTO 990
      ENDIF
C
C     Check usage (and exit)
C
      IF( JCOUNT.LT.2 ) THEN
        WRITE(*,*) 'Usage: compare [options] file1 file2'
        ISTATUS = 1
        GOTO 990
      ENDIF
C
      IF( JCOUNT.GT.2 ) THEN
        IF( JCOUNT.GT.(JPMXOPT+2) ) THEN
          WRITE(*,*) 'Too many options on command line, max = ', JPMXOPT
          ISTATUS = 1
          GOTO 990
        ENDIF
        DO LOOP = 1, (JCOUNT-2)
          CALL GETARG(LOOP,OPTIONS(LOOP))
        ENDDO
      ENDIF
C
      CALL GETARG((JCOUNT-1),COMPFILE1)
      CALL GETARG(JCOUNT,COMPFILE2)
C
C     Default tolerance and print output level
C
      TOLERNC = 0.0
      MARGIN = 0.0
      ILEVEL = 1
      LLEVEL = .FALSE.
      LFAIL1 = .FALSE.
      LRANDOM = .FALSE.
      LBIT2BT = .FALSE.
      LBIT4BT = .FALSE.
      NFAILS = 0
      NFAIL1 = 0
C
C     Check options to see if defaults to be overridden
C
      DO LOOP = 1, (JCOUNT-2)
C
C       Print level option
C
        IF( OPTIONS(LOOP)(1:2).EQ.'-p' ) THEN
          ILEVEL = ICHAR(OPTIONS(LOOP)(3:3)) - ICHAR('0')
          IF( (ILEVEL.LT.0).OR.(ILEVEL.GT.9) ) THEN
             WRITE(*,*) 'Invalid -p option: ' // OPTIONS(LOOP)
            ISTATUS = 1
            GOTO 990
          ENDIF
C
C         Set flag if print level set
C
          LLEVEL = .TRUE.
        ENDIF
C
C       Tolerance option
C
        IF( OPTIONS(LOOP)(1:2).EQ.'-t' ) THEN
          READ(OPTIONS(LOOP)(3:23),'(F20.10)') TOLERNC
          IF( TOLERNC.LT.0.0 ) TOLERNC = 0.0
          IF( TOLERNC.GT.100.0 ) TOLERNC = 100.0
        ENDIF
C
C       Bit to bit option
C
        IF( OPTIONS(LOOP)(1:8).EQ.'-bit2bit' ) LBIT2BT = .TRUE.
C
C       Bit for bit option
C
        IF( OPTIONS(LOOP)(1:8).EQ.'-bit4bit' ) LBIT4BT = .TRUE.
C
C       Fail option
C
        IF( OPTIONS(LOOP)(1:5).EQ.'-fail' ) LFAIL1 = .TRUE.
C
C       Random option
C
        IF( OPTIONS(LOOP)(1:7).EQ.'-random' ) LRANDOM = .TRUE.
C
      ENDDO
C
C     -----------------------------------------------------------------|
C     Open the data files
C     -----------------------------------------------------------------|
C
      ITOTAL1 = PBXTOTL(COMPFILE1)
      IF( ITOTAL1.LT.1 ) THEN
        WRITE(*, *) 'No GRIBS found in file: ', COMPFILE1
        ISTATUS = 1
        GOTO 990
      ENDIF
C
      ITOTAL2 = PBXTOTL(COMPFILE2)
      IF( ITOTAL2.LT.1 ) THEN
        WRITE(*, *) 'No GRIBS found in file: ', COMPFILE2
        ISTATUS = 1
        GOTO 990
      ENDIF
C
      IF( ITOTAL1.NE.ITOTAL2 ) THEN
        WRITE(*, *) 'The files have different number of GRIBs'
        WRITE(*, *) ITOTAL1, ' GRIB(s) in '
        WRITE(*, *) COMPFILE1
        WRITE(*, *) ITOTAL2, ' GRIB(s) in '
        WRITE(*, *) COMPFILE2
        IF( LFAIL1 ) THEN
          ISTATUS = 1
          GOTO 990
        ENDIF
      ENDIF
C
C     -----------------------------------------------------------------|
C     Read GRIB products one at a time
C     -----------------------------------------------------------------|
C
      LFAIL = .FALSE.
      ICOUNT = 0
      NEXT1 = 0
C
   50 CONTINUE
C
      NEXT1 = NEXT1 + 1
C
C     Clear arrays to allow clean comparisons
C
      DO LOOP = 1, 1024
        ISEC1(LOOP) = 0
        JSEC1(LOOP) = 0
        ISEC2(LOOP) = 0
        JSEC2(LOOP) = 0
        ISEC4(LOOP) = 0
        JSEC4(LOOP) = 0
        ZSEC2(LOOP) = 0.0
        WSEC2(LOOP) = 0.0
      ENDDO
      DO LOOP = 1, 2
        ISEC0(LOOP) = 0
        JSEC0(LOOP) = 0
        ISEC3(LOOP) = 0
        JSEC3(LOOP) = 0
        ZSEC3(LOOP) = 0.0
      ENDDO
C
C     Read packed field from first file into INBUFF1.
C
      LENOUT1 = PBXGET(COMPFILE1,INBUFF1, JPACK*4, NEXT1)
      IF( LENOUT1.LT.0 ) THEN
        WRITE(*, *) COMPFILE1 // ' read error for GRIB ', NEXT1
        ISTATUS = 1
        GOTO 990
      ENDIF
C
C     Unpack GRIB message headers.
C
      KRET = 1
      IPUNP = 1500000
      ILENB = (LENOUT1+3)/4
      ISEC3(2) = NINT(MISSING)
      ZSEC3(2) = MISSING
      CALL GRIBEX (ISEC0,ISEC1,ISEC2,ZSEC2,ISEC3,ZSEC3,ISEC4,
     X             ARRAY1,IPUNP,INBUFF1,ILENB,IWORD,'I',KRET)
C
      IF( KRET.GT.0 ) THEN
        WRITE(*,*) 'GRIBEX return code = ',KRET
        WRITE(*,*) 'GRIBEX error in product from file: ' // COMPFILE1
        WRITE(*,*) 'Product number = ', NEXT1
        ISTATUS = 1
        GOTO 990
      ENDIF
C
C     Read packed field from second file into INBUFF2.
C
C     Are the fields in a different sequence on the two file?
C
      IF( LRANDOM ) THEN
C
        NEXT2 = PBXXFIND(INBUFF1,COMPFILE2)
        IF( NEXT2.LT.0 ) THEN
          WRITE(*, *) COMPFILE2 // ' error finding matching GRIB'
          WRITE(*,*) 'Product number = ', NEXT1
          ISTATUS = 1
          GOTO 990
        ENDIF
C
C     ... the fields are in the same sequence on the two files
C
      ELSE
        NEXT2 = NEXT1
      ENDIF
C
      LENOUT2 = PBXGET(COMPFILE2,INBUFF2, JPACK*4, NEXT2)
      IF( LENOUT2.LT.0 ) THEN
        WRITE(*, *) COMPFILE2 // ' read error for GRIB ', NEXT2
        ISTATUS = 1
        GOTO 990
      ENDIF
C
      ICOUNT = ICOUNT + 1
C
C     -----------------------------------------------------------------|
C     If requested, compare the GRIBs bit for bit
C     -----------------------------------------------------------------|
C
      IF( LBIT4BT ) THEN
        IF( LENOUT1.NE.LENOUT2) THEN
          WRITE(*,*)
     X    'GRIBs', NEXT1,' and ', NEXT2,' are NOT bit for bit the same'
          LFAIL = .FALSE.
          GOTO 800
        ENDIF
C
        IZERO = 0
        KRET = JMEMCMP(INBUFF1,IZERO,INBUFF2,IZERO,LENOUT1)
        IF( KRET.NE.0 ) THEN
          WRITE(*,*)
     X    'GRIBs', NEXT1,' and ', NEXT2,' are NOT bit for bit the same'
          LFAIL = .FALSE.
        ELSE
          WRITE(*,*)
     X    'GRIBs', NEXT1,' and ', NEXT2,' are  bit for bit the same'
        ENDIF
        GOTO 800
      ENDIF
C
C     -----------------------------------------------------------------|
C     If requested, compare the GRIBs bit to bit
C     -----------------------------------------------------------------|
C
      IF( LBIT2BT ) THEN
        IF( LENOUT1.NE.LENOUT2) THEN
          WRITE(*,*)
     X    'GRIBs', NEXT1,' - ', NEXT2,' are different lengths'
          LFAIL = .FALSE.
Cjdc      GOTO 800
        ENDIF
C
        KRET = SOFFSET(INBUFF1,IS0,IS1,IS2,IS3,IS4,IEDITN)
        KRET = SOFFSET(INBUFF2,JS0,JS1,JS2,JS3,JS4,JEDITN)
C
        LENGTH = IS1 - IS0
        KRET = JMEMCMP(INBUFF1,IS0,INBUFF2,JS0,LENGTH)
        IF( KRET.NE.0 ) THEN
          WRITE(*,*)
     X    'GRIBs', NEXT1,' - ', NEXT2,' sections 0 differ'
          LFAIL = .FALSE.
        ENDIF
C
        LENGTH = IS2 - IS1
        KRET = JMEMCMP(INBUFF1,IS1,INBUFF2,JS1,LENGTH)
        IF( KRET.NE.0 ) THEN
          WRITE(*,*)
     X    'GRIBs', NEXT1,' - ', NEXT2,' sections 1 differ'
          LFAIL = .FALSE.
        ENDIF
C
        IF( IS3.NE.0 ) THEN
          LENGTH = IS3 - IS2
        ELSE
          LENGTH = IS4 - IS2
        ENDIF
        KRET = JMEMCMP(INBUFF1,IS2,INBUFF2,JS2,LENGTH)
        IF( KRET.NE.0 ) THEN
          WRITE(*,*)
     X    'GRIBs', NEXT1,' - ', NEXT2,' sections 2 differ'
          LFAIL = .FALSE.
        ENDIF
C
        IF( IS3.NE.0 ) THEN
          LENGTH = IS4 - IS3
          KRET = JMEMCMP(INBUFF1,IS3,INBUFF2,JS3,LENGTH)
          IF( KRET.NE.0 ) THEN
            WRITE(*,*)
     X      'GRIBs', NEXT1,' - ', NEXT2,' sections 3 differ'
            LFAIL = .FALSE.
          ENDIF
        ENDIF
C
Cjdc    LENGTH = LENOUT1 - IS4
        LENGTH = 11
        KRET = JMEMCMP(INBUFF1,IS4,INBUFF2,JS4,LENGTH)
        IF( KRET.NE.0 ) THEN
          WRITE(*,*)
     X    'GRIBs', NEXT1,' - ', NEXT2,' sections 4 leading bytes differ'
          LFAIL = .FALSE.
        ENDIF
C
        GOTO 800
      ENDIF
C
C     -----------------------------------------------------------------|
C     Otherwise, compare the GRIB values
C     -----------------------------------------------------------------|
C
C     Unpack GRIB messages.
C
      KRET = 1
      IPUNP = 1500000
      ILENB = (LENOUT1+3)/4
      ISEC3(2) = NINT(MISSING)
      ZSEC3(2) = MISSING
      CALL GRIBEX (ISEC0,ISEC1,ISEC2,ZSEC2,ISEC3,ZSEC3,ISEC4,
     X             ARRAY1,IPUNP,INBUFF1,ILENB,IWORD,'D',KRET)
C
      IF( KRET.GT.0 ) THEN
        WRITE(*,*) 'GRIBEX return code = ',KRET
        WRITE(*,*) 'GRIBEX error in product from file: ' // COMPFILE1
        WRITE(*,*) 'Product number = ', NEXT1
        ISTATUS = 1
        GOTO 990
      ENDIF
C
      NVALS1 = ISEC4(1)
C
      KRET = 1
      IPUNP = 1500000
      ILENB = (LENOUT2+3)/4
      CALL GRIBEX (JSEC0,JSEC1,JSEC2,WSEC2,JSEC3,ZSEC3,JSEC4,
     X             ARRAY2,IPUNP,INBUFF2,ILENB,IWORD,'D',KRET)
C
      IF( KRET.GT.0 ) THEN
        WRITE(*,*) 'GRIBEX return code = ',KRET
        WRITE(*,*) 'GRIBEX error in product from file: ' // COMPFILE2
        WRITE(*,*) 'Product number = ', NEXT2
        ISTATUS = 1
        GOTO 990
      ENDIF
C
      NVALS2 = JSEC4(1)
C
      IF( NVALS1.NE.NVALS2 ) THEN
        WRITE(*,*) 'Comparing GRIB ',NEXT1,' from '  // COMPFILE1
        WRITE(*,*) 'with      GRIB ',NEXT2,' from '  // COMPFILE2
        WRITE(*,*) 'The two GRIBs have different number of values'
        WRITE(*,*) NVALS1,' values in the grib from ' // COMPFILE1
        WRITE(*,*) NVALS2,' values in the grib from ' // COMPFILE2
        IF( LFAIL1 ) THEN
          ISTATUS = 1
          GOTO 990
        ENDIF
      ENDIF
C
C     -----------------------------------------------------------------|
C     Compare the GRIB headers
C     -----------------------------------------------------------------|
C
      LDIFF = .TRUE.
      DO LOOP = 1, 1024
        IF( ISEC1(LOOP).NE.JSEC1(LOOP) ) THEN
          IF( LDIFF ) THEN
            WRITE(*,*) 'GRIBs', NEXT1,' and ', NEXT2,': headers differ'
            LDIFF = .FALSE.
          ENDIF
          WRITE(*,*) 'ISEC1(',LOOP,') : ', ISEC1(LOOP), JSEC1(LOOP)
        ENDIF
      ENDDO
C
      DO LOOP = 1, 1024
        IF( ISEC2(LOOP).NE.JSEC2(LOOP) ) THEN
          IF( LDIFF ) THEN
            WRITE(*,*) 'GRIB headers differ:'
            LDIFF = .FALSE.
          ENDIF
          WRITE(*,*) 'ISEC2(',LOOP,') : ', ISEC2(LOOP), JSEC2(LOOP)
        ENDIF
      ENDDO
C
      DO LOOP = 1, 1024
        IF( ISEC4(LOOP).NE.JSEC4(LOOP) ) THEN
          IF( LDIFF ) THEN
            WRITE(*,*) 'GRIB headers differ:'
            LDIFF = .FALSE.
          ENDIF
          WRITE(*,*) 'ISEC4(',LOOP,') : ', ISEC4(LOOP), JSEC4(LOOP)
        ENDIF
      ENDDO
C
      DO LOOP = 1, 1024
        IF( ZSEC2(LOOP).NE.WSEC2(LOOP) ) THEN
          IF( LDIFF ) THEN
            WRITE(*,*) 'GRIB headers differ:'
            LDIFF = .FALSE.
          ENDIF
          WRITE(*,*) 'ZSEC2(',LOOP,') : ', ZSEC2(LOOP), WSEC2(LOOP)
        ENDIF
      ENDDO
C
C     -----------------------------------------------------------------|
C     Compare the arrays
C     -----------------------------------------------------------------|
C
C     Initialize the max/min values for the field
C
      DO LOOP = 1, NVALS1
        V1 = ARRAY1(LOOP)
        IF( NOTEQ(V1,MISSING) ) THEN
          MAXVAL1 = V1
          MINVAL1 = V1
          GOTO 10
        ENDIF
      ENDDO
   10 CONTINUE
C
      DO LOOP = 1, NVALS2
        V2 = ARRAY2(LOOP)
        IF( NOTEQ(V2,MISSING) ) THEN
          MAXVAL2 = V2
          MINVAL2 = V2
          GOTO 20
        ENDIF
      ENDDO
   20 CONTINUE
C
      MAXDIFF= 0.0
      MAXPERC= 0.0
      MAXDV1  = MAXVAL1
      MAXDV2  = MAXVAL2
C
Cjdc  DO LOOP = 1, ISEC4(1)
      DO LOOP = 1, MIN(NVALS1,NVALS2)
        V1 = ARRAY1(LOOP)
        V2 = ARRAY2(LOOP)
        IF( (NOTEQ(V1,MISSING)).AND.(NOTEQ(V2,MISSING)) ) THEN
          IF( MAXVAL1.LT.(V1) ) MAXVAL1 = (V1)
          IF( MAXVAL2.LT.(V2) ) MAXVAL2 = (V2)
          IF( MINVAL1.GT.(V1) ) MINVAL1 = (V1)
          IF( MINVAL2.GT.(V2) ) MINVAL2 = (V2)
          DIFF = ABS((V1-V2))
          IF( MAXDIFF.LT.DIFF ) THEN
            MAXDIFF = DIFF
            MAXDV1 = V1
            MAXDV2 = V2
            IF( V2.NE.0.0 ) THEN
              IF( ABS(V2).LT.ABS(V1) ) THEN
                MAXPERC = (MAXDIFF*100.0)/ABS(V2)
              ELSE IF( V1.NE.0 ) THEN
                MAXPERC = (MAXDIFF*100.0)/ABS(V1)
              ELSE
                MAXPERC = (MAXDIFF*100.0)/ABS(V2)
              ENDIF
            ELSE
              MAXPERC = (MAXDIFF*100.0)/ABS(V1)
            ENDIF
          ENDIF
        ENDIF
      ENDDO
C
C     Margin allowed is percentage of range (max-min) given by tolerance
C
      MARGIN = ABS((MAXVAL1 - MINVAL1)*TOLERNC*0.01)
C
      LPRINT = ILEVEL.GT.0
      IF( MAXDIFF.GT.MARGIN ) THEN
        LPRINT = .TRUE.
        LFAIL = .TRUE.
        NFAILS = NFAILS + 1
        IF( NFAIL1.EQ.0 ) NFAIL1 = ICOUNT
Cjdc    IF( ILEVEL.LT.1 ) ILEVEL = 1
      ENDIF
C
Cjdc  IF( ILEVEL.GT.0 ) THEN
      IF( LPRINT ) THEN
        WRITE(*,*) ' '
        WRITE(*,*) 'GRIB products ', NEXT1, ' : ', NEXT2
        WRITE(*,*) 'Number of data points = ', ISEC4(1)
        WRITE(*,*) 'Parameter  = ', isec1(6)
        WRITE(*,*) 'Level (P1) = ', isec1(8)
        WRITE(*,*) 'Level (P2) = ', isec1(9)
        WRITE(*,*) ' '
        WRITE(*,*) 'MAXVAL1 = ', MAXVAL1
        WRITE(*,*) 'MAXVAL2 = ', MAXVAL2
        WRITE(*,*) ' '
        WRITE(*,*) 'MINVAL1 = ', MINVAL1
        WRITE(*,*) 'MINVAL2 = ', MINVAL2
        WRITE(*,*) ' '
        WRITE(*,*) 'MAXDIFF = ', MAXDIFF, ' (',MAXPERC,' %)'
        IF( MAXDIFF.GT.0.0 )
     X    WRITE(*,*) 'At MAXDIFF: V1 = ', MAXDV1, ', V2 = ', MAXDV2
        WRITE(*,*) ' '
      ENDIF
C
      N = 0
      AVERAGE1 = 0.0
      AVERAGE2 = 0.0
C
      DO LOOP = 1, ISEC4(1)
        V1 = ARRAY1(LOOP)
        V2 = ARRAY2(LOOP)
        IF( (NOTEQ(V1,MISSING)).AND.(NOTEQ(V2,MISSING)) ) THEN
          AVERAGE1 = AVERAGE1 + V1
          AVERAGE2 = AVERAGE2 + V2
          N = N + 1
          DIFF = ABS(V1-V2)
          IF( DIFF .GT. MARGIN ) THEN
            LFAIL = .TRUE.
            IF( ILEVEL.GT.1 ) WRITE(*,*) LOOP, V1, V2, DIFF, (V1/V2)
          ENDIF
        ELSE
          IF( ILEVEL.GT.1 ) THEN
            IF( .NOT.NOTEQ(V1,MISSING) ) THEN
              IF( .NOT.NOTEQ(V2,MISSING) ) THEN
Cjdc            WRITE(*,*) LOOP,'    *** MISSING ***    *** MISSING ***'
              ELSE
                WRITE(*,*) LOOP,'    *** MISSING *** ', V2
              ENDIF
            ELSE
              WRITE(*,*) LOOP, V1,'    *** MISSING ***'
            ENDIF
          ENDIF
        ENDIF
      ENDDO
C
      AVERAGE1 = AVERAGE1 / N
      AVERAGE2 = AVERAGE2 / N
C
      IF( ILEVEL.GT.0 ) THEN
        WRITE(*,*) 'Average of field 1 = ', AVERAGE1
        WRITE(*,*) 'Average of field 2 = ', AVERAGE2
        WRITE(*,*) ' '
      ENDIF
C
  800 CONTINUE
C
      IF( LFAIL.AND.LFAIL1 ) THEN
        ISTATUS = 1
        GOTO 990
      ELSE
        IF( NEXT1.LT.ITOTAL1 ) GOTO 50
      ENDIF
C
C     -----------------------------------------------------------------|
C     Closedown
C     -----------------------------------------------------------------|
  900 CONTINUE
C
      IF( ILEVEL.GT.0 ) THEN
        WRITE(*,*) 'Total number of GRIB products = ', ICOUNT
        WRITE(*,*) ' '
      ENDIF
C
      ISTATUS = 0
C
      IF( NFAILS.GT.0 ) THEN
        WRITE(*,*) 'Total number of mismatched GRIBs = ', NFAILS
        WRITE(*,*) 'First fail in GRIB number ', NFAIL1
        WRITE(*,*) ' '
        ISTATUS = 1
        GOTO 990
      ENDIF
C
  990 CONTINUE
#ifdef FUJITSU
      CALL SETRCD(ISTATUS)
#else
      CALL JDCEXIT(ISTATUS)
#endif
C
      STOP
      END
