Created a tag for the 2012 HWRF baseline tests.

[WPS-merge.git] / hwrf-baseline-20120103-1354 / ungrib / src / ngl / g2 / pack_gp.f

      SUBROUTINE PACK_GP(KFILDO,IC,NXY,IS523,MINPK,INC,MISSP,MISSS,
     1                   JMIN,JMAX,LBIT,NOV,NDG,LX,IBIT,JBIT,KBIT,
     2                   NOVREF,LBITREF,IER)            
C
C        FEBRUARY 1994   GLAHN   TDL   MOS-2000
C        JUNE     1995   GLAHN   MODIFIED FOR LMISS ERROR.
C        JULY     1996   GLAHN   ADDED MISSS
C        FEBRUARY 1997   GLAHN   REMOVED 4 REDUNDANT TESTS FOR
C                                MISSP.EQ.0; INSERTED A TEST TO BETTER
C                                HANDLE A STRING OF 9999'S
C        FEBRUARY 1997   GLAHN   ADDED LOOPS TO ELIMINATE TEST FOR 
C                                MISSS WHEN MISSS = 0
C        MARCH    1997   GLAHN   CORRECTED FOR SECONDARY MISSING VALUE
C        MARCH    1997   GLAHN   CORRECTED FOR USE OF LOCAL VALUE
C                                OF MINPK
C        MARCH    1997   GLAHN   CORRECTED FOR SECONDARY MISSING VALUE
C        MARCH    1997   GLAHN   CHANGED CALCULATING NUMBER OF BITS 
C                                THROUGH EXPONENTS TO AN ARRAY (IMPROVED
C                                OVERALL PACKING PERFORMANCE BY ABOUT
C                                35 PERCENT!).  ALLOWED 0 BITS FOR
C                                PACKING JMIN( ), LBIT( ), AND NOV( ).
C        MAY      1997   GLAHN   A NUMBER OF CHANGES FOR EFFICIENCY.
C                                MOD FUNCTIONS ELIMINATED AND ONE
C                                IFTHEN ADDED.  JOUNT REMOVED.
C                                RECOMPUTATION OF BITS NOT MADE UNLESS
C                                NECESSARY AFTER MOVING POINTS FROM
C                                ONE GROUP TO ANOTHER.  NENDB ADJUSTED
C                                TO ELIMINATE POSSIBILITY OF VERY
C                                SMALL GROUP AT THE END. 
C                                ABOUT 8 PERCENT IMPROVEMENT IN
C                                OVERALL PACKING.  ISKIPA REMOVED;
C                                THERE IS ALWAYS A GROUP B THAT CAN
C                                BECOME GROUP A.  CONTROL ON SIZE 
C                                OF GROUP B (STATEMENT BELOW 150)
C                                ADDED.  ADDED ADDA, AND USE
C                                OF GE AND LE INSTEAD OF GT AND LT
C                                IN LOOPS BETWEEN 150 AND 160.
C                                IBITBS ADDED TO SHORTEN TRIPS 
C                                THROUGH LOOP.
C        MARCH    2000   GLAHN   MODIFIED FOR GRIB2; CHANGED NAME FROM 
C                                PACKGP
C        JANUARY  2001   GLAHN   COMMENTS; IER = 706 SUBSTITUTED FOR
C                                STOPS; ADDED RETURN1; REMOVED STATEMENT
C                                NUMBER 110; ADDED IER AND * RETURN
C        NOVEMBER 2001   GLAHN   CHANGED SOME DIAGNOSTIC FORMATS TO 
C                                ALLOW PRINTING LARGER NUMBERS
C        NOVEMBER 2001   GLAHN   ADDED MISSLX( ) TO PUT MAXIMUM VALUE
C                                INTO JMIN( ) WHEN ALL VALUES MISSING
C                                TO AGREE WITH GRIB STANDARD.
C        NOVEMBER 2001   GLAHN   CHANGED TWO TESTS ON MISSP AND MISSS
C                                EQ 0 TO TESTS ON IS523.  HOWEVER,
C                                MISSP AND MISSS CANNOT IN GENERAL BE
C                                = 0.
C        NOVEMBER 2001   GLAHN   ADDED CALL TO REDUCE; DEFINED ITEST
C                                BEFORE LOOPS TO REDUCE COMPUTATION;
C                                STARTED LARGE GROUP WHEN ALL SAME
C                                VALUE
C        DECEMBER 2001   GLAHN   MODIFIED AND ADDED A FEW COMMENTS
C        JANUARY  2002   GLAHN   REMOVED LOOP BEFORE 150 TO DETERMINE
C                                A GROUP OF ALL SAME VALUE
C        JANUARY  2002   GLAHN   CHANGED MALLOW FROM 9999999 TO 2**30+1,
C                                AND MADE IT A PARAMETER
C        MARCH    2002   GLAHN   ADDED NON FATAL IER = 716, 717;
C                                REMOVED NENDB=NXY ABOVE 150;
C                                ADDED IERSAV=0; COMMENTS
C
C        PURPOSE
C            DETERMINES GROUPS OF VARIABLE SIZE, BUT AT LEAST OF
C            SIZE MINPK, THE ASSOCIATED MAX (JMAX( )) AND MIN (JMIN( )),
C            THE NUMBER OF BITS NECESSARY TO HOLD THE VALUES IN EACH
C            GROUP (LBIT( )), THE NUMBER OF VALUES IN EACH GROUP
C            (NOV( )), THE NUMBER OF BITS NECESSARY TO PACK THE JMIN( )
C            VALUES (IBIT), THE NUMBER OF BITS NECESSARY TO PACK THE
C            LBIT( ) VALUES (JBIT), AND THE NUMBER OF BITS NECESSARY
C            TO PACK THE NOV( ) VALUES (KBIT).  THE ROUTINE IS DESIGNED
C            TO DETERMINE THE GROUPS SUCH THAT A SMALL NUMBER OF BITS
C            IS NECESSARY TO PACK THE DATA WITHOUT EXCESSIVE
C            COMPUTATIONS.  IF ALL VALUES IN THE GROUP ARE ZERO, THE
C            NUMBER OF BITS TO USE IN PACKING IS DEFINED AS ZERO WHEN
C            THERE CAN BE NO MISSING VALUES; WHEN THERE CAN BE MISSING
C            VALUES, THE NUMBER OF BITS MUST BE AT LEAST 1 TO HAVE
C            THE CAPABILITY TO RECOGNIZE THE MISSING VALUE.  HOWEVER,
C            IF ALL VALUES IN A GROUP ARE MISSING, THE NUMBER OF BITS
C            NEEDED IS 0, AND THE UNPACKER RECOGNIZES THIS.
C            ALL VARIABLES ARE INTEGER.  EVEN THOUGH THE GROUPS ARE 
C            INITIALLY OF SIZE MINPK OR LARGER, AN ADJUSTMENT BETWEEN
C            TWO GROUPS (THE LOOKBACK PROCEDURE) MAY MAKE A GROUP 
C            SMALLER THAN MINPK.  THE CONTROL ON GROUP SIZE IS THAT
C            THE SUM OF THE SIZES OF THE TWO CONSECUTIVE GROUPS, EACH OF
C            SIZE MINPK OR LARGER, IS NOT DECREASED.  WHEN DETERMINING
C            THE NUMBER OF BITS NECESSARY FOR PACKING, THE LARGEST
C            VALUE THAT CAN BE ACCOMMODATED IN, SAY, MBITS, IS
C            2**MBITS-1; THIS LARGEST VALUE (AND THE NEXT SMALLEST
C            VALUE) IS RESERVED FOR THE MISSING VALUE INDICATOR (ONLY)
C            WHEN IS523 NE 0.  IF THE DIMENSION NDG
C            IS NOT LARGE ENOUGH TO HOLD ALL THE GROUPS, THE LOCAL VALUE
C            OF MINPK IS INCREASED BY 50 PERCENT.  THIS IS REPEATED
C            UNTIL NDG WILL SUFFICE.  A DIAGNOSTIC IS PRINTED WHENEVER
C            THIS HAPPENS, WHICH SHOULD BE VERY RARELY.  IF IT HAPPENS
C            OFTEN, NDG IN SUBROUTINE PACK SHOULD BE INCREASED AND
C            A CORRESPONDING INCREASE IN SUBROUTINE UNPACK MADE. 
C            CONSIDERABLE CODE IS PROVIDED SO THAT NO MORE CHECKING
C            FOR MISSING VALUES WITHIN LOOPS IS DONE THAN NECESSARY;
C            THE ADDED EFFICIENCY OF THIS IS RELATIVELY MINOR,
C            BUT DOES NO HARM.  FOR GRIB2, THE REFERENCE VALUE FOR
C            THE LENGTH OF GROUPS IN NOV( ) AND FOR THE NUMBER OF
C            BITS NECESSARY TO PACK GROUP VALUES ARE DETERMINED,
C            AND SUBTRACTED BEFORE JBIT AND KBIT ARE DETERMINED.
C
C            WHEN 1 OR MORE GROUPS ARE LARGE COMPARED TO THE OTHERS,
C            THE WIDTH OF ALL GROUPS MUST BE AS LARGE AS THE LARGEST.
C            A SUBROUTINE REDUCE BREAKS UP LARGE GROUPS INTO 2 OR
C            MORE TO REDUCE TOTAL BITS REQUIRED.  IF REDUCE SHOULD
C            ABORT, PACK_GP WILL BE EXECUTED AGAIN WITHOUT THE CALL
C            TO REDUCE.
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               IC( ) = ARRAY TO HOLD DATA FOR PACKING.  THE VALUES
C                       DO NOT HAVE TO BE POSITIVE AT THIS POINT, BUT
C                       MUST BE IN THE RANGE -2**30 TO +2**30 (THE 
C                       THE VALUE OF MALLOW).  THESE INTEGER VALUES
C                       WILL BE RETAINED EXACTLY THROUGH PACKING AND
C                       UNPACKING.  (INPUT)
C                 NXY = NUMBER OF VALUES IN IC( ).  ALSO TREATED
C                       AS ITS DIMENSION.  (INPUT)
C              IS523  = missing value management
C                       0=data contains no missing values
C                       1=data contains Primary missing values
C                       2=data contains Primary and secondary missing values
C                       (INPUT)
C               MINPK = THE MINIMUM SIZE OF EACH GROUP, EXCEPT POSSIBLY
C                       THE LAST ONE.  (INPUT)
C                 INC = THE NUMBER OF VALUES TO ADD TO AN ALREADY
C                       EXISTING GROUP IN DETERMINING WHETHER OR NOT
C                       TO START A NEW GROUP.  IDEALLY, THIS WOULD BE
C                       1, BUT EACH TIME INC VALUES ARE ATTEMPTED, THE
C                       MAX AND MIN OF THE NEXT MINPK VALUES MUST BE
C                       FOUND.  THIS IS "A LOOP WITHIN A LOOP," AND
C                       A SLIGHTLY LARGER VALUE MAY GIVE ABOUT AS GOOD
C                       RESULTS WITH SLIGHTLY LESS COMPUTATIONAL TIME.
C                       IF INC IS LE 0, 1 IS USED, AND A DIAGNOSTIC IS
C                       OUTPUT.  NOTE:  IT IS EXPECTED THAT INC WILL
C                       EQUAL 1.  THE CODE USES INC PRIMARILY IN THE
C                       LOOPS STARTING AT STATEMENT 180.  IF INC
C                       WERE 1, THERE WOULD NOT NEED TO BE LOOPS
C                       AS SUCH.  HOWEVER, KINC (THE LOCAL VALUE OF
C                       INC) IS SET GE 1 WHEN NEAR THE END OF THE DATA
C                       TO FORESTALL A VERY SMALL GROUP AT THE END. 
C                       (INPUT)
C               MISSP = WHEN MISSING POINTS CAN BE PRESENT IN THE DATA,
C                       THEY WILL HAVE THE VALUE MISSP OR MISSS.
C                       MISSP IS THE PRIMARY MISSING VALUE AND  MISSS
C                       IS THE SECONDARY MISSING VALUE .  THESE MUST
C                       NOT BE VALUES THAT WOULD OCCUR WITH SUBTRACTING
C                       THE MINIMUM (REFERENCE) VALUE OR SCALING.
C                       FOR EXAMPLE, MISSP = 0 WOULD NOT BE ADVISABLE.
C                       (INPUT)
C               MISSS = SECONDARY MISSING VALUE INDICATOR (SEE MISSP).
C                       (INPUT)
C             JMIN(J) = THE MINIMUM OF EACH GROUP (J=1,LX).  (OUTPUT)
C             JMAX(J) = THE MAXIMUM OF EACH GROUP (J=1,LX).  THIS IS
C                       NOT REALLY NEEDED, BUT SINCE THE MAX OF EACH
C                       GROUP MUST BE FOUND, SAVING IT HERE IS CHEAP
C                       IN CASE THE USER WANTS IT.  (OUTPUT)
C             LBIT(J) = THE NUMBER OF BITS NECESSARY TO PACK EACH GROUP
C                       (J=1,LX).  IT IS ASSUMED THE MINIMUM OF EACH
C                       GROUP WILL BE REMOVED BEFORE PACKING, AND THE
C                       VALUES TO PACK WILL, THEREFORE, ALL BE POSITIVE.
C                       HOWEVER, IC( ) DOES NOT NECESSARILY CONTAIN
C                       ALL POSITIVE VALUES.  IF THE OVERALL MINIMUM
C                       HAS BEEN REMOVED (THE USUAL CASE), THEN IC( )
C                       WILL CONTAIN ONLY POSITIVE VALUES.  (OUTPUT)
C              NOV(J) = THE NUMBER OF VALUES IN EACH GROUP (J=1,LX).
C                       (OUTPUT)
C                 NDG = THE DIMENSION OF JMIN( ), JMAX( ), LBIT( ), AND
C                       NOV( ).  (INPUT)
C                  LX = THE NUMBER OF GROUPS DETERMINED.  (OUTPUT)
C                IBIT = THE NUMBER OF BITS NECESSARY TO PACK THE JMIN(J)
C                       VALUES, J=1,LX.  (OUTPUT)
C                JBIT = THE NUMBER OF BITS NECESSARY TO PACK THE LBIT(J)
C                       VALUES, J=1,LX.  (OUTPUT)
C                KBIT = THE NUMBER OF BITS NECESSARY TO PACK THE NOV(J)
C                       VALUES, J=1,LX.  (OUTPUT)
C              NOVREF = REFERENCE VALUE FOR NOV( ).  (OUTPUT)
C             LBITREF = REFERENCE VALUE FOR LBIT( ).  (OUTPUT)
C                 IER = ERROR RETURN.
C                       706 = VALUE WILL NOT PACK IN 30 BITS--FATAL
C                       714 = ERROR IN REDUCE--NON-FATAL
C                       715 = NGP NOT LARGE ENOUGH IN REDUCE--NON-FATAL
C                       716 = MINPK INCEASED--NON-FATAL
C                       717 = INC SET = 1--NON-FATAL
C                       (OUTPUT)
C                   * = ALTERNATE RETURN WHEN IER NE 0 AND FATAL ERROR.
C
C        INTERNAL VARIABLES 
C               CFEED = CONTAINS THE CHARACTER REPRESENTATION
C                       OF A PRINTER FORM FEED.
C               IFEED = CONTAINS THE INTEGER VALUE OF A PRINTER
C                       FORM FEED.
C                KINC = WORKING COPY OF INC.  MAY BE MODIFIED.
C                MINA = MINIMUM VALUE IN GROUP A.
C                MAXA = MAXIMUM VALUE IN GROUP A.
C               NENDA = THE PLACE IN IC( ) WHERE GROUP A ENDS.
C              KSTART = THE PLACE IN IC( ) WHERE GROUP A STARTS.
C               IBITA = NUMBER OF BITS NEEDED TO HOLD VALUES IN GROUP A.
C                MINB = MINIMUM VALUE IN GROUP B.
C                MAXB = MAXIMUM VALUE IN GROUP B.
C               NENDB = THE PLACE IN IC( ) WHERE GROUP B ENDS.
C               IBITB = NUMBER OF BITS NEEDED TO HOLD VALUES IN GROUP B.
C                MINC = MINIMUM VALUE IN GROUP C.
C                MAXC = MAXIMUM VALUE IN GROUP C.
C              KTOTAL = COUNT OF NUMBER OF VALUES IN IC( ) PROCESSED.
C               NOUNT = NUMBER OF VALUES ADDED TO GROUP A.
C               LMISS = 0 WHEN IS523 = 0.  WHEN PACKING INTO A 
C                       SPECIFIC NUMBER OF BITS, SAY MBITS,
C                       THE MAXIMUM VALUE THAT CAN BE HANDLED IS
C                       2**MBITS-1.  WHEN IS523 = 1, INDICATING
C                       PRIMARY MISSING VALUES, THIS MAXIMUM VALUE 
C                       IS RESERVED TO HOLD THE PRIMARY MISSING VALUE 
C                       INDICATOR AND LMISS = 1.  WHEN IS523 = 2,
C                       THE VALUE JUST BELOW THE MAXIMUM (I.E.,
C                       2**MBITS-2) IS RESERVED TO HOLD THE SECONDARY 
C                       MISSING VALUE INDICATOR AND LMISS = 2.
C              LMINPK = LOCAL VALUE OF MINPK.  THIS WILL BE ADJUSTED
C                       UPWARD WHENEVER NDG IS NOT LARGE ENOUGH TO HOLD
C                       ALL THE GROUPS.
C              MALLOW = THE LARGEST ALLOWABLE VALUE FOR PACKING.
C              MISLLA = SET TO 1 WHEN ALL VALUES IN GROUP A ARE MISSING.
C                       THIS IS USED TO DISTINGUISH BETWEEN A REAL
C                       MINIMUM WHEN ALL VALUES ARE NOT MISSING
C                       AND A MINIMUM THAT HAS BEEN SET TO ZERO WHEN
C                       ALL VALUES ARE MISSING.  0 OTHERWISE.
C                       NOTE THAT THIS DOES NOT DISTINGUISH BETWEEN
C                       PRIMARY AND SECONDARY MISSINGS WHEN SECONDARY
C                       MISSINGS ARE PRESENT.  THIS MEANS THAT 
C                       LBIT( ) WILL NOT BE ZERO WITH THE RESULTING
C                       COMPRESSION EFFICIENCY WHEN SECONDARY MISSINGS
C                       ARE PRESENT.  ALSO NOTE THAT A CHECK HAS BEEN
C                       MADE EARLIER TO DETERMINE THAT SECONDARY
C                       MISSINGS ARE REALLY THERE.
C              MISLLB = SET TO 1 WHEN ALL VALUES IN GROUP B ARE MISSING.
C                       THIS IS USED TO DISTINGUISH BETWEEN A REAL
C                       MINIMUM WHEN ALL VALUES ARE NOT MISSING
C                       AND A MINIMUM THAT HAS BEEN SET TO ZERO WHEN
C                       ALL VALUES ARE MISSING.  0 OTHERWISE.
C              MISLLC = PERFORMS THE SAME FUNCTION FOR GROUP C THAT
C                       MISLLA AND MISLLB DO FOR GROUPS B AND C,
C                       RESPECTIVELY.
C            IBXX2(J) = AN ARRAY THAT WHEN THIS ROUTINE IS FIRST ENTERED
C                       IS SET TO 2**J, J=0,30. IBXX2(30) = 2**30, WHICH
C                       IS THE LARGEST VALUE PACKABLE, BECAUSE 2**31
C                       IS LARGER THAN THE INTEGER WORD SIZE.
C              IFIRST = SET BY DATA STATEMENT TO 0.  CHANGED TO 1 ON
C                       FIRST
C                       ENTRY WHEN IBXX2( ) IS FILLED.
C               MINAK = KEEPS TRACK OF THE LOCATION IN IC( ) WHERE THE 
C                       MINIMUM VALUE IN GROUP A IS LOCATED.
C               MAXAK = DOES THE SAME AS MINAK, EXCEPT FOR THE MAXIMUM.
C               MINBK = THE SAME AS MINAK FOR GROUP B.
C               MAXBK = THE SAME AS MAXAK FOR GROUP B.
C               MINCK = THE SAME AS MINAK FOR GROUP C.
C               MAXCK = THE SAME AS MAXAK FOR GROUP C.
C                ADDA = KEEPS TRACK WHETHER OR NOT AN ATTEMPT TO ADD
C                       POINTS TO GROUP A WAS MADE.  IF SO, THEN ADDA
C                       KEEPS FROM TRYING TO PUT ONE BACK INTO B.
C                       (LOGICAL)
C              IBITBS = KEEPS CURRENT VALUE IF IBITB SO THAT LOOP
C                       ENDING AT 166 DOESN'T HAVE TO START AT
C                       IBITB = 0 EVERY TIME.
C           MISSLX(J) = MALLOW EXCEPT WHEN A GROUP IS ALL ONE VALUE (AND
C                       LBIT(J) = 0) AND THAT VALUE IS MISSING.  IN
C                       THAT CASE, MISSLX(J) IS MISSP OR MISSS.  THIS
C                       GETS INSERTED INTO JMIN(J) LATER AS THE 
C                       MISSING INDICATOR; IT CAN'T BE PUT IN UNTIL
C                       THE END, BECAUSE JMIN( ) IS USED TO CALCULATE
C                       THE MAXIMUM NUMBER OF BITS (IBITS) NEEDED TO
C                       PACK JMIN( ).
C        1         2         3         4         5         6         7 X
C
C        NON SYSTEM SUBROUTINES CALLED 
C           NONE
C
      PARAMETER (MALLOW=2**30+1)
