      SUBROUTINE REDUCE(KFILDO,JMIN,JMAX,LBIT,NOV,LX,NDG,IBIT,JBIT,KBIT,
     1                  NOVREF,IBXX2,IER)            
C
C        NOVEMBER 2001   GLAHN   TDL   GRIB2
C        MARCH    2002   GLAHN   COMMENT IER = 715
C        MARCH    2002   GLAHN   MODIFIED TO ACCOMMODATE LX=1 ON ENTRY
C
C        PURPOSE
C            DETERMINES WHETHER THE NUMBER OF GROUPS SHOULD BE
C            INCREASED IN ORDER TO REDUCE THE SIZE OF THE LARGE
C            GROUPS, AND TO MAKE THAT ADJUSTMENT.  BY REDUCING THE
C            SIZE OF THE LARGE GROUPS, LESS BITS MAY BE NECESSARY
C            FOR PACKING THE GROUP SIZES AND ALL THE INFORMATION
C            ABOUT THE GROUPS.
C
C            THE REFERENCE FOR NOV( ) WAS REMOVED IN THE CALLING
C            ROUTINE SO THAT KBIT COULD BE DETERMINED.  THIS
C            FURNISHES A STARTING POINT FOR THE ITERATIONS IN REDUCE.
C            HOWEVER, THE REFERENCE MUST BE CONSIDERED.
C
C        DATA SET USE 
C           KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) 
C
C        VARIABLES IN CALL SEQUENCE 
C              KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE.  (INPUT)
C             JMIN(J) = THE MINIMUM OF EACH GROUP (J=1,LX).  IT IS
C                       POSSIBLE AFTER SPLITTING THE GROUPS, JMIN( )
C                       WILL NOT BE THE MINIMUM OF THE NEW GROUP.
C                       THIS DOESN'T MATTER; JMIN( ) IS REALLY THE
C                       GROUP REFERENCE AND DOESN'T HAVE TO BE THE
C                       SMALLEST VALUE.  (INPUT/OUTPUT)
C             JMAX(J) = THE MAXIMUM OF EACH GROUP (J=1,LX). 
C                       (INPUT/OUTPUT)
C             LBIT(J) = THE NUMBER OF BITS NECESSARY TO PACK EACH GROUP
C                       (J=1,LX).  (INPUT/OUTPUT)
C              NOV(J) = THE NUMBER OF VALUES IN EACH GROUP (J=1,LX).
C                       (INPUT/OUTPUT)
C                  LX = THE NUMBER OF GROUPS.  THIS WILL BE INCREASED
C                       IF GROUPS ARE SPLIT.  (INPUT/OUTPUT)
C                 NDG = THE DIMENSION OF JMIN( ), JMAX( ), LBIT( ), AND
C                       NOV( ).  (INPUT)
C                IBIT = THE NUMBER OF BITS NECESSARY TO PACK THE JMIN(J)
C                       VALUES, J=1,LX.  (INPUT)
C                JBIT = THE NUMBER OF BITS NECESSARY TO PACK THE LBIT(J)
C                       VALUES, J=1,LX.  (INPUT)
C                KBIT = THE NUMBER OF BITS NECESSARY TO PACK THE NOV(J)
C                       VALUES, J=1,LX.  IF THE GROUPS ARE SPLIT, KBIT
C                       IS REDUCED.  (INPUT/OUTPUT)
C              NOVREF = REFERENCE VALUE FOR NOV( ).  (INPUT)
C            IBXX2(J) = 2**J (J=0,30).  (INPUT)
C                 IER = ERROR RETURN.  (OUTPUT)
C                         0 = GOOD RETURN.
C                       714 = PROBLEM IN ALGORITHM.  REDUCE ABORTED.
C                       715 = NGP NOT LARGE ENOUGH.  REDUCE ABORTED.
C           NTOTBT(J) = THE TOTAL BITS USED FOR THE PACKING BITS J
C                       (J=1,30).  (INTERNAL)
C            NBOXJ(J) = NEW BOXES NEEDED FOR THE PACKING BITS J
C                       (J=1,30).  (INTERNAL)
C           NEWBOX(L) = NUMBER OF NEW BOXES (GROUPS) FOR EACH ORIGINAL
C                       GROUP (L=1,LX) FOR THE CURRENT J.  (AUTOMATIC)
C                       (INTERNAL)
C          NEWBOXP(L) = SAME AS NEWBOX( ) BUT FOR THE PREVIOUS J.
C                       THIS ELIMINATES RECOMPUTATION.  (AUTOMATIC)
C                       (INTERNAL)
C               CFEED = CONTAINS THE CHARACTER REPRESENTATION
C                       OF A PRINTER FORM FEED.  (CHARACTER) (INTERNAL)
C               IFEED = CONTAINS THE INTEGER VALUE OF A PRINTER
C                       FORM FEED.  (INTERNAL)
C              IORIGB = THE ORIGINAL NUMBER OF BITS NECESSARY
C                       FOR THE GROUP VALUES.  (INTERNAL)
C        1         2         3         4         5         6         7 X
C
C        NON SYSTEM SUBROUTINES CALLED 
C           NONE
c
      CHARACTER*1 CFEED
