/src/gdal/frmts/grib/degrib/g2clib/pack_gp.c

Source
/* pack_gp.f -- translated by f2c (version 20031025).
   You must link the resulting object file with libf2c:
  on Microsoft Windows system, link with libf2c.lib;
  on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  or, if you install libf2c.a in a standard place, with -lf2c -lm
  -- in that order, at the end of the command line, as in
    cc *.o -lf2c -lm
  Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

    http://www.netlib.org/f2c/libf2c.zip
*/

/*#include "f2c.h"*/
#include "cpl_port.h"
#include <limits.h>
#include <stdlib.h>
#include "grib2.h"
typedef g2int logical;
#define TRUE_ (1)
#define FALSE_ (0)

/* Subroutine */ int pack_gp(integer *kfildo, integer *ic, integer *nxy,
  integer *is523, integer *minpk, integer *inc, integer *missp, integer
  *misss, integer *jmin, integer *jmax, integer *lbit, integer *nov,
  integer *ndg, integer *lx, integer *ibit, integer *jbit, integer *
  kbit, integer *novref, integer *lbitref, integer *ier)
{
    /* Initialized data */

    const  integer mallow = 1073741825;   /*  MALLOW=2**30+1  */
    integer ifeed = 12;
    integer ifirst = 0;

    /* System generated locals */
    integer i__1, i__2, i__3;

    /* Local variables */
    integer j, k, l;
    logical adda;
    integer ired, kinc, mina, maxa, minb = 0, maxb = 0, minc = 0, maxc = 0, ibxx2[31];
    char cfeed[1];
    integer nenda, nendb = 0, ibita, ibitb = 0, minak, minbk = 0, maxak, maxbk = 0,
      minck = 0, maxck, nouta = 0, lmiss, itest = 0, nount = 0;
    extern /* Subroutine */ int reduce(integer *, integer *, integer *,
      integer *, integer *, integer *, integer *, integer *, integer *,
      integer *, integer *, integer *, integer *);
    integer ibitbs = 0, mislla, misllb = 0, misllc = 0, iersav = 0, lminpk, ktotal,
      kounta, kountb = 0, kstart, mstart = 0, mintst = 0, maxtst = 0,
      kounts = 0, mintstk = 0, maxtstk = 0;
    integer *misslx;


/*        FEBRUARY 1994   GLAHN   TDL   MOS-2000 */
/*        JUNE     1995   GLAHN   MODIFIED FOR LMISS ERROR. */
/*        JULY     1996   GLAHN   ADDED MISSS */
/*        FEBRUARY 1997   GLAHN   REMOVED 4 REDUNDANT TESTS FOR */
/*                                MISSP.EQ.0; INSERTED A TEST TO BETTER */
/*                                HANDLE A STRING OF 9999'S */
/*        FEBRUARY 1997   GLAHN   ADDED LOOPS TO ELIMINATE TEST FOR */
/*                                MISSS WHEN MISSS = 0 */
/*        MARCH    1997   GLAHN   CORRECTED FOR SECONDARY MISSING VALUE */
/*        MARCH    1997   GLAHN   CORRECTED FOR USE OF LOCAL VALUE */
/*                                OF MINPK */
/*        MARCH    1997   GLAHN   CORRECTED FOR SECONDARY MISSING VALUE */
/*        MARCH    1997   GLAHN   CHANGED CALCULATING NUMBER OF BITS */
/*                                THROUGH EXPONENTS TO AN ARRAY (IMPROVED */
/*                                OVERALL PACKING PERFORMANCE BY ABOUT */
/*                                35 PERCENT!).  ALLOWED 0 BITS FOR */
/*                                PACKING JMIN( ), LBIT( ), AND NOV( ). */
/*        MAY      1997   GLAHN   A NUMBER OF CHANGES FOR EFFICIENCY. */
/*                                MOD FUNCTIONS ELIMINATED AND ONE */
/*                                IFTHEN ADDED.  JOUNT REMOVED. */
/*                                RECOMPUTATION OF BITS NOT MADE UNLESS */
/*                                NECESSARY AFTER MOVING POINTS FROM */
/*                                ONE GROUP TO ANOTHER.  NENDB ADJUSTED */
/*                                TO ELIMINATE POSSIBILITY OF VERY */
/*                                SMALL GROUP AT THE END. */
/*                                ABOUT 8 PERCENT IMPROVEMENT IN */
/*                                OVERALL PACKING.  ISKIPA REMOVED; */
/*                                THERE IS ALWAYS A GROUP B THAT CAN */
/*                                BECOME GROUP A.  CONTROL ON SIZE */
/*                                OF GROUP B (STATEMENT BELOW 150) */
/*                                ADDED.  ADDED ADDA, AND USE */
/*                                OF GE AND LE INSTEAD OF GT AND LT */
/*                                IN LOOPS BETWEEN 150 AND 160. */
/*                                IBITBS ADDED TO SHORTEN TRIPS */
/*                                THROUGH LOOP. */
/*        MARCH    2000   GLAHN   MODIFIED FOR GRIB2; CHANGED NAME FROM */
/*                                PACKGP */
/*        JANUARY  2001   GLAHN   COMMENTS; IER = 706 SUBSTITUTED FOR */
/*                                STOPS; ADDED RETURN1; REMOVED STATEMENT */
/*                                NUMBER 110; ADDED IER AND * RETURN */
/*        NOVEMBER 2001   GLAHN   CHANGED SOME DIAGNOSTIC FORMATS TO */
/*                                ALLOW PRINTING LARGER NUMBERS */
/*        NOVEMBER 2001   GLAHN   ADDED MISSLX( ) TO PUT MAXIMUM VALUE */
/*                                INTO JMIN( ) WHEN ALL VALUES MISSING */
/*                                TO AGREE WITH GRIB STANDARD. */
/*        NOVEMBER 2001   GLAHN   CHANGED TWO TESTS ON MISSP AND MISSS */
/*                                EQ 0 TO TESTS ON IS523.  HOWEVER, */
/*                                MISSP AND MISSS CANNOT IN GENERAL BE */
/*                                = 0. */
/*        NOVEMBER 2001   GLAHN   ADDED CALL TO REDUCE; DEFINED ITEST */
/*                                BEFORE LOOPS TO REDUCE COMPUTATION; */
/*                                STARTED LARGE GROUP WHEN ALL SAME */
/*                                VALUE */
/*        DECEMBER 2001   GLAHN   MODIFIED AND ADDED A FEW COMMENTS */
/*        JANUARY  2002   GLAHN   REMOVED LOOP BEFORE 150 TO DETERMINE */
/*                                A GROUP OF ALL SAME VALUE */
/*        JANUARY  2002   GLAHN   CHANGED MALLOW FROM 9999999 TO 2**30+1, */
/*                                AND MADE IT A PARAMETER */
/*        MARCH    2002   GLAHN   ADDED NON FATAL IER = 716, 717; */
/*                                REMOVED NENDB=NXY ABOVE 150; */
/*                                ADDED IERSAV=0; COMMENTS */

/*        PURPOSE */
/*            DETERMINES GROUPS OF VARIABLE SIZE, BUT AT LEAST OF */
/*            SIZE MINPK, THE ASSOCIATED MAX (JMAX( )) AND MIN (JMIN( )), */
/*            THE NUMBER OF BITS NECESSARY TO HOLD THE VALUES IN EACH */
/*            GROUP (LBIT( )), THE NUMBER OF VALUES IN EACH GROUP */
/*            (NOV( )), THE NUMBER OF BITS NECESSARY TO PACK THE JMIN( ) */
/*            VALUES (IBIT), THE NUMBER OF BITS NECESSARY TO PACK THE */
/*            LBIT( ) VALUES (JBIT), AND THE NUMBER OF BITS NECESSARY */
/*            TO PACK THE NOV( ) VALUES (KBIT).  THE ROUTINE IS DESIGNED */
/*            TO DETERMINE THE GROUPS SUCH THAT A SMALL NUMBER OF BITS */
/*            IS NECESSARY TO PACK THE DATA WITHOUT EXCESSIVE */
/*            COMPUTATIONS.  IF ALL VALUES IN THE GROUP ARE ZERO, THE */
/*            NUMBER OF BITS TO USE IN PACKING IS DEFINED AS ZERO WHEN */
/*            THERE CAN BE NO MISSING VALUES; WHEN THERE CAN BE MISSING */
/*            VALUES, THE NUMBER OF BITS MUST BE AT LEAST 1 TO HAVE */
/*            THE CAPABILITY TO RECOGNIZE THE MISSING VALUE.  HOWEVER, */
/*            IF ALL VALUES IN A GROUP ARE MISSING, THE NUMBER OF BITS */
/*            NEEDED IS 0, AND THE UNPACKER RECOGNIZES THIS. */
/*            ALL VARIABLES ARE INTEGER.  EVEN THOUGH THE GROUPS ARE */
/*            INITIALLY OF SIZE MINPK OR LARGER, AN ADJUSTMENT BETWEEN */
/*            TWO GROUPS (THE LOOKBACK PROCEDURE) MAY MAKE A GROUP */
/*            SMALLER THAN MINPK.  THE CONTROL ON GROUP SIZE IS THAT */
/*            THE SUM OF THE SIZES OF THE TWO CONSECUTIVE GROUPS, EACH OF */
/*            SIZE MINPK OR LARGER, IS NOT DECREASED.  WHEN DETERMINING */
/*            THE NUMBER OF BITS NECESSARY FOR PACKING, THE LARGEST */
/*            VALUE THAT CAN BE ACCOMMODATED IN, SAY, MBITS, IS */
/*            2**MBITS-1; THIS LARGEST VALUE (AND THE NEXT SMALLEST */
/*            VALUE) IS RESERVED FOR THE MISSING VALUE INDICATOR (ONLY) */
/*            WHEN IS523 NE 0.  IF THE DIMENSION NDG */
/*            IS NOT LARGE ENOUGH TO HOLD ALL THE GROUPS, THE LOCAL VALUE */
/*            OF MINPK IS INCREASED BY 50 PERCENT.  THIS IS REPEATED */
/*            UNTIL NDG WILL SUFFICE.  A DIAGNOSTIC IS PRINTED WHENEVER */
/*            THIS HAPPENS, WHICH SHOULD BE VERY RARELY.  IF IT HAPPENS */
/*            OFTEN, NDG IN SUBROUTINE PACK SHOULD BE INCREASED AND */
/*            A CORRESPONDING INCREASE IN SUBROUTINE UNPACK MADE. */
/*            CONSIDERABLE CODE IS PROVIDED SO THAT NO MORE CHECKING */
/*            FOR MISSING VALUES WITHIN LOOPS IS DONE THAN NECESSARY; */
/*            THE ADDED EFFICIENCY OF THIS IS RELATIVELY MINOR, */
/*            BUT DOES NO HARM.  FOR GRIB2, THE REFERENCE VALUE FOR */
/*            THE LENGTH OF GROUPS IN NOV( ) AND FOR THE NUMBER OF */
/*            BITS NECESSARY TO PACK GROUP VALUES ARE DETERMINED, */
/*            AND SUBTRACTED BEFORE JBIT AND KBIT ARE DETERMINED. */

/*            WHEN 1 OR MORE GROUPS ARE LARGE COMPARED TO THE OTHERS, */
/*            THE WIDTH OF ALL GROUPS MUST BE AS LARGE AS THE LARGEST. */
/*            A SUBROUTINE REDUCE BREAKS UP LARGE GROUPS INTO 2 OR */
/*            MORE TO REDUCE TOTAL BITS REQUIRED.  IF REDUCE SHOULD */
/*            ABORT, PACK_GP WILL BE EXECUTED AGAIN WITHOUT THE CALL */
/*            TO REDUCE. */

/*        DATA SET USE */
/*           KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) */

/*        VARIABLES IN CALL SEQUENCE */
/*              KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE.  (INPUT) */
/*               IC( ) = ARRAY TO HOLD DATA FOR PACKING.  THE VALUES */
/*                       DO NOT HAVE TO BE POSITIVE AT THIS POINT, BUT */
/*                       MUST BE IN THE RANGE -2**30 TO +2**30 (THE */
/*                       THE VALUE OF MALLOW).  THESE INTEGER VALUES */
/*                       WILL BE RETAINED EXACTLY THROUGH PACKING AND */
/*                       UNPACKING.  (INPUT) */
/*                 NXY = NUMBER OF VALUES IN IC( ).  ALSO TREATED */
/*                       AS ITS DIMENSION.  (INPUT) */
/*              IS523  = missing value management */
/*                       0=data contains no missing values */
/*                       1=data contains Primary missing values */
/*                       2=data contains Primary and secondary missing values */
/*                       (INPUT) */
/*               MINPK = THE MINIMUM SIZE OF EACH GROUP, EXCEPT POSSIBLY */
/*                       THE LAST ONE.  (INPUT) */
/*                 INC = THE NUMBER OF VALUES TO ADD TO AN ALREADY */
/*                       EXISTING GROUP IN DETERMINING WHETHER OR NOT */
/*                       TO START A NEW GROUP.  IDEALLY, THIS WOULD BE */
/*                       1, BUT EACH TIME INC VALUES ARE ATTEMPTED, THE */
/*                       MAX AND MIN OF THE NEXT MINPK VALUES MUST BE */
/*                       FOUND.  THIS IS "A LOOP WITHIN A LOOP," AND */
/*                       A SLIGHTLY LARGER VALUE MAY GIVE ABOUT AS GOOD */
/*                       RESULTS WITH SLIGHTLY LESS COMPUTATIONAL TIME. */
/*                       IF INC IS LE 0, 1 IS USED, AND A DIAGNOSTIC IS */
/*                       OUTPUT.  NOTE:  IT IS EXPECTED THAT INC WILL */
/*                       EQUAL 1.  THE CODE USES INC PRIMARILY IN THE */
/*                       LOOPS STARTING AT STATEMENT 180.  IF INC */
/*                       WERE 1, THERE WOULD NOT NEED TO BE LOOPS */
/*                       AS SUCH.  HOWEVER, KINC (THE LOCAL VALUE OF */
/*                       INC) IS SET GE 1 WHEN NEAR THE END OF THE DATA */
/*                       TO FORESTALL A VERY SMALL GROUP AT THE END. */
/*                       (INPUT) */
/*               MISSP = WHEN MISSING POINTS CAN BE PRESENT IN THE DATA, */
/*                       THEY WILL HAVE THE VALUE MISSP OR MISSS. */
/*                       MISSP IS THE PRIMARY MISSING VALUE AND  MISSS */
/*                       IS THE SECONDARY MISSING VALUE .  THESE MUST */
/*                       NOT BE VALUES THAT WOULD OCCUR WITH SUBTRACTING */
/*                       THE MINIMUM (REFERENCE) VALUE OR SCALING. */
/*                       FOR EXAMPLE, MISSP = 0 WOULD NOT BE ADVISABLE. */
/*                       (INPUT) */
/*               MISSS = SECONDARY MISSING VALUE INDICATOR (SEE MISSP). */
/*                       (INPUT) */
/*             JMIN(J) = THE MINIMUM OF EACH GROUP (J=1,LX).  (OUTPUT) */
/*             JMAX(J) = THE MAXIMUM OF EACH GROUP (J=1,LX).  THIS IS */
/*                       NOT REALLY NEEDED, BUT SINCE THE MAX OF EACH */
/*                       GROUP MUST BE FOUND, SAVING IT HERE IS CHEAP */
/*                       IN CASE THE USER WANTS IT.  (OUTPUT) */
/*             LBIT(J) = THE NUMBER OF BITS NECESSARY TO PACK EACH GROUP */
/*                       (J=1,LX).  IT IS ASSUMED THE MINIMUM OF EACH */
/*                       GROUP WILL BE REMOVED BEFORE PACKING, AND THE */
/*                       VALUES TO PACK WILL, THEREFORE, ALL BE POSITIVE. */
/*                       HOWEVER, IC( ) DOES NOT NECESSARILY CONTAIN */
/*                       ALL POSITIVE VALUES.  IF THE OVERALL MINIMUM */
/*                       HAS BEEN REMOVED (THE USUAL CASE), THEN IC( ) */
/*                       WILL CONTAIN ONLY POSITIVE VALUES.  (OUTPUT) */
/*              NOV(J) = THE NUMBER OF VALUES IN EACH GROUP (J=1,LX). */
/*                       (OUTPUT) */
/*                 NDG = THE DIMENSION OF JMIN( ), JMAX( ), LBIT( ), AND */
/*                       NOV( ).  (INPUT) */
/*                  LX = THE NUMBER OF GROUPS DETERMINED.  (OUTPUT) */
/*                IBIT = THE NUMBER OF BITS NECESSARY TO PACK THE JMIN(J) */
/*                       VALUES, J=1,LX.  (OUTPUT) */
/*                JBIT = THE NUMBER OF BITS NECESSARY TO PACK THE LBIT(J) */
/*                       VALUES, J=1,LX.  (OUTPUT) */
/*                KBIT = THE NUMBER OF BITS NECESSARY TO PACK THE NOV(J) */
/*                       VALUES, J=1,LX.  (OUTPUT) */
/*              NOVREF = REFERENCE VALUE FOR NOV( ).  (OUTPUT) */
/*             LBITREF = REFERENCE VALUE FOR LBIT( ).  (OUTPUT) */
/*                 IER = ERROR RETURN. */
/*                       706 = VALUE WILL NOT PACK IN 30 BITS--FATAL */
/*                       714 = ERROR IN REDUCE--NON-FATAL */
/*                       715 = NGP NOT LARGE ENOUGH IN REDUCE--NON-FATAL */
/*                       716 = MINPK INCEASED--NON-FATAL */
/*                       717 = INC SET = 1--NON-FATAL */
/*                       (OUTPUT) */
/*                   * = ALTERNATE RETURN WHEN IER NE 0 AND FATAL ERROR. */

/*        INTERNAL VARIABLES */
/*               CFEED = CONTAINS THE CHARACTER REPRESENTATION */
/*                       OF A PRINTER FORM FEED. */
/*               IFEED = CONTAINS THE INTEGER VALUE OF A PRINTER */
/*                       FORM FEED. */
/*                KINC = WORKING COPY OF INC.  MAY BE MODIFIED. */
/*                MINA = MINIMUM VALUE IN GROUP A. */
/*                MAXA = MAXIMUM VALUE IN GROUP A. */
/*               NENDA = THE PLACE IN IC( ) WHERE GROUP A ENDS. */
/*              KSTART = THE PLACE IN IC( ) WHERE GROUP A STARTS. */
/*               IBITA = NUMBER OF BITS NEEDED TO HOLD VALUES IN GROUP A. */
/*                MINB = MINIMUM VALUE IN GROUP B. */
/*                MAXB = MAXIMUM VALUE IN GROUP B. */
/*               NENDB = THE PLACE IN IC( ) WHERE GROUP B ENDS. */
/*               IBITB = NUMBER OF BITS NEEDED TO HOLD VALUES IN GROUP B. */
/*                MINC = MINIMUM VALUE IN GROUP C. */
/*                MAXC = MAXIMUM VALUE IN GROUP C. */
/*              KTOTAL = COUNT OF NUMBER OF VALUES IN IC( ) PROCESSED. */
/*               NOUNT = NUMBER OF VALUES ADDED TO GROUP A. */
/*               LMISS = 0 WHEN IS523 = 0.  WHEN PACKING INTO A */
/*                       SPECIFIC NUMBER OF BITS, SAY MBITS, */
/*                       THE MAXIMUM VALUE THAT CAN BE HANDLED IS */
/*                       2**MBITS-1.  WHEN IS523 = 1, INDICATING */
/*                       PRIMARY MISSING VALUES, THIS MAXIMUM VALUE */
/*                       IS RESERVED TO HOLD THE PRIMARY MISSING VALUE */
/*                       INDICATOR AND LMISS = 1.  WHEN IS523 = 2, */
/*                       THE VALUE JUST BELOW THE MAXIMUM (I.E., */
/*                       2**MBITS-2) IS RESERVED TO HOLD THE SECONDARY */
/*                       MISSING VALUE INDICATOR AND LMISS = 2. */
/*              LMINPK = LOCAL VALUE OF MINPK.  THIS WILL BE ADJUSTED */
/*                       UPWARD WHENEVER NDG IS NOT LARGE ENOUGH TO HOLD */
/*                       ALL THE GROUPS. */
/*              MALLOW = THE LARGEST ALLOWABLE VALUE FOR PACKING. */
/*              MISLLA = SET TO 1 WHEN ALL VALUES IN GROUP A ARE MISSING. */
/*                       THIS IS USED TO DISTINGUISH BETWEEN A REAL */
/*                       MINIMUM WHEN ALL VALUES ARE NOT MISSING */
/*                       AND A MINIMUM THAT HAS BEEN SET TO ZERO WHEN */
/*                       ALL VALUES ARE MISSING.  0 OTHERWISE. */
/*                       NOTE THAT THIS DOES NOT DISTINGUISH BETWEEN */
/*                       PRIMARY AND SECONDARY MISSING WHEN SECONDARY */
/*                       MISSING ARE PRESENT.  THIS MEANS THAT */
/*                       LBIT( ) WILL NOT BE ZERO WITH THE RESULTING */
/*                       COMPRESSION EFFICIENCY WHEN SECONDARY MISSING */
/*                       ARE PRESENT.  ALSO NOTE THAT A CHECK HAS BEEN */
/*                       MADE EARLIER TO DETERMINE THAT SECONDARY */
/*                       MISSING ARE REALLY THERE. */
/*              MISLLB = SET TO 1 WHEN ALL VALUES IN GROUP B ARE MISSING. */
/*                       THIS IS USED TO DISTINGUISH BETWEEN A REAL */
/*                       MINIMUM WHEN ALL VALUES ARE NOT MISSING */
/*                       AND A MINIMUM THAT HAS BEEN SET TO ZERO WHEN */
/*                       ALL VALUES ARE MISSING.  0 OTHERWISE. */
/*              MISLLC = PERFORMS THE SAME FUNCTION FOR GROUP C THAT */
/*                       MISLLA AND MISLLB DO FOR GROUPS B AND C, */
/*                       RESPECTIVELY. */
/*            IBXX2(J) = AN ARRAY THAT WHEN THIS ROUTINE IS FIRST ENTERED */
/*                       IS SET TO 2**J, J=0,30. IBXX2(30) = 2**30, WHICH */
/*                       IS THE LARGEST VALUE PACKABLE, BECAUSE 2**31 */
/*                       IS LARGER THAN THE INTEGER WORD SIZE. */
/*              IFIRST = SET BY DATA STATEMENT TO 0.  CHANGED TO 1 ON */
/*                       FIRST */
/*                       ENTRY WHEN IBXX2( ) IS FILLED. */
/*               MINAK = KEEPS TRACK OF THE LOCATION IN IC( ) WHERE THE */
/*                       MINIMUM VALUE IN GROUP A IS LOCATED. */
/*               MAXAK = DOES THE SAME AS MINAK, EXCEPT FOR THE MAXIMUM. */
/*               MINBK = THE SAME AS MINAK FOR GROUP B. */
/*               MAXBK = THE SAME AS MAXAK FOR GROUP B. */
/*               MINCK = THE SAME AS MINAK FOR GROUP C. */
/*               MAXCK = THE SAME AS MAXAK FOR GROUP C. */
/*                ADDA = KEEPS TRACK WHETHER OR NOT AN ATTEMPT TO ADD */
/*                       POINTS TO GROUP A WAS MADE.  IF SO, THEN ADDA */
/*                       KEEPS FROM TRYING TO PUT ONE BACK INTO B. */
/*                       (LOGICAL) */
/*              IBITBS = KEEPS CURRENT VALUE IF IBITB SO THAT LOOP */
/*                       ENDING AT 166 DOESN'T HAVE TO START AT */
/*                       IBITB = 0 EVERY TIME. */
/*           MISSLX(J) = MALLOW EXCEPT WHEN A GROUP IS ALL ONE VALUE (AND */
/*                       LBIT(J) = 0) AND THAT VALUE IS MISSING.  IN */
/*                       THAT CASE, MISSLX(J) IS MISSP OR MISSS.  THIS */
/*                       GETS INSERTED INTO JMIN(J) LATER AS THE */
/*                       MISSING INDICATOR; IT CAN'T BE PUT IN UNTIL */
/*                       THE END, BECAUSE JMIN( ) IS USED TO CALCULATE */
/*                       THE MAXIMUM NUMBER OF BITS (IBITS) NEEDED TO */
/*                       PACK JMIN( ). */
/*        1         2         3         4         5         6         7 X */

/*        NON SYSTEM SUBROUTINES CALLED */
/*           NONE */



/*        MISSLX( ) was AN AUTOMATIC ARRAY. */
    misslx = (integer *)calloc(*ndg,sizeof(integer));
    if( misslx == NULL )
    {
        *ier = -1;
        return 0;
    }

    /* Parameter adjustments */
    --ic;
    --nov;
    --lbit;
    --jmax;
    --jmin;

    /* Function Body */

    *ier = 0;
    iersav = 0;
/*     CALL TIMPR(KFILDO,KFILDO,'START PACK_GP        ') */
    *(unsigned char *)cfeed = (char) ifeed;

    ired = 0;
/*        IRED IS A FLAG.  WHEN ZERO, REDUCE WILL BE CALLED. */
/*        IF REDUCE ABORTS, IRED = 1 AND IS NOT CALLED.  IN */
/*        THIS CASE PACK_GP EXECUTES AGAIN EXCEPT FOR REDUCE. */

    if (*inc <= 0) {
  iersav = 717;
/*        WRITE(KFILDO,101)INC */
/* 101     FORMAT(/' ****INC ='I8,' NOT CORRECT IN PACK_GP.  1 IS USED.') */
    }

/*        THERE WILL BE A RESTART OF PACK_GP IF SUBROUTINE REDUCE */
/*        ABORTS.  THIS SHOULD NOT HAPPEN, BUT IF IT DOES, PACK_GP */
/*        WILL COMPLETE WITHOUT SUBROUTINE REDUCE.  A NON FATAL */
/*        DIAGNOSTIC RETURN IS PROVIDED. */

L102:
    /*kinc = max(*inc,1);*/
    kinc = (*inc > 1) ? *inc : 1;
    lminpk = *minpk;

/*         CALCULATE THE POWERS OF 2 THE FIRST TIME ENTERED. */

    if (ifirst == 0) {
  ifirst = 1;
  ibxx2[0] = 1;

  for (j = 1; j <= 30; ++j) {
      ibxx2[j] = ibxx2[j - 1] << 1;
/* L104: */
  }

    }

/*        THERE WILL BE A RESTART AT 105 IS NDG IS NOT LARGE ENOUGH. */
/*        A NON FATAL DIAGNOSTIC RETURN IS PROVIDED. */

L105:
    kstart = 1;
    ktotal = 0;
    *lx = 0;
    adda = FALSE_;
    lmiss = 0;
    if (*is523 == 1) {
  lmiss = 1;
    }
    if (*is523 == 2) {
  lmiss = 2;
    }

/*        ************************************* */

/*        THIS SECTION COMPUTES STATISTICS FOR GROUP A.  GROUP A IS */
/*        A GROUP OF SIZE LMINPK. */

/*        ************************************* */

    ibita = 0;
    mina = mallow;
    maxa = -mallow;
    minak = mallow;
    maxak = -mallow;

/*        FIND THE MIN AND MAX OF GROUP A.  THIS WILL INITIALLY BE OF */
/*        SIZE LMINPK (IF THERE ARE STILL LMINPK VALUES IN IC( )), BUT */
/*        WILL INCREASE IN SIZE IN INCREMENTS OF INC UNTIL A NEW */
/*        GROUP IS STARTED.  THE DEFINITION OF GROUP A IS DONE HERE */
/*        ONLY ONCE (UPON INITIAL ENTRY), BECAUSE A GROUP B CAN ALWAYS */
/*        BECOME A NEW GROUP A AFTER A IS PACKED, EXCEPT IF LMINPK */
/*        HAS TO BE INCREASED BECAUSE NDG IS TOO SMALL.  THEREFORE, */
/*        THE SEPARATE LOOPS FOR MISSING AND NON-MISSING HERE BUYS */
/*        ALMOST NOTHING. */

/* Computing MIN */
    i__1 = kstart + lminpk - 1;
    /*nenda = min(i__1,*nxy);*/
    nenda = (i__1 < *nxy) ? i__1 : *nxy;
    if (*nxy - nenda <= lminpk / 2) {
  nenda = *nxy;
    }
/*        ABOVE STATEMENT GUARANTEES THE LAST GROUP IS GT LMINPK/2 BY */
/*        MAKING THE ACTUAL GROUP LARGER.  IF A PROVISION LIKE THIS IS */
/*        NOT INCLUDED, THERE WILL MANY TIMES BE A VERY SMALL GROUP */
/*        AT THE END.  USE SEPARATE LOOPS FOR MISSING AND NO MISSING */
/*        VALUES FOR EFFICIENCY. */

/*        DETERMINE WHETHER THERE IS A LONG STRING OF THE SAME VALUE */
/*        UNLESS NENDA = NXY.  THIS MAY ALLOW A LARGE GROUP A TO */
/*        START WITH, AS WITH MISSING VALUES.   SEPARATE LOOPS FOR */
/*        MISSING OPTIONS.  THIS SECTION IS ONLY EXECUTED ONCE, */
/*        IN DETERMINING THE FIRST GROUP.  IT HELPS FOR AN ARRAY */
/*        OF MOSTLY MISSING VALUES OR OF ONE VALUE, SUCH AS */
/*        RADAR OR PRECIP DATA. */

    if (nenda != *nxy && ic[kstart] == ic[kstart + 1]) {
/*           NO NEED TO EXECUTE IF FIRST TWO VALUES ARE NOT EQUAL. */

  if (*is523 == 0) {
/*              THIS LOOP IS FOR NO MISSING VALUES. */

      i__1 = *nxy;
      for (k = kstart + 1; k <= i__1; ++k) {

    if (ic[k] != ic[kstart]) {
/* Computing MAX */
        i__2 = nenda;
            i__3 = k - 1;
        /*nenda = max(i__2,i__3);*/
        nenda = (i__2 > i__3) ? i__2 : i__3;
        goto L114;
    }

/* L111: */
      }

      nenda = *nxy;
/*              FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME. */

  } else if (*is523 == 1) {
/*              THIS LOOP IS FOR PRIMARY MISSING VALUES ONLY. */

      i__1 = *nxy;
      for (k = kstart + 1; k <= i__1; ++k) {

    if (ic[k] != *missp) {

        if (ic[k] != ic[kstart]) {
/* Computing MAX */
      i__2 = nenda;
            i__3 = k - 1;
      /*nenda = max(i__2,i__3);*/
      nenda = (i__2 > i__3) ? i__2 : i__3;
      goto L114;
        }

    }

/* L112: */
      }

      nenda = *nxy;
/*              FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME. */

  } else {
/*              THIS LOOP IS FOR PRIMARY AND SECONDARY MISSING VALUES. */

      i__1 = *nxy;
      for (k = kstart + 1; k <= i__1; ++k) {

    if (ic[k] != *missp && ic[k] != *misss) {

        if (ic[k] != ic[kstart]) {
/* Computing MAX */
      i__2 = nenda;
            i__3 = k - 1;
      /*nenda = max(i__2,i__3);*/
      nenda = (i__2 > i__3) ? i__2 : i__3;
      goto L114;
        }

    }

/* L113: */
      }

      nenda = *nxy;
/*              FALL THROUGH THE LOOP MEANS ALL VALUES ARE THE SAME. */
  }

    }

L114:
    if (*is523 == 0) {

  i__1 = nenda;
  for (k = kstart; k <= i__1; ++k) {
      if (ic[k] < mina) {
    mina = ic[k];
    minak = k;
      }
      if (ic[k] > maxa) {
    maxa = ic[k];
    maxak = k;
      }
/* L115: */
  }

    } else if (*is523 == 1) {

  i__1 = nenda;
  for (k = kstart; k <= i__1; ++k) {
      if (ic[k] == *missp) {
    goto L117;
      }
      if (ic[k] < mina) {
    mina = ic[k];
    minak = k;
      }
      if (ic[k] > maxa) {
    maxa = ic[k];
    maxak = k;
      }
L117:
      ;
  }

    } else {

  i__1 = nenda;
  for (k = kstart; k <= i__1; ++k) {
      if (ic[k] == *missp || ic[k] == *misss) {
    goto L120;
      }
      if (ic[k] < mina) {
    mina = ic[k];
    minak = k;
      }
      if (ic[k] > maxa) {
    maxa = ic[k];
    maxak = k;
      }
L120:
      ;
  }

    }

    kounta = nenda - kstart + 1;

/*        INCREMENT KTOTAL AND FIND THE BITS NEEDED TO PACK THE A GROUP. */

    ktotal += kounta;
    mislla = 0;
    if (mina != mallow) {
  goto L125;
    }
/*        ALL MISSING VALUES MUST BE ACCOMMODATED. */
    mina = 0;
    maxa = 0;
    mislla = 1;
    ibitb = 0;
    if (*is523 != 2) {
  goto L130;
    }
/*        WHEN ALL VALUES ARE MISSING AND THERE ARE NO */
/*        SECONDARY MISSING VALUES, IBITA = 0. */
/*        OTHERWISE, IBITA MUST BE CALCULATED. */

L125:
    itest = maxa - mina + lmiss;

    for (ibita = 0; ibita <= 30; ++ibita) {
  if (itest < ibxx2[ibita]) {
      goto L130;
  }
/* ***        THIS TEST IS THE SAME AS: */
/* ***     IF(MAXA-MINA.LT.IBXX2(IBITA)-LMISS)GO TO 130 */
/* L126: */
    }

/*     WRITE(KFILDO,127)MAXA,MINA */
/* 127  FORMAT(' ****ERROR IN PACK_GP.  VALUE WILL NOT PACK IN 30 BITS.', */
/*    1       '  MAXA ='I13,'  MINA ='I13,'.  ERROR AT 127.') */
    *ier = 706;
    goto L900;

L130:

/* ***D     WRITE(KFILDO,131)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA */
/* ***D131  FORMAT(' AT 130, KOUNTA ='I8,'  KTOTAL ='I8,'  MINA ='I8, */
/* ***D    1       '  MAXA ='I8,'  IBITA ='I3,'  MISLLA ='I3) */

L133:
    if (ktotal >= *nxy) {
  goto L200;
    }

/*        ************************************* */

/*        THIS SECTION COMPUTES STATISTICS FOR GROUP B.  GROUP B IS A */
/*        GROUP OF SIZE LMINPK IMMEDIATELY FOLLOWING GROUP A. */

/*        ************************************* */

L140:
    minb = mallow;
    maxb = -mallow;
    minbk = mallow;
    maxbk = -mallow;
    ibitbs = 0;
    mstart = ktotal + 1;

/*        DETERMINE WHETHER THERE IS A LONG STRING OF THE SAME VALUE. */
/*        THIS WORKS WHEN THERE ARE NO MISSING VALUES. */

    nendb = 1;

    if (mstart < *nxy) {

  if (*is523 == 0) {
/*              THIS LOOP IS FOR NO MISSING VALUES. */

      i__1 = *nxy;
      for (k = mstart + 1; k <= i__1; ++k) {

    if (ic[k] != ic[mstart]) {
        nendb = k - 1;
        goto L150;
    }

/* L145: */
      }

      nendb = *nxy;
/*              FALL THROUGH THE LOOP MEANS ALL REMAINING VALUES */
/*              ARE THE SAME. */
  }

    }

L150:
/* Computing MAX */
/* Computing MIN */
    i__3 = ktotal + lminpk;
    /*i__1 = nendb, i__2 = min(i__3,*nxy);*/
    i__1 = nendb;
    i__2 = (i__3 < *nxy) ? i__3 : *nxy;
    /*nendb = max(i__1,i__2);*/
    nendb = (i__1 > i__2) ? i__1 : i__2;
/* **** 150  NENDB=MIN(KTOTAL+LMINPK,NXY) */

    if (*nxy - nendb <= lminpk / 2) {
  nendb = *nxy;
    }
/*        ABOVE STATEMENT GUARANTEES THE LAST GROUP IS GT LMINPK/2 BY */
/*        MAKING THE ACTUAL GROUP LARGER.  IF A PROVISION LIKE THIS IS */
/*        NOT INCLUDED, THERE WILL MANY TIMES BE A VERY SMALL GROUP */
/*        AT THE END.  USE SEPARATE LOOPS FOR MISSING AND NO MISSING */

/*        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES */
/*        FOR EFFICIENCY. */

    if (*is523 == 0) {

  i__1 = nendb;
  for (k = mstart; k <= i__1; ++k) {
      if (ic[k] <= minb) {
    minb = ic[k];
/*              NOTE LE, NOT LT.  LT COULD BE USED BUT THEN A */
/*              RECOMPUTE OVER THE WHOLE GROUP WOULD BE NEEDED */
/*              MORE OFTEN.  SAME REASONING FOR GE AND OTHER */
/*              LOOPS BELOW. */
    minbk = k;
      }
      if (ic[k] >= maxb) {
    maxb = ic[k];
    maxbk = k;
      }
/* L155: */
  }

    } else if (*is523 == 1) {

  i__1 = nendb;
  for (k = mstart; k <= i__1; ++k) {
      if (ic[k] == *missp) {
    goto L157;
      }
      if (ic[k] <= minb) {
    minb = ic[k];
    minbk = k;
      }
      if (ic[k] >= maxb) {
    maxb = ic[k];
    maxbk = k;
      }
L157:
      ;
  }

    } else {

  i__1 = nendb;
  for (k = mstart; k <= i__1; ++k) {
      if (ic[k] == *missp || ic[k] == *misss) {
    goto L160;
      }
      if (ic[k] <= minb) {
    minb = ic[k];
    minbk = k;
      }
      if (ic[k] >= maxb) {
    maxb = ic[k];
    maxbk = k;
      }
L160:
      ;
  }

    }

    kountb = nendb - ktotal;
    misllb = 0;
    if (minb != mallow) {
  goto L165;
    }
/*        ALL MISSING VALUES MUST BE ACCOMMODATED. */
    minb = 0;
    maxb = 0;
    misllb = 1;
    ibitb = 0;

    if (*is523 != 2) {
  goto L170;
    }
/*        WHEN ALL VALUES ARE MISSING AND THERE ARE NO SECONDARY */
/*        MISSING VALUES, IBITB = 0.  OTHERWISE, IBITB MUST BE */
/*        CALCULATED. */

L165:
    if( (GIntBig)maxb - minb < INT_MIN ||
        (GIntBig)maxb - minb > INT_MAX )
    {
        *ier = -1;
        free(misslx);
        return 0;
    }

    for (ibitb = ibitbs; ibitb <= 30; ++ibitb) {
  if (maxb - minb < ibxx2[ibitb] - lmiss) {
      goto L170;
  }
/* L166: */
    }

/*     WRITE(KFILDO,167)MAXB,MINB */
/* 167  FORMAT(' ****ERROR IN PACK_GP.  VALUE WILL NOT PACK IN 30 BITS.', */
/*    1       '  MAXB ='I13,'  MINB ='I13,'.  ERROR AT 167.') */
    *ier = 706;
    goto L900;

/*        COMPARE THE BITS NEEDED TO PACK GROUP B WITH THOSE NEEDED */
/*        TO PACK GROUP A.  IF IBITB GE IBITA, TRY TO ADD TO GROUP A. */
/*        IF NOT, TRY TO ADD A'S POINTS TO B, UNLESS ADDITION TO A */
/*        HAS BEEN DONE.  THIS LATTER IS CONTROLLED WITH ADDA. */

L170:

/* ***D     WRITE(KFILDO,171)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA, */
/* ***D    1                               MINB,MAXB,IBITB,MISLLB */
/* ***D171  FORMAT(' AT 171, KOUNTA ='I8,'  KTOTAL ='I8,'  MINA ='I8, */
/* ***D    1       '  MAXA ='I8,'  IBITA ='I3,'  MISLLA ='I3, */
/* ***D    2       '  MINB ='I8,'  MAXB ='I8,'  IBITB ='I3,'  MISLLB ='I3) */

    if (ibitb >= ibita) {
  goto L180;
    }
    if (adda) {
  goto L200;
    }

/*        ************************************* */

/*        GROUP B REQUIRES LESS BITS THAN GROUP A.  PUT AS MANY OF A'S */
/*        POINTS INTO B AS POSSIBLE WITHOUT EXCEEDING THE NUMBER OF */
/*        BITS NECESSARY TO PACK GROUP B. */

/*        ************************************* */

    kounts = kounta;
/*        KOUNTA REFERS TO THE PRESENT GROUP A. */
    mintst = minb;
    maxtst = maxb;
    mintstk = minbk;
    maxtstk = maxbk;

/*        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES */
/*        FOR EFFICIENCY. */

    if (*is523 == 0) {

  i__1 = kstart;
  for (k = ktotal; k >= i__1; --k) {
/*           START WITH THE END OF THE GROUP AND WORK BACKWARDS. */
      if (ic[k] < minb) {
    mintst = ic[k];
    mintstk = k;
      } else if (ic[k] > maxb) {
    maxtst = ic[k];
    maxtstk = k;
      }
      if (maxtst - mintst >= ibxx2[ibitb]) {
    goto L174;
      }
/*           NOTE THAT FOR THIS LOOP, LMISS = 0. */
      minb = mintst;
      maxb = maxtst;
      minbk = mintstk;
      maxbk = maxtstk;
      --kounta;
/*           THERE IS ONE LESS POINT NOW IN A. */
/* L1715: */
  }

    } else if (*is523 == 1) {

  i__1 = kstart;
  for (k = ktotal; k >= i__1; --k) {
/*           START WITH THE END OF THE GROUP AND WORK BACKWARDS. */
      if (ic[k] == *missp) {
    goto L1718;
      }
      if (ic[k] < minb) {
    mintst = ic[k];
    mintstk = k;
      } else if (ic[k] > maxb) {
    maxtst = ic[k];
    maxtstk = k;
      }
      if (maxtst - mintst >= ibxx2[ibitb] - lmiss) {
    goto L174;
      }
/*           FOR THIS LOOP, LMISS = 1. */
      minb = mintst;
      maxb = maxtst;
      minbk = mintstk;
      maxbk = maxtstk;
      misllb = 0;
/*           WHEN THE POINT IS NON MISSING, MISLLB SET = 0. */
L1718:
      --kounta;
/*           THERE IS ONE LESS POINT NOW IN A. */
/* L1719: */
  }

    } else {

  i__1 = kstart;
  for (k = ktotal; k >= i__1; --k) {
/*           START WITH THE END OF THE GROUP AND WORK BACKWARDS. */
      if (ic[k] == *missp || ic[k] == *misss) {
    goto L1729;
      }
      if (ic[k] < minb) {
    mintst = ic[k];
    mintstk = k;
      } else if (ic[k] > maxb) {
    maxtst = ic[k];
    maxtstk = k;
      }
      if (maxtst - mintst >= ibxx2[ibitb] - lmiss) {
    goto L174;
      }
/*           FOR THIS LOOP, LMISS = 2. */
      minb = mintst;
      maxb = maxtst;
      minbk = mintstk;
      maxbk = maxtstk;
      misllb = 0;
/*           WHEN THE POINT IS NON MISSING, MISLLB SET = 0. */
L1729:
      --kounta;
/*           THERE IS ONE LESS POINT NOW IN A. */
/* L173: */
  }

    }

/*        AT THIS POINT, KOUNTA CONTAINS THE NUMBER OF POINTS TO CLOSE */
/*        OUT GROUP A WITH.  GROUP B NOW STARTS WITH KSTART+KOUNTA AND */
/*        ENDS WITH NENDB.  MINB AND MAXB HAVE BEEN ADJUSTED AS */
/*        NECESSARY TO REFLECT GROUP B (EVEN THOUGH THE NUMBER OF BITS */
/*        NEEDED TO PACK GROUP B HAVE NOT INCREASED, THE END POINTS */
/*        OF THE RANGE MAY HAVE). */

L174:
    if (kounta == kounts) {
  goto L200;
    }
/*        ON TRANSFER, GROUP A WAS NOT CHANGED.  CLOSE IT OUT. */

/*        ONE OR MORE POINTS WERE TAKEN OUT OF A.  RANGE AND IBITA */
/*        MAY HAVE TO BE RECOMPUTED; IBITA COULD BE LESS THAN */
/*        ORIGINALLY COMPUTED.  IN FACT, GROUP A CAN NOW CONTAIN */
/*        ONLY ONE POINT AND BE PACKED WITH ZERO BITS */
/*        (UNLESS MISSS NE 0). */

    nouta = kounts - kounta;
    ktotal -= nouta;
    kountb += nouta;
    if (nenda - nouta > minak && nenda - nouta > maxak) {
  goto L200;
    }
/*        WHEN THE ABOVE TEST IS MET, THE MIN AND MAX OF THE */
/*        CURRENT GROUP A WERE WITHIN THE OLD GROUP A, SO THE */
/*        RANGE AND IBITA DO NOT NEED TO BE RECOMPUTED. */
/*        NOTE THAT MINAK AND MAXAK ARE NO LONGER NEEDED. */
    ibita = 0;
    mina = mallow;
    maxa = -mallow;

/*        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES */
/*        FOR EFFICIENCY. */

    if (*is523 == 0) {

  i__1 = nenda - nouta;
  for (k = kstart; k <= i__1; ++k) {
      if (ic[k] < mina) {
    mina = ic[k];
      }
      if (ic[k] > maxa) {
    maxa = ic[k];
      }
/* L1742: */
  }

    } else if (*is523 == 1) {

  i__1 = nenda - nouta;
  for (k = kstart; k <= i__1; ++k) {
      if (ic[k] == *missp) {
    goto L1744;
      }
      if (ic[k] < mina) {
    mina = ic[k];
      }
      if (ic[k] > maxa) {
    maxa = ic[k];
      }
L1744:
      ;
  }

    } else {

  i__1 = nenda - nouta;
  for (k = kstart; k <= i__1; ++k) {
      if (ic[k] == *missp || ic[k] == *misss) {
    goto L175;
      }
      if (ic[k] < mina) {
    mina = ic[k];
      }
      if (ic[k] > maxa) {
    maxa = ic[k];
      }
L175:
      ;
  }

    }

    mislla = 0;
    if (mina != mallow) {
  goto L1750;
    }
/*        ALL MISSING VALUES MUST BE ACCOMMODATED. */
    mina = 0;
    maxa = 0;
    mislla = 1;
    if (*is523 != 2) {
  goto L177;
    }
/*        WHEN ALL VALUES ARE MISSING AND THERE ARE NO SECONDARY */
/*        MISSING VALUES IBITA = 0 AS ORIGINALLY SET.  OTHERWISE, */
/*        IBITA MUST BE CALCULATED. */

L1750:
    itest = maxa - mina + lmiss;

    for (ibita = 0; ibita <= 30; ++ibita) {
  if (itest < ibxx2[ibita]) {
      goto L177;
  }
/* ***        THIS TEST IS THE SAME AS: */
/* ***         IF(MAXA-MINA.LT.IBXX2(IBITA)-LMISS)GO TO 177 */
/* L176: */
    }

/*     WRITE(KFILDO,1760)MAXA,MINA */
/* 1760 FORMAT(' ****ERROR IN PACK_GP.  VALUE WILL NOT PACK IN 30 BITS.', */
/*    1       '  MAXA ='I13,'  MINA ='I13,'.  ERROR AT 1760.') */
    *ier = 706;
    goto L900;

L177:
    goto L200;

/*        ************************************* */

/*        AT THIS POINT, GROUP B REQUIRES AS MANY BITS TO PACK AS GROUPA. */
/*        THEREFORE, TRY TO ADD INC POINTS TO GROUP A WITHOUT INCREASING */
/*        IBITA.  THIS AUGMENTED GROUP IS CALLED GROUP C. */

/*        ************************************* */

L180:
    if (mislla == 1) {
  minc = mallow;
  minck = mallow;
  maxc = -mallow;
  maxck = -mallow;
    } else {
  minc = mina;
  maxc = maxa;
  minck = minak;
  maxck = minak;
    }

    nount = 0;
    if (*nxy - (ktotal + kinc) <= lminpk / 2) {
  kinc = *nxy - ktotal;
    }
/*        ABOVE STATEMENT CONSTRAINS THE LAST GROUP TO BE NOT LESS THAN */
/*        LMINPK/2 IN SIZE.  IF A PROVISION LIKE THIS IS NOT INCLUDED, */
/*        THERE WILL MANY TIMES BE A VERY SMALL GROUP AT THE END. */

/*        USE SEPARATE LOOPS FOR MISSING AND NO MISSING VALUES */
/*        FOR EFFICIENCY.  SINCE KINC IS USUALLY 1, USING SEPARATE */
/*        LOOPS HERE DOESN'T BUY MUCH.  A MISSING VALUE WILL ALWAYS */
/*        TRANSFER BACK TO GROUP A. */

    if (*is523 == 0) {

/* Computing MIN */
  i__2 = ktotal + kinc;
  /*i__1 = min(i__2,*nxy);*/
  i__1 = (i__2 < *nxy) ? i__2 : *nxy;
  for (k = ktotal + 1; k <= i__1; ++k) {
      if (ic[k] < minc) {
    minc = ic[k];
    minck = k;
      }
      if (ic[k] > maxc) {
    maxc = ic[k];
    maxck = k;
      }
      ++nount;
/* L185: */
  }

    } else if (*is523 == 1) {

/* Computing MIN */
  i__2 = ktotal + kinc;
  /*i__1 = min(i__2,*nxy);*/
  i__1 = (i__2 < *nxy) ? i__2 : *nxy;
  for (k = ktotal + 1; k <= i__1; ++k) {
      if (ic[k] == *missp) {
    goto L186;
      }
      if (ic[k] < minc) {
    minc = ic[k];
    minck = k;
      }
      if (ic[k] > maxc) {
    maxc = ic[k];
    maxck = k;
      }
L186:
      ++nount;
/* L187: */
  }

    } else {

/* Computing MIN */
  i__2 = ktotal + kinc;
  /*i__1 = min(i__2,*nxy);*/
  i__1 = (i__2 < *nxy) ? i__2 : *nxy;
  for (k = ktotal + 1; k <= i__1; ++k) {
      if (ic[k] == *missp || ic[k] == *misss) {
    goto L189;
      }
      if (ic[k] < minc) {
    minc = ic[k];
    minck = k;
      }
      if (ic[k] > maxc) {
    maxc = ic[k];
    maxck = k;
      }
L189:
      ++nount;
/* L190: */
  }

    }

/* ***D     WRITE(KFILDO,191)KOUNTA,KTOTAL,MINA,MAXA,IBITA,MISLLA, */
/* ***D    1   MINC,MAXC,NOUNT,IC(KTOTAL),IC(KTOTAL+1) */
/* ***D191  FORMAT(' AT 191, KOUNTA ='I8,'  KTOTAL ='I8,'  MINA ='I8, */
/* ***D    1       '  MAXA ='I8,'  IBITA ='I3,'  MISLLA ='I3, */
/* ***D    2       '  MINC ='I8,'  MAXC ='I8, */
/* ***D    3       '  NOUNT ='I5,'  IC(KTOTAL) ='I9,'  IC(KTOTAL+1) =',I9) */

/*        IF THE NUMBER OF BITS NEEDED FOR GROUP C IS GT IBITA, */
/*        THEN THIS GROUP A IS A GROUP TO PACK. */

    if (minc == mallow) {
  minc = mina;
  maxc = maxa;
  minck = minak;
  maxck = maxak;
  misllc = 1;
  goto L195;
/*           WHEN THE NEW VALUE(S) ARE MISSING, THEY CAN ALWAYS */
/*           BE ADDED. */

    } else {
  misllc = 0;
    }

    if (maxc - minc >= ibxx2[ibita] - lmiss) {
  goto L200;
    }

/*        THE BITS NECESSARY FOR GROUP C HAS NOT INCREASED FROM THE */
/*        BITS NECESSARY FOR GROUP A.  ADD THIS POINT(S) TO GROUP A. */
/*        COMPUTE THE NEXT GROUP B, ETC., UNLESS ALL POINTS HAVE BEEN */
/*        USED. */

L195:
    ktotal += nount;
    kounta += nount;
    mina = minc;
    maxa = maxc;
    minak = minck;
    maxak = maxck;
    mislla = misllc;
    adda = TRUE_;
    if (ktotal >= *nxy) {
  goto L200;
    }

    if (minbk > ktotal && maxbk > ktotal) {
  mstart = nendb + 1;
/*           THE MAX AND MIN OF GROUP B WERE NOT FROM THE POINTS */
/*           REMOVED, SO THE WHOLE GROUP DOES NOT HAVE TO BE LOOKED */
/*           AT TO DETERMINE THE NEW MAX AND MIN.  RATHER START */
/*           JUST BEYOND THE OLD NENDB. */
  ibitbs = ibitb;
  nendb = 1;
  goto L150;
    } else {
  goto L140;
    }

/*        ************************************* */

/*        GROUP A IS TO BE PACKED.  STORE VALUES IN JMIN( ), JMAX( ), */
/*        LBIT( ), AND NOV( ). */

/*        ************************************* */

L200:
    ++(*lx);
    if (*lx <= *ndg) {
  goto L205;
    }
    lminpk += lminpk / 2;
/*     WRITE(KFILDO,201)NDG,LMINPK,LX */
/* 201  FORMAT(' ****NDG ='I5,' NOT LARGE ENOUGH.', */
/*    1       '  LMINPK IS INCREASED TO 'I3,' FOR THIS FIELD.'/ */
/*    2       '  LX = 'I10) */
    iersav = 716;
    goto L105;

L205:
    jmin[*lx] = mina;
    jmax[*lx] = maxa;
    lbit[*lx] = ibita;
    nov[*lx] = kounta;
    kstart = ktotal + 1;

    if (mislla == 0) {
  misslx[*lx - 1] = mallow;
    } else {
  misslx[*lx - 1] = ic[ktotal];
/*           IC(KTOTAL) WAS THE LAST VALUE PROCESSED.  IF MISLLA NE 0, */
/*           THIS MUST BE THE MISSING VALUE FOR THIS GROUP. */
    }

/* ***D     WRITE(KFILDO,206)MISLLA,IC(KTOTAL),KTOTAL,LX,JMIN(LX),JMAX(LX), */
/* ***D    1                 LBIT(LX),NOV(LX),MISSLX(LX) */
/* ***D206  FORMAT(' AT 206,  MISLLA ='I2,'  IC(KTOTAL) ='I5,'  KTOTAL ='I8, */
/* ***D    1       '  LX ='I6,'  JMIN(LX) ='I8,'  JMAX(LX) ='I8, */
/* ***D    2       '  LBIT(LX) ='I5,'  NOV(LX) ='I8,'  MISSLX(LX) =',I7) */

    if (ktotal >= *nxy) {
  goto L209;
    }

/*        THE NEW GROUP A WILL BE THE PREVIOUS GROUP B.  SET LIMITS, ETC. */

    ibita = ibitb;
    mina = minb;
    maxa = maxb;
    minak = minbk;
    maxak = maxbk;
    mislla = misllb;
    nenda = nendb;
    kounta = kountb;
    ktotal += kounta;
    adda = FALSE_;
    goto L133;

/*        ************************************* */

/*        CALCULATE IBIT, THE NUMBER OF BITS NEEDED TO HOLD THE GROUP */
/*        MINIMUM VALUES. */

/*        ************************************* */

L209:
    *ibit = 0;

    i__1 = *lx;
    for (l = 1; l <= i__1; ++l) {
L210:
        if( *ibit == 31 )
        {
            *ier = -1;
            goto L900;
        }
  if (jmin[l] < ibxx2[*ibit]) {
      goto L220;
  }
  ++(*ibit);
  goto L210;
L220:
  ;
    }

/*        INSERT THE VALUE IN JMIN( ) TO BE USED FOR ALL MISSING */
/*        VALUES WHEN LBIT( ) = 0.  WHEN SECONDARY MISSING */
/*        VALUES CAN BE PRESENT, LBIT(L) WILL NOT = 0. */

    if (*is523 == 1) {

  i__1 = *lx;
  for (l = 1; l <= i__1; ++l) {

      if (lbit[l] == 0) {

    if (misslx[l - 1] == *missp) {
        jmin[l] = ibxx2[*ibit] - 1;
    }

      }

/* L226: */
  }

    }

/*        ************************************* */

/*        CALCULATE JBIT, THE NUMBER OF BITS NEEDED TO HOLD THE BITS */
/*        NEEDED TO PACK THE VALUES IN THE GROUPS.  BUT FIND AND */
/*        REMOVE THE REFERENCE VALUE FIRST. */

/*        ************************************* */

/*     WRITE(KFILDO,228)CFEED,LX */
/* 228  FORMAT(A1,/' *****************************************' */
/*    1          /' THE GROUP WIDTHS LBIT( ) FOR ',I8,' GROUPS' */
/*    2          /' *****************************************') */
/*     WRITE(KFILDO,229) (LBIT(J),J=1,MIN(LX,100)) */
/* 229  FORMAT(/' '20I6) */

    *lbitref = lbit[1];

    i__1 = *lx;
    for (k = 1; k <= i__1; ++k) {
  if (lbit[k] < *lbitref) {
      *lbitref = lbit[k];
  }
/* L230: */
    }

    if (*lbitref != 0) {

  i__1 = *lx;
  for (k = 1; k <= i__1; ++k) {
      lbit[k] -= *lbitref;
/* L240: */
  }

    }

/*     WRITE(KFILDO,241)CFEED,LBITREF */
/* 241  FORMAT(A1,/' *****************************************' */
/*    1          /' THE GROUP WIDTHS LBIT( ) AFTER REMOVING REFERENCE ', */
/*    2             I8, */
/*    3          /' *****************************************') */
/*     WRITE(KFILDO,242) (LBIT(J),J=1,MIN(LX,100)) */
/* 242  FORMAT(/' '20I6) */

    *jbit = 0;

    i__1 = *lx;
    for (k = 1; k <= i__1; ++k) {
L310:
  if (lbit[k] < ibxx2[*jbit]) {
      goto L320;
  }
  ++(*jbit);
  goto L310;
L320:
  ;
    }

/*        ************************************* */

/*        CALCULATE KBIT, THE NUMBER OF BITS NEEDED TO HOLD THE NUMBER */
/*        OF VALUES IN THE GROUPS.  BUT FIND AND REMOVE THE */
/*        REFERENCE FIRST. */

/*        ************************************* */

/*     WRITE(KFILDO,321)CFEED,LX */
/* 321  FORMAT(A1,/' *****************************************' */
/*    1          /' THE GROUP SIZES NOV( ) FOR ',I8,' GROUPS' */
/*    2          /' *****************************************') */
/*     WRITE(KFILDO,322) (NOV(J),J=1,MIN(LX,100)) */
/* 322  FORMAT(/' '20I6) */

    *novref = nov[1];

    i__1 = *lx;
    for (k = 1; k <= i__1; ++k) {
  if (nov[k] < *novref) {
      *novref = nov[k];
  }
/* L400: */
    }

    if (*novref > 0) {

  i__1 = *lx;
  for (k = 1; k <= i__1; ++k) {
      nov[k] -= *novref;
/* L405: */
  }

    }

/*     WRITE(KFILDO,406)CFEED,NOVREF */
/* 406  FORMAT(A1,/' *****************************************' */
/*    1          /' THE GROUP SIZES NOV( ) AFTER REMOVING REFERENCE ',I8, */
/*    2          /' *****************************************') */
/*     WRITE(KFILDO,407) (NOV(J),J=1,MIN(LX,100)) */
/* 407  FORMAT(/' '20I6) */
/*     WRITE(KFILDO,408)CFEED */
/* 408  FORMAT(A1,/' *****************************************' */
/*    1          /' THE GROUP REFERENCES JMIN( )' */
/*    2          /' *****************************************') */
/*     WRITE(KFILDO,409) (JMIN(J),J=1,MIN(LX,100)) */
/* 409  FORMAT(/' '20I6) */

    *kbit = 0;

    i__1 = *lx;
    for (k = 1; k <= i__1; ++k) {
L410:
  if (nov[k] < ibxx2[*kbit]) {
      goto L420;
  }
  ++(*kbit);
  goto L410;
L420:
  ;
    }

/*        DETERMINE WHETHER THE GROUP SIZES SHOULD BE REDUCED */
/*        FOR SPACE EFFICIENCY. */

    if (ired == 0) {
  reduce(kfildo, &jmin[1], &jmax[1], &lbit[1], &nov[1], lx, ndg, ibit,
    jbit, kbit, novref, ibxx2, ier);

  if (*ier == 714 || *ier == 715) {
/*              REDUCE HAS ABORTED.  REEXECUTE PACK_GP WITHOUT REDUCE. */
/*              PROVIDE FOR A NON FATAL RETURN FROM REDUCE. */
      iersav = *ier;
      ired = 1;
      *ier = 0;
      goto L102;
  }

    }

    free(misslx);
    misslx=0;

/*     CALL TIMPR(KFILDO,KFILDO,'END   PACK_GP        ') */
    if (iersav != 0) {
  *ier = iersav;
  return 0;
    }

/* 900  IF(IER.NE.0)RETURN1 */

L900:
    free(misslx);
    return 0;
} /* pack_gp__ */


Coverage Report

Created: 2026-09-26 08:22