C
      CHARACTER*1 CFEED
      LOGICAL ADDA
C
      DIMENSION IC(NXY)
      DIMENSION JMIN(NDG),JMAX(NDG),LBIT(NDG),NOV(NDG)
      DIMENSION MISSLX(NDG)
C        MISSLX( ) IS AN AUTOMATIC ARRAY.
      DIMENSION IBXX2(0:30)
C
      SAVE IBXX2
C
      DATA IFEED/12/
      DATA IFIRST/0/
C
      IER=0
      IERSAV=0
C     CALL TIMPR(KFILDO,KFILDO,'START PACK_GP        ')
      CFEED=CHAR(IFEED)
C
      IRED=0
C        IRED IS A FLAG.  WHEN ZERO, REDUCE WILL BE CALLED.
C        IF REDUCE ABORTS, IRED = 1 AND IS NOT CALLED.  IN
C        THIS CASE PACK_GP EXECUTES AGAIN EXCEPT FOR REDUCE.
C
      IF(INC.LE.0)THEN
         IERSAV=717
C        WRITE(KFILDO,101)INC
C101     FORMAT(/' ****INC ='I8,' NOT CORRECT IN PACK_GP.  1 IS USED.')
      ENDIF
C
C        THERE WILL BE A RESTART OF PACK_GP IF SUBROUTINE REDUCE
C        ABORTS.  THIS SHOULD NOT HAPPEN, BUT IF IT DOES, PACK_GP
C        WILL COMPLETE WITHOUT SUBROUTINE REDUCE.  A NON FATAL
C        DIAGNOSTIC RETURN IS PROVIDED.
C
 102  KINC=MAX(INC,1)
      LMINPK=MINPK