C
      DIMENSION JMIN(NDG),JMAX(NDG),LBIT(NDG),NOV(NDG)
      DIMENSION NEWBOX(NDG),NEWBOXP(NDG)
C        NEWBOX( ) AND NEWBOXP( ) ARE AUTOMATIC ARRAYS.
      DIMENSION NTOTBT(31),NBOXJ(31)
      DIMENSION IBXX2(0:30)
C
      DATA IFEED/12/
C
      IER=0
      IF(LX.EQ.1)GO TO 410
C        IF THERE IS ONLY ONE GROUP, RETURN.
C
      CFEED=CHAR(IFEED)
C
C        INITIALIZE NUMBER OF NEW BOXES PER GROUP TO ZERO.
C
      DO 110 L=1,LX
         NEWBOX(L)=0
 110  CONTINUE
C
C        INITIALIZE NUMBER OF TOTAL NEW BOXES PER J TO ZERO.
C
      DO 112 J=1,31
         NTOTBT(J)=999999999
         NBOXJ(J)=0
 112  CONTINUE
C
      IORIGB=(IBIT+JBIT+KBIT)*LX
C        IBIT = BITS TO PACK THE JMIN( ).
C        JBIT = BITS TO PACK THE LBIT( ).
C        KBIT = BITS TO PACK THE NOV( ).
C        LX = NUMBER OF GROUPS.
         NTOTBT(KBIT)=IORIGB
C           THIS IS THE VALUE OF TOTAL BITS FOR THE ORIGINAL LX
C           GROUPS, WHICH REQUIRES KBITS TO PACK THE GROUP
C           LENGHTS.  SETTING THIS HERE MAKES ONE LESS LOOPS
C           NECESSARY BELOW.
C
C        COMPUTE BITS NOW USED FOR THE PARAMETERS DEFINED.
C
C        DETERMINE OTHER POSSIBILITES BY INCREASING LX AND DECREASING
C        NOV( ) WITH VALUES GREATER THAN THRESHOLDS.  ASSUME A GROUP IS
C        SPLIT INTO 2 OR MORE GROUPS SO THAT KBIT IS REDUCED WITHOUT
C        CHANGING IBIT OR JBIT.
C
      JJ=0
C
      DO 200 J=MIN(30,KBIT-1),2,-1
C           VALUES GE KBIT WILL NOT REQUIRE SPLITS.  ONCE THE TOTAL
C           BITS START INCREASING WITH DECREASING J, STOP.  ALSO, THE
C           NUMBER OF BITS REQUIRED IS KNOWN FOR KBITS = NTOTBT(KBIT).
C
         NEWBOXT=0
C
         DO 190 L=1,LX
C
            IF(NOV(L).LT.IBXX2(J))THEN
               NEWBOX(L)=0
C                 NO SPLITS OR NEW BOXES.
               GO TO 190
            ELSE
               NOVL=NOV(L)
C
               M=(NOV(L)-1)/(IBXX2(J)-1)+1
C                 M IS FOUND BY SOLVING THE EQUATION BELOW FOR M:
C                 (NOV(L)+M-1)/M LT IBXX2(J)
C                 M GT (NOV(L)-1)/(IBXX2(J)-1)
C                 SET M = (NOV(L)-1)/(IBXX2(J)-1)+1
 130           NOVL=(NOV(L)+M-1)/M
C                 THE +M-1 IS NECESSARY.  FOR INSTANCE, 15 WILL FIT
C                 INTO A BOX 4 BITS WIDE, BUT WON'T DIVIDE INTO
C                 TWO BOXES 3 BITS WIDE EACH.
C      
               IF(NOVL.LT.IBXX2(J))THEN
                  GO TO 185
               ELSE
                  M=M+1
C***                  WRITE(KFILDO,135)L,NOV(L),NOVL,M,J,IBXX2(J)
C*** 135              FORMAT(/' AT 135--L,NOV(L),NOVL,M,J,IBXX2(J)',6I10)               
                  GO TO 130
               ENDIF
C
C                 THE ABOVE DO LOOP WILL NEVER COMPLETE.
            ENDIF
C
 185        NEWBOX(L)=M-1
            NEWBOXT=NEWBOXT+M-1
 190     CONTINUE
C
         NBOXJ(J)=NEWBOXT
         NTOTPR=NTOTBT(J+1)
         NTOTBT(J)=(IBIT+JBIT)*(LX+NEWBOXT)+J*(LX+NEWBOXT)
