pack_gp.c

Go to the documentation of this file.

 
/*#include "f2c.h"*/
#include "grib2_int.h"
#include <stdlib.h>
 
#define TRUE_ (1)  
#define FALSE_ (0) 
int
pack_gp(g2int *kfildo, g2int *ic, g2int *nxy,
        g2int *is523, g2int *minpk, g2int *inc, g2int *missp, g2int *misss,
        g2int *jmin, g2int *jmax, g2int *lbit, g2int *nov,
        g2int *ndg, g2int *lx, g2int *ibit, g2int *jbit, g2int *kbit,
        g2int *novref, g2int *lbitref, g2int *ier)
{
    /* Initialized data */
 
    const g2int mallow = 1073741825; /*  MALLOW=2**30+1  */
    static g2int ifeed = 12;
    static g2int ifirst = 0;
 
    /* System generated locals */
    g2int i__1, i__2, i__3;
 
    /* Local variables */
    static g2int j, k, l;
    static g2int adda;
    static g2int ired, kinc, mina, maxa, minb, maxb, minc, maxc, ibxx2[31];
    static char cfeed[1];
    static g2int nenda, nendb, ibita, ibitb, minak, minbk, maxak, maxbk,
        minck, maxck, nouta, lmiss, itest, nount;
    extern /* Subroutine */ int reduce(g2int *, g2int *, g2int *,
                                       g2int *, g2int *, g2int *, g2int *, g2int *, g2int *,
                                       g2int *, g2int *, g2int *, g2int *);
    static g2int ibitbs, mislla, misllb, misllc, iersav, lminpk, ktotal,
        kounta, kountb, kstart, mstart, mintst, maxtst,
        kounts, mintstk, maxtstk;
    g2int *misslx;
 
    /*        NON SYSTEM SUBROUTINES CALLED */
    /*           NONE */
 
    /*        MISSLX( ) was AN AUTOMATIC ARRAY. */
    misslx = (g2int *)calloc(*ndg, sizeof(g2int));
 
    /* 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:
    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 (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;
        }
    }
 
    if (misslx != 0)
    {
        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:
    if (misslx != 0)
        free(misslx);
    return 0;
} /* pack_gp__ */