C
C         CALCULATE THE POWERS OF 2 THE FIRST TIME ENTERED.
C
      IF(IFIRST.EQ.0)THEN
         IFIRST=1
         IBXX2(0)=1
C
         DO 104 J=1,30
         IBXX2(J)=IBXX2(J-1)*2
 104     CONTINUE
C
      ENDIF
C
C        THERE WILL BE A RESTART AT 105 IS NDG IS NOT LARGE ENOUGH.
C        A NON FATAL DIAGNOSTIC RETURN IS PROVIDED.
C
 105  KSTART=1
      KTOTAL=0
      LX=0
      ADDA=.FALSE.
      LMISS=0
      IF(IS523.EQ.1)LMISS=1
      IF(IS523.EQ.2)LMISS=2
C
C        *************************************
C
C        THIS SECTION COMPUTES STATISTICS FOR GROUP A.  GROUP A IS
C        A GROUP OF SIZE LMINPK.
C
C        *************************************
C
      IBITA=0
      MINA=MALLOW
      MAXA=-MALLOW
      MINAK=MALLOW
      MAXAK=-MALLOW
C
C        FIND THE MIN AND MAX OF GROUP A.  THIS WILL INITIALLY BE OF
C        SIZE LMINPK (IF THERE ARE STILL LMINPK VALUES IN IC( )), BUT
C        WILL INCREASE IN SIZE IN INCREMENTS OF INC UNTIL A NEW
C        GROUP IS STARTED.  THE DEFINITION OF GROUP A IS DONE HERE
C        ONLY ONCE (UPON INITIAL ENTRY), BECAUSE A GROUP B CAN ALWAYS
C        BECOME A NEW GROUP A AFTER A IS PACKED, EXCEPT IF LMINPK 
C        HAS TO BE INCREASED BECAUSE NDG IS TOO SMALL.  THEREFORE,
C        THE SEPARATE LOOPS FOR MISSING AND NON-MISSING HERE BUYS
C        ALMOST NOTHING.
C
      NENDA=MIN(KSTART+LMINPK-1,NXY)
      IF(NXY-NENDA.LE.LMINPK/2)NENDA=NXY