C
         IF(NTOTBT(J).GE.NTOTPR)THEN
            JJ=J+1
C              THE PLUS IS USED BECAUSE J DECREASES PER ITERATION.
            GO TO 250
         ELSE
C
C              SAVE THE TOTAL NEW BOXES AND NEWBOX( ) IN CASE THIS
C              IS THE J TO USE.
C
            NEWBOXTP=NEWBOXT
C
            DO 195 L=1,LX
               NEWBOXP(L)=NEWBOX(L)
 195        CONTINUE
C
C           WRITE(KFILDO,197)NEWBOXT,IBXX2(J)
C197        FORMAT(/' *****************************************'
C    1             /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL',
C    2              I10,' FOR GROUP MAXSIZE PLUS 1 ='I10
C    3             /' *****************************************')
C           WRITE(KFILDO,198) (NEWBOX(L),L=1,LX)
C198        FORMAT(/' '20I6/(' '20I6))
    
         ENDIF
C        
C205     WRITE(KFILDO,209)KBIT,IORIGB
C209     FORMAT(/' ORIGINAL BITS WITH KBIT OF',I5,' =',I10)
C        WRITE(KFILDO,210)(N,N=2,10),(IBXX2(N),N=2,10),
C    1                    (NTOTBT(N),N=2,10),(NBOXJ(N),N=2,10),
C    2                    (N,N=11,20),(IBXX2(N),N=11,20),
C    3                    (NTOTBT(N),N=11,20),(NBOXJ(N),N=11,20),
C    4                    (N,N=21,30),(IBXX2(N),N=11,20),
C    5                    (NTOTBT(N),N=21,30),(NBOXJ(N),N=21,30)
C210     FORMAT(/' THE TOTAL BYTES FOR MAXIMUM GROUP LENGTHS BY ROW'//
C    1      '   J         = THE NUMBER OF BITS PER GROUP LENGTH'/
C    2      '   IBXX2(J)  = THE MAXIMUM GROUP LENGTH PLUS 1 FOR THIS J'/
C    3      '   NTOTBT(J) = THE TOTAL BITS FOR THIS J'/
C    4      '   NBOXJ(J)  = THE NEW GROUPS FOR THIS J'/
C    5      4(/10X,9I10)/4(/10I10)/4(/10I10))
C
 200  CONTINUE
C
 250  PIMP=((IORIGB-NTOTBT(JJ))/FLOAT(IORIGB))*100.
C     WRITE(KFILDO,252)PIMP,KBIT,JJ
C252  FORMAT(/' PERCENT IMPROVEMENT =',F6.1,
C    1        ' BY DECREASING GROUP LENGTHS FROM',I4,' TO',I4,' BITS')
      IF(PIMP.GE.2.)THEN
C
C        WRITE(KFILDO,255)CFEED,NEWBOXTP,IBXX2(JJ)
C255     FORMAT(A1,/' *****************************************'
C    1             /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL',
C    2             I10,' FOR GROUP MAXSIZE PLUS 1 ='I10
C    2             /' *****************************************')
C        WRITE(KFILDO,256) (NEWBOXP(L),L=1,LX)
C256     FORMAT(/' '20I6)
C
C           ADJUST GROUP LENGTHS FOR MAXIMUM LENGTH OF JJ BITS.
C           THE MIN PER GROUP AND THE NUMBER OF BITS REQUIRED
C           PER GROUP ARE NOT CHANGED.  THIS MAY MEAN THAT A
C           GROUP HAS A MIN (OR REFERENCE) THAT IS NOT ZERO.
C           THIS SHOULD NOT MATTER TO THE UNPACKER.
C
         LXNKP=LX+NEWBOXTP
C           LXNKP = THE NEW NUMBER OF BOXES
C  
         IF(LXNKP.GT.NDG)THEN
C              DIMENSIONS NOT LARGE ENOUGH.  PROBABLY AN ERROR
C              OF SOME SORT.  ABORT.
C           WRITE(KFILDO,257)NDG,LXNPK
C        1         2         3         4         5         6         7 X
C257        FORMAT(/' DIMENSIONS OF JMIN, ETC. IN REDUCE =',I8,
C    1              ' NOT LARGE ENOUGH FOR THE EXPANDED NUMBER OF',
C    2              ' GROUPS =',I8,'.  ABORT REDUCE.')
            IER=715
            GO TO 410
C              AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE 
C              WITHOUT CALLING REDUCE.
         ENDIF
C
         LXN=LXNKP
C           LXN IS THE NUMBER OF THE BOX IN THE NEW SERIES BEING
C           FILLED.  IT DECREASES PER ITERATION.
         IBXX2M1=IBXX2(JJ)-1
C           IBXX2M1 IS THE MAXIMUM NUMBER OF VALUES PER GROUP.
C
         DO 300 L=LX,1,-1