C        ABOVE STATEMENT GUARANTEES THE LAST GROUP IS GT LMINPK/2 BY 
C        MAKING THE ACTUAL GROUP LARGER.  IF A PROVISION LIKE THIS IS 
C        NOT INCLUDED, THERE WILL MANY TIMES BE A VERY SMALL GROUP
C        AT THE END.  USE SEPARATE LOOPS FOR MISSING AND NO MISSING
C        VALUES FOR EFFICIENCY.
C
C        DETERMINE WHETHER THERE IS A LONG STRING OF THE SAME VALUE
C        UNLESS NENDA = NXY.  THIS MAY ALLOW A LARGE GROUP A TO
C        START WITH, AS WITH MISSING VALUES.   SEPARATE LOOPS FOR
C        MISSING OPTIONS.  THIS SECTION IS ONLY EXECUTED ONCE,
C        IN DETERMINING THE FIRST GROUP.  IT HELPS FOR AN ARRAY
C        OF MOSTLY MISSING VALUES OR OF ONE VALUE, SUCH AS
C        RADAR OR PRECIP DATA.
C
      IF(NENDA.NE.NXY.AND.IC(KSTART).EQ.IC(KSTART+1))THEN
C           NO NEED TO EXECUTE IF FIRST TWO VALUES ARE NOT EQUAL.
C
         IF(IS523.EQ.0)THEN
C              THIS LOOP IS FOR NO MISSING VALUES.
C
            DO 111 K=KSTART+1,NXY
C
               IF(IC(K).NE.IC(KSTART))THEN
                  NENDA=MAX(NENDA,K-1)
                  GO TO 114
               ENDIF
C
 111        CONTINUE
C
            NENDA=NXY
C              FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME.
C
         ELSEIF(IS523.EQ.1)THEN
C              THIS LOOP IS FOR PRIMARY MISSING VALUES ONLY.
C
            DO 112 K=KSTART+1,NXY
C        
               IF(IC(K).NE.MISSP)THEN
C
                  IF(IC(K).NE.IC(KSTART))THEN
                     NENDA=MAX(NENDA,K-1)
                     GO TO 114
                  ENDIF
C
               ENDIF
C
 112        CONTINUE
C
            NENDA=NXY
C              FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME.
C
         ELSE
C              THIS LOOP IS FOR PRIMARY AND SECONDARY MISSING VALUES.
C
            DO 113 K=KSTART+1,NXY
C        
               IF(IC(K).NE.MISSP.AND.IC(K).NE.MISSS)THEN
C
                  IF(IC(K).NE.IC(KSTART))THEN
                     NENDA=MAX(NENDA,K-1)
                     GO TO 114
                  ENDIF
C
               ENDIF
C
 113        CONTINUE
C
            NENDA=NXY
C              FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME.
         ENDIF
C
      ENDIF
C
 114  IF(IS523.EQ.0)THEN
C
         DO 115 K=KSTART,NENDA
         IF(IC(K).LT.MINA)THEN
            MINA=IC(K)
            MINAK=K
         ENDIF
         IF(IC(K).GT.MAXA)THEN
            MAXA=IC(K)
            MAXAK=K
         ENDIF
 115     CONTINUE
C
      ELSEIF(IS523.EQ.1)THEN
C
         DO 117 K=KSTART,NENDA
         IF(IC(K).EQ.MISSP)GO TO 117
         IF(IC(K).LT.MINA)THEN
            MINA=IC(K)
            MINAK=K
         ENDIF
         IF(IC(K).GT.MAXA)THEN
            MAXA=IC(K)
            MAXAK=K
         ENDIF
 117     CONTINUE
C
      ELSE
C
         DO 120 K=KSTART,NENDA
         IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 120
         IF(IC(K).LT.MINA)THEN
            MINA=IC(K)
            MINAK=K
         ENDIF
         IF(IC(K).GT.MAXA)THEN
            MAXA=IC(K)
            MAXAK=K
         ENDIF
 120     CONTINUE
C
      ENDIF
C
      KOUNTA=NENDA-KSTART+1
C
C        INCREMENT KTOTAL AND FIND THE BITS NEEDED TO PACK THE A GROUP.
C
      KTOTAL=KTOTAL+KOUNTA
      MISLLA=0
      IF(MINA.NE.MALLOW)GO TO 125
C        ALL MISSING VALUES MUST BE ACCOMMODATED.
      MINA=0
      MAXA=0
      MISLLA=1
      IBITB=0
      IF(IS523.NE.2)GO TO 130
C        WHEN ALL VALUES ARE MISSING AND THERE ARE NO
C        SECONDARY MISSING VALUES, IBITA = 0.
C        OTHERWISE, IBITA MUST BE CALCULATED.
C
 125  ITEST=MAXA-MINA+LMISS
C  
      DO 126 IBITA=0,30
      IF(ITEST.LT.IBXX2(IBITA))GO TO 130
C***        THIS TEST IS THE SAME AS:
C***     IF(MAXA-MINA.LT.IBXX2(IBITA)-LMISS)GO TO 130
 126  CONTINUE
C
C     WRITE(KFILDO,127)MAXA,MINA
C127  FORMAT(' ****ERROR IN PACK_GP.  VALUE WILL NOT PACK IN 30 BITS.',
C    1       '  MAXA ='I13,'  MINA ='I13,'.  ERROR AT 127.')
      IER=706
      GO TO 900
C
 130  CONTINUE
C
C***D     WRITE(KFILDO,131)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA
C***D131  FORMAT(' AT 130, KOUNTA ='I8,'  KTOTAL ='I8,'  MINA ='I8,
C***D    1       '  MAXA ='I8,'  IBITA ='I3,'  MISLLA ='I3) 
C
 133  IF(KTOTAL.GE.NXY)GO TO 200
C
C        *************************************
C
C        THIS SECTION COMPUTES STATISTICS FOR GROUP B.  GROUP B IS A
C        GROUP OF SIZE LMINPK IMMEDIATELY FOLLOWING GROUP A.
C
C        *************************************
C
 140  MINB=MALLOW
      MAXB=-MALLOW
      MINBK=MALLOW
      MAXBK=-MALLOW
      IBITBS=0
      MSTART=KTOTAL+1
C
C        DETERMINE WHETHER THERE IS A LONG STRING OF THE SAME VALUE.
C        THIS WORKS WHEN THERE ARE NO MISSING VALUES.
C
      NENDB=1
C
      IF(MSTART.LT.NXY)THEN
C
         IF(IS523.EQ.0)THEN
C              THIS LOOP IS FOR NO MISSING VALUES.
C
            DO 145 K=MSTART+1,NXY
C
               IF(IC(K).NE.IC(MSTART))THEN
                  NENDB=K-1
                  GO TO 150
               ENDIF
C
 145        CONTINUE
C
            NENDB=NXY
C              FALL THROUGH THE LOOP MEANS ALL REMAINING VALUES
C              ARE THE SAME.
         ENDIF
C
      ENDIF
C         
 150  NENDB=MAX(NENDB,MIN(KTOTAL+LMINPK,NXY))
C**** 150  NENDB=MIN(KTOTAL+LMINPK,NXY)
C
      IF(NXY-NENDB.LE.LMINPK/2)NENDB=NXY
C        ABOVE STATEMENT GUARANTEES THE LAST GROUP IS GT LMINPK/2 BY 
C        MAKING THE ACTUAL GROUP LARGER.  IF A PROVISION LIKE THIS IS 
C        NOT INCLUDED, THERE WILL MANY TIMES BE A VERY SMALL GROUP
C        AT THE END.  USE SEPARATE LOOPS FOR MISSING AND NO MISSING
C
C        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES
C        FOR EFFICIENCY.
C
      IF(IS523.EQ.0)THEN
C              
         DO 155 K=MSTART,NENDB
         IF(IC(K).LE.MINB)THEN
            MINB=IC(K)
C              NOTE LE, NOT LT.  LT COULD BE USED BUT THEN A 
C              RECOMPUTE OVER THE WHOLE GROUP WOULD BE NEEDED
C              MORE OFTEN.  SAME REASONING FOR GE AND OTHER
C              LOOPS BELOW.
            MINBK=K
         ENDIF
         IF(IC(K).GE.MAXB)THEN
            MAXB=IC(K)
            MAXBK=K
         ENDIF
 155     CONTINUE
C
      ELSEIF(IS523.EQ.1)THEN
C
         DO 157 K=MSTART,NENDB
         IF(IC(K).EQ.MISSP)GO TO 157
         IF(IC(K).LE.MINB)THEN
            MINB=IC(K)
            MINBK=K
         ENDIF
         IF(IC(K).GE.MAXB)THEN
            MAXB=IC(K)
            MAXBK=K
         ENDIF
 157     CONTINUE
C
      ELSE
C
         DO 160 K=MSTART,NENDB
         IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 160
         IF(IC(K).LE.MINB)THEN
            MINB=IC(K)
            MINBK=K
         ENDIF
         IF(IC(K).GE.MAXB)THEN
            MAXB=IC(K)
            MAXBK=K
         ENDIF
 160     CONTINUE
C
      ENDIF
C
      KOUNTB=NENDB-KTOTAL
      MISLLB=0
      IF(MINB.NE.MALLOW)GO TO 165
C        ALL MISSING VALUES MUST BE ACCOMMODATED.
      MINB=0
      MAXB=0
      MISLLB=1
      IBITB=0
C
      IF(IS523.NE.2)GO TO 170
C        WHEN ALL VALUES ARE MISSING AND THERE ARE NO SECONDARY
C        MISSING VALUES, IBITB = 0.  OTHERWISE, IBITB MUST BE
C        CALCULATED.
C
 165  DO 166 IBITB=IBITBS,30
         IF(MAXB-MINB.LT.IBXX2(IBITB)-LMISS)GO TO 170
 166  CONTINUE
C
C     WRITE(KFILDO,167)MAXB,MINB
C167  FORMAT(' ****ERROR IN PACK_GP.  VALUE WILL NOT PACK IN 30 BITS.',
C    1       '  MAXB ='I13,'  MINB ='I13,'.  ERROR AT 167.')
      IER=706
      GO TO 900
C
C        COMPARE THE BITS NEEDED TO PACK GROUP B WITH THOSE NEEDED
C        TO PACK GROUP A.  IF IBITB GE IBITA, TRY TO ADD TO GROUP A.
C        IF NOT, TRY TO ADD A'S POINTS TO B, UNLESS ADDITION TO A
C        HAS BEEN DONE.  THIS LATTER IS CONTROLLED WITH ADDA.
C
 170  CONTINUE