C
C              THE VALUES IS NOV( ) REPRESENT THOSE VALUES + NOVREF.
C              WHEN VALUES ARE MOVED TO ANOTHER BOX, EACH VALUE
C              MOVED TO A NEW BOX REPRESENTS THAT VALUE + NOVREF.
C              THIS HAS TO BE CONSIDERED IN MOVING VALUES.
C
            IF(NEWBOXP(L)*(IBXX2M1+NOVREF)+NOVREF.GT.NOV(L)+NOVREF)THEN
C                 IF THE ABOVE TEST IS MET, THEN MOVING IBXX2M1 VALUES
C                 FOR ALL NEW BOXES WILL LEAVE A NEGATIVE NUMBER FOR
C                 THE LAST BOX.  NOT A TOLERABLE SITUATION.
               MOVMIN=(NOV(L)-(NEWBOXP(L))*NOVREF)/NEWBOXP(L)
               LEFT=NOV(L)
C                 LEFT = THE NUMBER OF VALUES TO MOVE FROM THE ORIGINAL
C                 BOX TO EACH NEW BOX EXCEPT THE LAST.  LEFT IS THE
C                 NUMBER LEFT TO MOVE.
            ELSE
               MOVMIN=IBXX2M1
C                 MOVMIN VALUES CAN BE MOVED FOR EACH NEW BOX.
               LEFT=NOV(L)
C                 LEFT IS THE NUMBER OF VALUES LEFT TO MOVE.
            ENDIF
C
            IF(NEWBOXP(L).GT.0)THEN
               IF((MOVMIN+NOVREF)*NEWBOXP(L)+NOVREF.LE.NOV(L)+NOVREF.
     1          AND.(MOVMIN+NOVREF)*(NEWBOXP(L)+1).GE.NOV(L)+NOVREF)THEN
                  GO TO 288
               ELSE
C***D                 WRITE(KFILDO,287)L,MOVMIN,NOVREF,NEWBOXP(L),NOV(L)
C***D287              FORMAT(/' AT 287 IN REDUCE--L,MOVMIN,NOVREF,',
C***D    1                    'NEWBOXP(L),NOV(L)',5I12
C***D    2                    ' REDUCE ABORTED.')
C              WRITE(KFILDO,2870)
C2870          FORMAT(/' AN ERROR IN REDUCE ALGORITHM.  ABORT REDUCE.')
               IER=714
               GO TO 410
C                 AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE 
C                 WITHOUT CALLING REDUCE.
               ENDIF
C
            ENDIF
C
 288        DO 290 J=1,NEWBOXP(L)+1
               MOVE=MIN(MOVMIN,LEFT)
               JMIN(LXN)=JMIN(L)
               JMAX(LXN)=JMAX(L)
               LBIT(LXN)=LBIT(L)
               NOV(LXN)=MOVE
               LXN=LXN-1
               LEFT=LEFT-(MOVE+NOVREF)
C                 THE MOVE OF MOVE VALUES REALLY REPRESENTS A MOVE OF
C                 MOVE + NOVREF VALUES.
 290        CONTINUE
C
            IF(LEFT.NE.-NOVREF)THEN
C***               WRITE(KFILDO,292)L,LXN,MOVE,LXNKP,IBXX2(JJ),LEFT,NOV(L),
C***     1                          MOVMIN
C*** 292           FORMAT(' AT 292 IN REDUCE--L,LXN,MOVE,LXNKP,',
C***     1                'IBXX2(JJ),LEFT,NOV(L),MOVMIN'/8I12)
            ENDIF
C     
 300     CONTINUE
C
         LX=LXNKP
C           LX IS NOW THE NEW NUMBER OF GROUPS.
         KBIT=JJ
C           KBIT IS NOW THE NEW NUMBER OF BITS REQUIRED FOR PACKING
C           GROUP LENGHTS.
      ENDIF
C
C     WRITE(KFILDO,406)CFEED,LX
C406  FORMAT(A1,/' *****************************************'
C    1          /' THE GROUP SIZES NOV( ) AFTER REDUCTION IN SIZE',
C    2           ' FOR'I10,' GROUPS',
C    3          /' *****************************************')
C     WRITE(KFILDO,407) (NOV(J),J=1,LX)
C407  FORMAT(/' '20I6)
C     WRITE(KFILDO,408)CFEED,LX
C408  FORMAT(A1,/' *****************************************'
C    1          /' THE GROUP MINIMA JMIN( ) AFTER REDUCTION IN SIZE',
C    2           ' FOR'I10,' GROUPS',
C    3          /' *****************************************')
C     WRITE(KFILDO,409) (JMIN(J),J=1,LX)
C409  FORMAT(/' '20I6)
C
 410  RETURN
      END
      