C
C***D     WRITE(KFILDO,171)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA,
C***D    1                               MINB,MAXB,IBITB,MISLLB
C***D171  FORMAT(' AT 171, KOUNTA ='I8,'  KTOTAL ='I8,'  MINA ='I8,
C***D    1       '  MAXA ='I8,'  IBITA ='I3,'  MISLLA ='I3,
C***D    2       '  MINB ='I8,'  MAXB ='I8,'  IBITB ='I3,'  MISLLB ='I3)  
C
      IF(IBITB.GE.IBITA)GO TO 180
      IF(ADDA)GO TO 200
C
C        *************************************
C
C        GROUP B REQUIRES LESS BITS THAN GROUP A.  PUT AS MANY OF A'S
C        POINTS INTO B AS POSSIBLE WITHOUT EXCEEDING THE NUMBER OF
C        BITS NECESSARY TO PACK GROUP B.
C
C        *************************************
C
      KOUNTS=KOUNTA
C        KOUNTA REFERS TO THE PRESENT GROUP A.
      MINTST=MINB
      MAXTST=MAXB
      MINTSTK=MINBK
      MAXTSTK=MAXBK
C
C        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES
C        FOR EFFICIENCY.
C
      IF(IS523.EQ.0)THEN
C 
         DO 1715 K=KTOTAL,KSTART,-1
C           START WITH THE END OF THE GROUP AND WORK BACKWARDS.
         IF(IC(K).LT.MINB)THEN
            MINTST=IC(K)
            MINTSTK=K
         ELSEIF(IC(K).GT.MAXB)THEN
            MAXTST=IC(K)
            MAXTSTK=K
         ENDIF
         IF(MAXTST-MINTST.GE.IBXX2(IBITB))GO TO 174
C           NOTE THAT FOR THIS LOOP, LMISS = 0.
         MINB=MINTST
         MAXB=MAXTST
         MINBK=MINTSTK
         MAXBK=MAXTSTK
         KOUNTA=KOUNTA-1
C           THERE IS ONE LESS POINT NOW IN A.
 1715    CONTINUE  
C
      ELSEIF(IS523.EQ.1)THEN            
C
         DO 1719 K=KTOTAL,KSTART,-1
C           START WITH THE END OF THE GROUP AND WORK BACKWARDS.
         IF(IC(K).EQ.MISSP)GO TO 1718
         IF(IC(K).LT.MINB)THEN
            MINTST=IC(K)
            MINTSTK=K
         ELSEIF(IC(K).GT.MAXB)THEN
            MAXTST=IC(K)
            MAXTSTK=K
         ENDIF
         IF(MAXTST-MINTST.GE.IBXX2(IBITB)-LMISS)GO TO 174
C           FOR THIS LOOP, LMISS = 1.
         MINB=MINTST
         MAXB=MAXTST
         MINBK=MINTSTK
         MAXBK=MAXTSTK
         MISLLB=0
C           WHEN THE POINT IS NON MISSING, MISLLB SET = 0.
 1718    KOUNTA=KOUNTA-1
C           THERE IS ONE LESS POINT NOW IN A.
 1719    CONTINUE  
C
      ELSE             
C
         DO 173 K=KTOTAL,KSTART,-1
C           START WITH THE END OF THE GROUP AND WORK BACKWARDS.
         IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 1729
         IF(IC(K).LT.MINB)THEN
            MINTST=IC(K)
            MINTSTK=K
         ELSEIF(IC(K).GT.MAXB)THEN
            MAXTST=IC(K)
            MAXTSTK=K
         ENDIF
         IF(MAXTST-MINTST.GE.IBXX2(IBITB)-LMISS)GO TO 174
C           FOR THIS LOOP, LMISS = 2.
         MINB=MINTST
         MAXB=MAXTST
         MINBK=MINTSTK
         MAXBK=MAXTSTK
         MISLLB=0
C           WHEN THE POINT IS NON MISSING, MISLLB SET = 0.
 1729    KOUNTA=KOUNTA-1
C           THERE IS ONE LESS POINT NOW IN A.
 173     CONTINUE  
C
      ENDIF
C
C        AT THIS POINT, KOUNTA CONTAINS THE NUMBER OF POINTS TO CLOSE
C        OUT GROUP A WITH.  GROUP B NOW STARTS WITH KSTART+KOUNTA AND
C        ENDS WITH NENDB.  MINB AND MAXB HAVE BEEN ADJUSTED AS
C        NECESSARY TO REFLECT GROUP B (EVEN THOUGH THE NUMBER OF BITS
C        NEEDED TO PACK GROUP B HAVE NOT INCREASED, THE END POINTS
C        OF THE RANGE MAY HAVE).
C
 174  IF(KOUNTA.EQ.KOUNTS)GO TO 200
C        ON TRANSFER, GROUP A WAS NOT CHANGED.  CLOSE IT OUT.
C
C        ONE OR MORE POINTS WERE TAKEN OUT OF A.  RANGE AND IBITA
C        MAY HAVE TO BE RECOMPUTED; IBITA COULD BE LESS THAN
C        ORIGINALLY COMPUTED.  IN FACT, GROUP A CAN NOW CONTAIN
C        ONLY ONE POINT AND BE PACKED WITH ZERO BITS
C        (UNLESS MISSS NE 0).
C
      NOUTA=KOUNTS-KOUNTA
      KTOTAL=KTOTAL-NOUTA
      KOUNTB=KOUNTB+NOUTA
      IF(NENDA-NOUTA.GT.MINAK.AND.NENDA-NOUTA.GT.MAXAK)GO TO 200
C        WHEN THE ABOVE TEST IS MET, THE MIN AND MAX OF THE 
C        CURRENT GROUP A WERE WITHIN THE OLD GROUP A, SO THE
C        RANGE AND IBITA DO NOT NEED TO BE RECOMPUTED.
C        NOTE THAT MINAK AND MAXAK ARE NO LONGER NEEDED.
      IBITA=0
      MINA=MALLOW
      MAXA=-MALLOW
C
C        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES
C        FOR EFFICIENCY.
C
      IF(IS523.EQ.0)THEN
C 
         DO 1742 K=KSTART,NENDA-NOUTA
         IF(IC(K).LT.MINA)THEN
            MINA=IC(K)
         ENDIF
         IF(IC(K).GT.MAXA)THEN
            MAXA=IC(K)
         ENDIF
 1742    CONTINUE
C
      ELSEIF(IS523.EQ.1)THEN 
C
         DO 1744 K=KSTART,NENDA-NOUTA
         IF(IC(K).EQ.MISSP)GO TO 1744
         IF(IC(K).LT.MINA)THEN
            MINA=IC(K)
         ENDIF
         IF(IC(K).GT.MAXA)THEN
            MAXA=IC(K)
         ENDIF
 1744    CONTINUE
C
      ELSE 
C
         DO 175 K=KSTART,NENDA-NOUTA
         IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 175
         IF(IC(K).LT.MINA)THEN
            MINA=IC(K)
         ENDIF
         IF(IC(K).GT.MAXA)THEN
            MAXA=IC(K)
         ENDIF
 175     CONTINUE
C
      ENDIF
C
      MISLLA=0
      IF(MINA.NE.MALLOW)GO TO 1750
C        ALL MISSING VALUES MUST BE ACCOMMODATED.
      MINA=0
      MAXA=0
      MISLLA=1
      IF(IS523.NE.2)GO TO 177
C        WHEN ALL VALUES ARE MISSING AND THERE ARE NO SECONDARY
C        MISSING VALUES IBITA = 0 AS ORIGINALLY SET.  OTHERWISE,
C        IBITA MUST BE CALCULATED.
C
 1750 ITEST=MAXA-MINA+LMISS
C
      DO 176 IBITA=0,30
      IF(ITEST.LT.IBXX2(IBITA))GO TO 177
C***        THIS TEST IS THE SAME AS:
C***         IF(MAXA-MINA.LT.IBXX2(IBITA)-LMISS)GO TO 177
 176  CONTINUE
C
C     WRITE(KFILDO,1760)MAXA,MINA
C1760 FORMAT(' ****ERROR IN PACK_GP.  VALUE WILL NOT PACK IN 30 BITS.',
C    1       '  MAXA ='I13,'  MINA ='I13,'.  ERROR AT 1760.')
      IER=706
      GO TO 900
C
 177  CONTINUE
      GO TO 200
C
C        *************************************
C
C        AT THIS POINT, GROUP B REQUIRES AS MANY BITS TO PACK AS GROUPA.
C        THEREFORE, TRY TO ADD INC POINTS TO GROUP A WITHOUT INCREASING
C        IBITA.  THIS AUGMENTED GROUP IS CALLED GROUP C.
C
C        *************************************
C
 180  IF(MISLLA.EQ.1)THEN
         MINC=MALLOW
         MINCK=MALLOW
         MAXC=-MALLOW
         MAXCK=-MALLOW
      ELSE
         MINC=MINA
         MAXC=MAXA
         MINCK=MINAK
         MAXCK=MINAK
      ENDIF
C
      NOUNT=0
      IF(NXY-(KTOTAL+KINC).LE.LMINPK/2)KINC=NXY-KTOTAL
C        ABOVE STATEMENT CONSTRAINS THE LAST GROUP TO BE NOT LESS THAN
C        LMINPK/2 IN SIZE.  IF A PROVISION LIKE THIS IS NOT INCLUDED,
C        THERE WILL MANY TIMES BE A VERY SMALL GROUP AT THE END.
C
C        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES
C        FOR EFFICIENCY.  SINCE KINC IS USUALLY 1, USING SEPARATE
C        LOOPS HERE DOESN'T BUY MUCH.  A MISSING VALUE WILL ALWAYS
C        TRANSFER BACK TO GROUP A.
C
      IF(IS523.EQ.0)THEN
C
         DO 185 K=KTOTAL+1,MIN(KTOTAL+KINC,NXY)
         IF(IC(K).LT.MINC)THEN
            MINC=IC(K)
            MINCK=K
         ENDIF
         IF(IC(K).GT.MAXC)THEN
            MAXC=IC(K)
            MAXCK=K
         ENDIF
         NOUNT=NOUNT+1
 185     CONTINUE
C
      ELSEIF(IS523.EQ.1)THEN
C
         DO 187 K=KTOTAL+1,MIN(KTOTAL+KINC,NXY)
         IF(IC(K).EQ.MISSP)GO TO 186
         IF(IC(K).LT.MINC)THEN
            MINC=IC(K)
            MINCK=K
         ENDIF
         IF(IC(K).GT.MAXC)THEN
            MAXC=IC(K)
            MAXCK=K
         ENDIF
 186     NOUNT=NOUNT+1
 187     CONTINUE
C
      ELSE
C
         DO 190 K=KTOTAL+1,MIN(KTOTAL+KINC,NXY)
         IF(IC(K).EQ.MISSP.OR.IC(K).EQ.MISSS)GO TO 189
         IF(IC(K).LT.MINC)THEN
            MINC=IC(K)
            MINCK=K
         ENDIF
         IF(IC(K).GT.MAXC)THEN
            MAXC=IC(K)
            MAXCK=K
         ENDIF
 189     NOUNT=NOUNT+1
 190     CONTINUE
C
      ENDIF
C
C***D     WRITE(KFILDO,191)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA,
C***D    1   MINC,MAXC,NOUNT,IC(KTOTAL),IC(KTOTAL+1)
C***D191  FORMAT(' AT 191, KOUNTA ='I8,'  KTOTAL ='I8,'  MINA ='I8,
C***D    1       '  MAXA ='I8,'  IBITA ='I3,'  MISLLA ='I3,
C***D    2       '  MINC ='I8,'  MAXC ='I8,
C***D    3       '  NOUNT ='I5,'  IC(KTOTAL) ='I9,'  IC(KTOTAL+1) =',I9) 
C
C        IF THE NUMBER OF BITS NEEDED FOR GROUP C IS GT IBITA,
C        THEN THIS GROUP A IS A GROUP TO PACK.
C
      IF(MINC.EQ.MALLOW)THEN
         MINC=MINA
         MAXC=MAXA
         MINCK=MINAK
         MAXCK=MAXAK
         MISLLC=1
         GO TO 195
C           WHEN THE NEW VALUE(S) ARE MISSING, THEY CAN ALWAYS
C           BE ADDED.
C
      ELSE
         MISLLC=0
      ENDIF
C
      IF(MAXC-MINC.GE.IBXX2(IBITA)-LMISS) GO TO 200
C
C        THE BITS NECESSARY FOR GROUP C HAS NOT INCREASED FROM THE
C        BITS NECESSARY FOR GROUP A.  ADD THIS POINT(S) TO GROUP A.
C        COMPUTE THE NEXT GROUP B, ETC., UNLESS ALL POINTS HAVE BEEN
C        USED.
C 
 195  KTOTAL=KTOTAL+NOUNT
      KOUNTA=KOUNTA+NOUNT
      MINA=MINC
      MAXA=MAXC
      MINAK=MINCK
      MAXAK=MAXCK
      MISLLA=MISLLC
      ADDA=.TRUE.
      IF(KTOTAL.GE.NXY)GO TO 200
C
      IF(MINBK.GT.KTOTAL.AND.MAXBK.GT.KTOTAL)THEN
         MSTART=NENDB+1
C           THE MAX AND MIN OF GROUP B WERE NOT FROM THE POINTS
C           REMOVED, SO THE WHOLE GROUP DOES NOT HAVE TO BE LOOKED
C           AT TO DETERMINE THE NEW MAX AND MIN.  RATHER START
C           JUST BEYOND THE OLD NENDB.
         IBITBS=IBITB
         NENDB=1
         GO TO 150
      ELSE
         GO TO 140
      ENDIF
C
C        *************************************
C
C        GROUP A IS TO BE PACKED.  STORE VALUES IN JMIN( ), JMAX( ),
C        LBIT( ), AND NOV( ).
C
C        *************************************
C
 200  LX=LX+1
      IF(LX.LE.NDG)GO TO 205
      LMINPK=LMINPK+LMINPK/2
C     WRITE(KFILDO,201)NDG,LMINPK,LX
C201  FORMAT(' ****NDG ='I5,' NOT LARGE ENOUGH.',
C    1       '  LMINPK IS INCREASED TO 'I3,' FOR THIS FIELD.'/
C    2       '  LX = 'I10)
      IERSAV=716
      GO TO 105
C
 205  JMIN(LX)=MINA
      JMAX(LX)=MAXA
      LBIT(LX)=IBITA
      NOV(LX)=KOUNTA
      KSTART=KTOTAL+1
C
      IF(MISLLA.EQ.0)THEN
         MISSLX(LX)=MALLOW
      ELSE
         MISSLX(LX)=IC(KTOTAL)
C           IC(KTOTAL) WAS THE LAST VALUE PROCESSED.  IF MISLLA NE 0,
C           THIS MUST BE THE MISSING VALUE FOR THIS GROUP.
      ENDIF
C
C***D     WRITE(KFILDO,206)MISLLA,IC(KTOTAL),KTOTAL,LX,JMIN(LX),JMAX(LX),
C***D    1                 LBIT(LX),NOV(LX),MISSLX(LX)
C***D206  FORMAT(' AT 206,  MISLLA ='I2,'  IC(KTOTAL) ='I5,'  KTOTAL ='I8,
C***D    1       '  LX ='I6,'  JMIN(LX) ='I8,'  JMAX(LX) ='I8,
C***D    2       '  LBIT(LX) ='I5,'  NOV(LX) ='I8,'  MISSLX(LX) =',I7) 
C
      IF(KTOTAL.GE.NXY)GO TO 209
C
C        THE NEW GROUP A WILL BE THE PREVIOUS GROUP B.  SET LIMITS, ETC.
C
      IBITA=IBITB
      MINA=MINB
      MAXA=MAXB
      MINAK=MINBK
      MAXAK=MAXBK
      MISLLA=MISLLB
      NENDA=NENDB
      KOUNTA=KOUNTB
      KTOTAL=KTOTAL+KOUNTA
      ADDA=.FALSE.
      GO TO 133
C
C        *************************************
C
C        CALCULATE IBIT, THE NUMBER OF BITS NEEDED TO HOLD THE GROUP
C        MINIMUM VALUES.
C
C        *************************************
C
 209  IBIT=0
C
      DO 220 L=1,LX
 210  IF(JMIN(L).LT.IBXX2(IBIT))GO TO 220
      IBIT=IBIT+1
      GO TO 210
 220  CONTINUE
C
C        INSERT THE VALUE IN JMIN( ) TO BE USED FOR ALL MISSING
C        VALUES WHEN LBIT( ) = 0.  WHEN SECONDARY MISSING 
C        VALUES CAN BE PRESENT, LBIT(L) WILL NOT = 0.
C
      IF(IS523.EQ.1)THEN
C
         DO 226 L=1,LX
C   
         IF(LBIT(L).EQ.0)THEN
C
            IF(MISSLX(L).EQ.MISSP)THEN
               JMIN(L)=IBXX2(IBIT)-1
            ENDIF
C
         ENDIF
C
 226     CONTINUE
C
      ENDIF
C
C        *************************************
C
C        CALCULATE JBIT, THE NUMBER OF BITS NEEDED TO HOLD THE BITS
C        NEEDED TO PACK THE VALUES IN THE GROUPS.  BUT FIND AND
C        REMOVE THE REFERENCE VALUE FIRST.
C
C        *************************************
C
C     WRITE(KFILDO,228)CFEED,LX
C228  FORMAT(A1,/' *****************************************'
C    1          /' THE GROUP WIDTHS LBIT( ) FOR ',I8,' GROUPS'
C    2          /' *****************************************')
C     WRITE(KFILDO,229) (LBIT(J),J=1,MIN(LX,100))
C229  FORMAT(/' '20I6)
C
      LBITREF=LBIT(1)
C
      DO 230 K=1,LX
      IF(LBIT(K).LT.LBITREF)LBITREF=LBIT(K)
 230  CONTINUE
C
      IF(LBITREF.NE.0)THEN
C
         DO 240 K=1,LX
         LBIT(K)=LBIT(K)-LBITREF
 240     CONTINUE
C
      ENDIF
C
C     WRITE(KFILDO,241)CFEED,LBITREF
C241  FORMAT(A1,/' *****************************************'
C    1          /' THE GROUP WIDTHS LBIT( ) AFTER REMOVING REFERENCE ',
C    2             I8,
C    3          /' *****************************************')
C     WRITE(KFILDO,242) (LBIT(J),J=1,MIN(LX,100))
C242  FORMAT(/' '20I6)
C
      JBIT=0
C
      DO 320 K=1,LX
 310  IF(LBIT(K).LT.IBXX2(JBIT))GO TO 320
      JBIT=JBIT+1
      GO TO 310
 320  CONTINUE
C
C        *************************************
C
C        CALCULATE KBIT, THE NUMBER OF BITS NEEDED TO HOLD THE NUMBER
C        OF VALUES IN THE GROUPS.  BUT FIND AND REMOVE THE
C        REFERENCE FIRST.
C
C        *************************************
C
C     WRITE(KFILDO,321)CFEED,LX
C321  FORMAT(A1,/' *****************************************'
C    1          /' THE GROUP SIZES NOV( ) FOR ',I8,' GROUPS'
C    2          /' *****************************************')
C     WRITE(KFILDO,322) (NOV(J),J=1,MIN(LX,100))
C322  FORMAT(/' '20I6)
C
      NOVREF=NOV(1)
C
      DO 400 K=1,LX
      IF(NOV(K).LT.NOVREF)NOVREF=NOV(K)
 400  CONTINUE
C
      IF(NOVREF.GT.0)THEN
C
         DO 405 K=1,LX
         NOV(K)=NOV(K)-NOVREF
 405     CONTINUE
C
      ENDIF
C
C     WRITE(KFILDO,406)CFEED,NOVREF
C406  FORMAT(A1,/' *****************************************'
C    1          /' THE GROUP SIZES NOV( ) AFTER REMOVING REFERENCE ',I8,
C    2          /' *****************************************')
C     WRITE(KFILDO,407) (NOV(J),J=1,MIN(LX,100))
C407  FORMAT(/' '20I6)
C     WRITE(KFILDO,408)CFEED
C408  FORMAT(A1,/' *****************************************'
C    1          /' THE GROUP REFERENCES JMIN( )'
C    2          /' *****************************************')
C     WRITE(KFILDO,409) (JMIN(J),J=1,MIN(LX,100))
C409  FORMAT(/' '20I6)
C
      KBIT=0
C
      DO 420 K=1,LX
 410  IF(NOV(K).LT.IBXX2(KBIT))GO TO 420
      KBIT=KBIT+1
      GO TO 410
 420  CONTINUE
C
C        DETERMINE WHETHER THE GROUP SIZES SHOULD BE REDUCED
C        FOR SPACE EFFICIENCY.
C
      IF(IRED.EQ.0)THEN
         CALL REDUCE(KFILDO,JMIN,JMAX,LBIT,NOV,LX,NDG,IBIT,JBIT,KBIT,
     1               NOVREF,IBXX2,IER)
C
         IF(IER.EQ.714.OR.IER.EQ.715)THEN
C              REDUCE HAS ABORTED.  REEXECUTE PACK_GP WITHOUT REDUCE.
C              PROVIDE FOR A NON FATAL RETURN FROM REDUCE.  
            IERSAV=IER
            IRED=1
            IER=0
            GO TO 102 
         ENDIF
C
      ENDIF         
C
C     CALL TIMPR(KFILDO,KFILDO,'END   PACK_GP        ')
      IF(IERSAV.NE.0)THEN
         IER=IERSAV
         RETURN
      ENDIF
C
C 900  IF(IER.NE.0)RETURN1
C
 900  RETURN
      END