/*  MULTIPLE MINIMUM DEGREE ROW RE-ORDERING ALGORITHM 
 *
 *  Modified to work with Fortran-style arrays and be thread-safe.
 *
 */

#include <math.h>

int genmmd(int* neqns, int* xadj, int* adjncy, int* invp, int* perm,
           int* delta, int* dhead, int* qsize, int* llist, int* marker,
           int*  maxint, int* nofsub);

static int mmdint_(int* neqns, int* xadj, int* adjncy, int* dhead, int* dforw,
            int* dbakw, int* qsize, int* llist, int* marker);
static int mmdelm_(int* mdnode, int* xadj, int* adjncy, int* dhead, int* dforw,
            int* dbakw, int* qsize, int* llist, int* marker,
            int* maxint, int* tag);
static int mmdupd_(int* ehead, int* neqns, int* xadj, int* adjncy, int* delta,
            int* mdeg, int* dhead, int* dforw, int* dbakw, int* qsize,
            int* llist, int* marker, int* maxint, int* tag);
static int mmdnum_(int* neqns, int* perm, int* invp, int* qsize);

//=============================================================================

/* genmmd.f -- translated by f2c (version of 23 April 1993  18:34:30).
   You must link the resulting object file with the libraries:
        -lf2c -lm   (in that order)
*/

//#include "f2c.h"

/* Sivan: I modified INTEGER*2 -> INTEGER*4 */
/* *************************************************************** */
/* *************************************************************** */
/* ****     GENMMD ..... MULTIPLE MINIMUM EXTERNAL DEGREE     **** */
/* *************************************************************** */
/* *************************************************************** */

/*     AUTHOR - JOSEPH W.H. LIU */
/*              DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */

/*     PURPOSE - THIS ROUTINE IMPLEMENTS THE MINIMUM DEGREE */
/*        ALGORITHM.  IT MAKES USE OF THE IMPLICIT REPRESENTATION */
/*        OF ELIMINATION GRAPHS BY QUOTIENT GRAPHS, AND THE */
/*        NOTION OF INDISTINGUISHABLE NODES.  IT ALSO IMPLEMENTS */
/*        THE MODIFICATIONS BY MULTIPLE ELIMINATION AND MINIMUM */
/*        EXTERNAL DEGREE. */
/*        --------------------------------------------- */
/*        CAUTION - THE ADJACENCY VECTOR ADJNCY WILL BE */
/*        DESTROYED. */
/*        --------------------------------------------- */

/*     INPUT PARAMETERS - */
/*        NEQNS  - NUMBER OF EQUATIONS. */
/*        (XADJ,ADJNCY) - THE ADJACENCY STRUCTURE. */
/*        DELTA  - TOLERANCE VALUE FOR MULTIPLE ELIMINATION. */
/*        MAXINT - MAXIMUM MACHINE REPRESENTABLE (SHORT) INTEGER */
/*                 (ANY SMALLER ESTIMATE WILL DO) FOR MARKING */
/*                 NODES. */

/*     OUTPUT PARAMETERS - */
/*        PERM   - THE MINIMUM DEGREE ORDERING. */
/*        INVP   - THE INVERSE OF PERM. */
/*        NOFSUB - AN UPPER BOUND ON THE NUMBER OF NONZERO */
/*                 SUBSCRIPTS FOR THE COMPRESSED STORAGE SCHEME. */

/*     WORKING PARAMETERS - */
/*        DHEAD  - VECTOR FOR HEAD OF DEGREE LISTS. */
/*        INVP   - USED TEMPORARILY FOR DEGREE FORWARD LINK. */
/*        PERM   - USED TEMPORARILY FOR DEGREE BACKWARD LINK. */
/*        QSIZE  - VECTOR FOR SIZE OF SUPERNODES. */
/*        LLIST  - VECTOR FOR TEMPORARY LINKED LISTS. */
/*        MARKER - A TEMPORARY MARKER VECTOR. */

/*     PROGRAM SUBROUTINES - */
/*        MMDELM, MMDINT, MMDNUM, MMDUPD. */

/* *************************************************************** */
int genmmd(int* neqns, int* xadj, int* adjncy, int* invp, int* perm,
           int* delta, int* dhead, int* qsize, int* llist, int* marker,
           int*  maxint, int* nofsub)
{
    /* System generated locals */
    int i__1;

    /* Local variables */
    int mdeg = 0, ehead = 0, i = 0, mdlmt = 0, mdnode = 0;
    //extern /* Subroutine */ int mmdelm_(), mmdupd_(), mmdint_(), mmdnum_();
    int nextmd = 0, tag = 0, num = 0;


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

/*         INTEGER*2  ADJNCY(1), DHEAD(1) , INVP(1)  , LLIST(1) , */
/*     1              MARKER(1), PERM(1)  , QSIZE(1) */

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

    /* Parameter adjustments */
    //--marker; --llist; --qsize; --dhead; --perm; --invp; --adjncy; --xadj;

    /* Function Body */
    if (*neqns <= 0) {
        return 0;
    }

/*        ------------------------------------------------ */
/*        INITIALIZATION FOR THE MINIMUM DEGREE ALGORITHM. */
/*        ------------------------------------------------ */
    *nofsub = 0;
    //mmdint_(neqns, &xadj[1], &adjncy[1], &dhead[1], &invp[1], &perm[1],
    //        &qsize[1], &llist[1], &marker[1]);
    mmdint_(neqns, xadj, adjncy, dhead, invp, perm, qsize, llist, marker);

/*        ---------------------------------------------- */
/*        NUM COUNTS THE NUMBER OF ORDERED NODES PLUS 1. */
/*        ---------------------------------------------- */
    num = 1;

/*        ----------------------------- */
/*        ELIMINATE ALL ISOLATED NODES. */
/*        ----------------------------- */
    nextmd = dhead[1];
L100:
    if (nextmd <= 0) {
        goto L200;
    }
    mdnode = nextmd;
    nextmd = invp[mdnode];
    marker[mdnode] = *maxint;
    invp[mdnode] = -num;
    ++num;
    goto L100;

L200:
/*        ---------------------------------------- */
/*        SEARCH FOR NODE OF THE MINIMUM DEGREE. */
/*        MDEG IS THE CURRENT MINIMUM DEGREE; */
/*        TAG IS USED TO FACILITATE MARKING NODES. */
/*        ---------------------------------------- */
    if (num > *neqns) {
        goto L1000;
    }
    tag = 1;
    dhead[1] = 0;
    mdeg = 2;
L300:
    if (dhead[mdeg] > 0) {
        goto L400;
    }
    ++mdeg;
    goto L300;
L400:
/*            ------------------------------------------------- */
/*            USE VALUE OF DELTA TO SET UP MDLMT, WHICH GOVERNS */
/*            WHEN A DEGREE UPDATE IS TO BE PERFORMED. */
/*            ------------------------------------------------- */
    mdlmt = mdeg + *delta;
    ehead = 0;

L500:
    mdnode = dhead[mdeg];
    if (mdnode > 0) {
        goto L600;
    }
    ++mdeg;
    if (mdeg > mdlmt) {
        goto L900;
    }
    goto L500;
L600:
/*                ---------------------------------------- */
/*                REMOVE MDNODE FROM THE DEGREE STRUCTURE. */
/*                ---------------------------------------- */
    nextmd = invp[mdnode];
    dhead[mdeg] = nextmd;
    if (nextmd > 0) {
        perm[nextmd] = -mdeg;
    }
    invp[mdnode] = -num;
    *nofsub = *nofsub + mdeg + qsize[mdnode] - 2;
    if (num + qsize[mdnode] > *neqns) {
        goto L1000;
    }
/*                ---------------------------------------------- */
/*                ELIMINATE MDNODE AND PERFORM QUOTIENT GRAPH */
/*                TRANSFORMATION.  RESET TAG VALUE IF NECESSARY. */
/*                ---------------------------------------------- */
    ++tag;
    if (tag < *maxint) {
        goto L800;
    }
    tag = 1;
    i__1 = *neqns;
    for (i = 1; i <= i__1; ++i) {
        if (marker[i] < *maxint) {
            marker[i] = 0;
        }
/* L700: */
    }
L800:
    //mmdelm_(&mdnode, &xadj[1], &adjncy[1], &dhead[1], &invp[1], &perm[1],
    //        &qsize[1], &llist[1], &marker[1], maxint, &tag);
    mmdelm_(&mdnode, xadj, adjncy, dhead, invp, perm, qsize, llist,
            marker, maxint, &tag);
    num += qsize[mdnode];
    llist[mdnode] = ehead;
    ehead = mdnode;
    if (*delta >= 0) {
        goto L500;
    }
L900:
/*            ------------------------------------------- */
/*            UPDATE DEGREES OF THE NODES INVOLVED IN THE */
/*            MINIMUM DEGREE NODES ELIMINATION. */
/*            ------------------------------------------- */
    if (num > *neqns) {
        goto L1000;
    }
    //mmdupd_(&ehead, neqns, &xadj[1], &adjncy[1], delta, &mdeg, &dhead[1],
    //        &invp[1], &perm[1], &qsize[1], &llist[1], &marker[1], maxint, &tag);
    mmdupd_(&ehead, neqns, xadj, adjncy, delta, &mdeg, dhead,
            invp, perm, qsize, llist, marker, maxint, &tag);
    goto L300;

L1000:
    //mmdnum_(neqns, &perm[1], &invp[1], &qsize[1]);
    mmdnum_(neqns, perm, invp, qsize);

    //++marker; ++llist; ++qsize; ++dhead; ++perm; ++invp; ++adjncy; ++xadj;
    return 0;

} /* genmmd_ */

/* *************************************************************** */
/* *************************************************************** */
/* ***     MMDINT ..... MULT MINIMUM DEGREE INITIALIZATION     *** */
/* *************************************************************** */
/* *************************************************************** */

/*     AUTHOR - JOSEPH W.H. LIU */
/*              DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */

/*     PURPOSE - THIS ROUTINE PERFORMS INITIALIZATION FOR THE */
/*        MULTIPLE ELIMINATION VERSION OF THE MINIMUM DEGREE */
/*        ALGORITHM. */

/*     INPUT PARAMETERS - */
/*        NEQNS  - NUMBER OF EQUATIONS. */
/*        (XADJ,ADJNCY) - ADJACENCY STRUCTURE. */

/*     OUTPUT PARAMETERS - */
/*        (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
/*        QSIZE  - SIZE OF SUPERNODE (INITIALIZED TO ONE). */
/*        LLIST  - LINKED LIST. */
/*        MARKER - MARKER VECTOR. */

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


static int mmdint_(int* neqns, int* xadj, int* adjncy, int* dhead, int* dforw,
            int* dbakw, int* qsize, int* llist, int* marker)
{
    /* System generated locals */
    int i__1;

    /* Local variables */
    int ndeg = 0, node = 0, fnode = 0;


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

/*         INTEGER*2  ADJNCY(1), DBAKW(1) , DFORW(1) , DHEAD(1) , */
/*     1              LLIST(1) , MARKER(1), QSIZE(1) */

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

    /* Parameter adjustments */
    //--marker; --llist; --qsize; --dbakw; --dforw; --dhead; --adjncy; --xadj;

    /* Function Body */
    i__1 = *neqns;
    for (node = 1; node <= i__1; ++node) {
        dhead[node] = 0;
        qsize[node] = 1;
        marker[node] = 0;
        llist[node] = 0;
/* L100: */
    }
/*        ------------------------------------------ */
/*        INITIALIZE THE DEGREE DOUBLY LINKED LISTS. */
/*        ------------------------------------------ */
    i__1 = *neqns;
    for (node = 1; node <= i__1; ++node) {
        ndeg = xadj[node + 1] - xadj[node] + 1;
        fnode = dhead[ndeg];
        dforw[node] = fnode;
        dhead[ndeg] = node;
        if (fnode > 0) {
            dbakw[fnode] = node;
        }
        dbakw[node] = -ndeg;
/* L200: */
    }
    return 0;

} /* mmdint_ */

/* *************************************************************** */
/* *************************************************************** */
/* **     MMDELM ..... MULTIPLE MINIMUM DEGREE ELIMINATION     *** */
/* *************************************************************** */
/* *************************************************************** */

/*     AUTHOR - JOSEPH W.H. LIU */
/*              DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */

/*     PURPOSE - THIS ROUTINE ELIMINATES THE NODE MDNODE OF */
/*        MINIMUM DEGREE FROM THE ADJACENCY STRUCTURE, WHICH */
/*        IS STORED IN THE QUOTIENT GRAPH FORMAT.  IT ALSO */
/*        TRANSFORMS THE QUOTIENT GRAPH REPRESENTATION OF THE */
/*        ELIMINATION GRAPH. */

/*     INPUT PARAMETERS - */
/*        MDNODE - NODE OF MINIMUM DEGREE. */
/*        MAXINT - ESTIMATE OF MAXIMUM REPRESENTABLE (SHORT) */
/*                 INTEGER. */
/*        TAG    - TAG VALUE. */

/*     UPDATED PARAMETERS - */
/*        (XADJ,ADJNCY) - UPDATED ADJACENCY STRUCTURE. */
/*        (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
/*        QSIZE  - SIZE OF SUPERNODE. */
/*        MARKER - MARKER VECTOR. */
/*        LLIST  - TEMPORARY LINKED LIST OF ELIMINATED NABORS. */

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

static int mmdelm_(int* mdnode, int* xadj, int* adjncy, int* dhead, int* dforw,
            int* dbakw, int* qsize, int* llist, int* marker,
            int* maxint, int* tag)
{
    /* System generated locals */
    int i__1, i__2;

    /* Local variables */
    int node = 0, link = 0, rloc = 0, rlmt = 0, i = 0, j = 0, nabor = 0, rnode = 0, elmnt = 0, xqnbr = 0,
            istop = 0, jstop = 0, istrt = 0, jstrt = 0, nxnode = 0, pvnode = 0, nqnbrs = 0, npv = 0;


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

/*         INTEGER*2  ADJNCY(1), DBAKW(1) , DFORW(1) , DHEAD(1) , */
/*     1              LLIST(1) , MARKER(1), QSIZE(1) */

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

/*        ----------------------------------------------- */
/*        FIND REACHABLE SET AND PLACE IN DATA STRUCTURE. */
/*        ----------------------------------------------- */
    /* Parameter adjustments */
    //--marker; --llist; --qsize; --dbakw; --dforw; --dhead;
    //--adjncy; --xadj;

    /* Function Body */
    marker[*mdnode] = *tag;
    istrt = xadj[*mdnode];
    istop = xadj[*mdnode + 1] - 1;
/*        ------------------------------------------------------- */
/*        ELMNT POINTS TO THE BEGINNING OF THE LIST OF ELIMINATED */
/*        NABORS OF MDNODE, AND RLOC GIVES THE STORAGE LOCATION */
/*        FOR THE NEXT REACHABLE NODE. */
/*        ------------------------------------------------------- */
    elmnt = 0;
    rloc = istrt;
    rlmt = istop;
    i__1 = istop;
    for (i = istrt; i <= i__1; ++i) {
        nabor = adjncy[i];
        if (nabor == 0) {
            goto L300;
        }
        if (marker[nabor] >= *tag) {
            goto L200;
        }
        marker[nabor] = *tag;
        if (dforw[nabor] < 0) {
            goto L100;
        }
        adjncy[rloc] = nabor;
        ++rloc;
        goto L200;
L100:
        llist[nabor] = elmnt;
        elmnt = nabor;
L200:
        ;
    }
L300:
/*            ----------------------------------------------------- */
/*            MERGE WITH REACHABLE NODES FROM GENERALIZED ELEMENTS. */
/*            ----------------------------------------------------- */
    if (elmnt <= 0) {
        goto L1000;
    }
    adjncy[rlmt] = -elmnt;
    link = elmnt;
L400:
    jstrt = xadj[link];
    jstop = xadj[link + 1] - 1;
    i__1 = jstop;
    for (j = jstrt; j <= i__1; ++j) {
        node = adjncy[j];
        link = -node;
        if (node < 0) {
            goto L400;
        } else if (node == 0) {
            goto L900;
        } else {
            goto L500;
        }
L500:
        if (marker[node] >= *tag || dforw[node] < 0) {
            goto L800;
        }
        marker[node] = *tag;
/*                            --------------------------------- */
/*                            USE STORAGE FROM ELIMINATED NODES */
/*                            IF NECESSARY. */
/*                            --------------------------------- */
L600:
        if (rloc < rlmt) {
            goto L700;
        }
        link = -adjncy[rlmt];
        rloc = xadj[link];
        rlmt = xadj[link + 1] - 1;
        goto L600;
L700:
        adjncy[rloc] = node;
        ++rloc;
L800:
        ;
    }
L900:
    elmnt = llist[elmnt];
    goto L300;
L1000:
    if (rloc <= rlmt) {
        adjncy[rloc] = 0;
    }
/*        -------------------------------------------------------- */
/*        FOR EACH NODE IN THE REACHABLE SET, DO THE FOLLOWING ... */
/*        -------------------------------------------------------- */
    link = *mdnode;
L1100:
    istrt = xadj[link];
    istop = xadj[link + 1] - 1;
    i__1 = istop;
    for (i = istrt; i <= i__1; ++i) {
        rnode = adjncy[i];
        link = -rnode;
        if (rnode < 0) {
            goto L1100;
        } else if (rnode == 0) {
            goto L1800;
        } else {
            goto L1200;
        }
L1200:
/*                -------------------------------------------- */
/*                IF RNODE IS IN THE DEGREE LIST STRUCTURE ... */
/*                -------------------------------------------- */
        pvnode = dbakw[rnode];
        if (pvnode == 0 || pvnode == -(*maxint)) {
            goto L1300;
        }
/*                    ------------------------------------- */
/*                    THEN REMOVE RNODE FROM THE STRUCTURE. */
/*                    ------------------------------------- */
        nxnode = dforw[rnode];
        if (nxnode > 0) {
            dbakw[nxnode] = pvnode;
        }
        if (pvnode > 0) {
            dforw[pvnode] = nxnode;
        }
        npv = -pvnode;
        if (pvnode < 0) {
            dhead[npv] = nxnode;
        }
L1300:
/*                ---------------------------------------- */
/*                PURGE INACTIVE QUOTIENT NABORS OF RNODE. */
/*                ---------------------------------------- */
        jstrt = xadj[rnode];
        jstop = xadj[rnode + 1] - 1;
        xqnbr = jstrt;
        i__2 = jstop;
        for (j = jstrt; j <= i__2; ++j) {
            nabor = adjncy[j];
            if (nabor == 0) {
                goto L1500;
            }
            if (marker[nabor] >= *tag) {
                goto L1400;
            }
            adjncy[xqnbr] = nabor;
            ++xqnbr;
L1400:
            ;
        }
L1500:
/*                ---------------------------------------- */
/*                IF NO ACTIVE NABOR AFTER THE PURGING ... */
/*                ---------------------------------------- */
        nqnbrs = xqnbr - jstrt;
        if (nqnbrs > 0) {
            goto L1600;
        }
/*                    ----------------------------- */
/*                    THEN MERGE RNODE WITH MDNODE. */
/*                    ----------------------------- */
        qsize[*mdnode] += qsize[rnode];
        qsize[rnode] = 0;
        marker[rnode] = *maxint;
        dforw[rnode] = -(*mdnode);
        dbakw[rnode] = -(*maxint);
        goto L1700;
L1600:
/*                -------------------------------------- */
/*                ELSE FLAG RNODE FOR DEGREE UPDATE, AND */
/*                ADD MDNODE AS A NABOR OF RNODE. */
/*                -------------------------------------- */
        dforw[rnode] = nqnbrs + 1;
        dbakw[rnode] = 0;
        adjncy[xqnbr] = *mdnode;
        ++xqnbr;
        if (xqnbr <= jstop) {
            adjncy[xqnbr] = 0;
        }

L1700:
        ;
    }
L1800:
    return 0;

} /* mmdelm_ */

/* *************************************************************** */
/* *************************************************************** */
/* *****     MMDUPD ..... MULTIPLE MINIMUM DEGREE UPDATE     ***** */
/* *************************************************************** */
/* *************************************************************** */

/*     AUTHOR - JOSEPH W.H. LIU */
/*              DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */

/*     PURPOSE - THIS ROUTINE UPDATES THE DEGREES OF NODES */
/*        AFTER A MULTIPLE ELIMINATION STEP. */

/*     INPUT PARAMETERS - */
/*        EHEAD  - THE BEGINNING OF THE LIST OF ELIMINATED */
/*                 NODES (I.E., NEWLY FORMED ELEMENTS). */
/*        NEQNS  - NUMBER OF EQUATIONS. */
/*        (XADJ,ADJNCY) - ADJACENCY STRUCTURE. */
/*        DELTA  - TOLERANCE VALUE FOR MULTIPLE ELIMINATION. */
/*        MAXINT - MAXIMUM MACHINE REPRESENTABLE (SHORT) */
/*                 INTEGER. */

/*     UPDATED PARAMETERS - */
/*        MDEG   - NEW MINIMUM DEGREE AFTER DEGREE UPDATE. */
/*        (DHEAD,DFORW,DBAKW) - DEGREE DOUBLY LINKED STRUCTURE. */
/*        QSIZE  - SIZE OF SUPERNODE. */
/*        LLIST  - WORKING LINKED LIST. */
/*        MARKER - MARKER VECTOR FOR DEGREE UPDATE. */
/*        TAG    - TAG VALUE. */

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

static int mmdupd_(int* ehead, int* neqns, int* xadj, int* adjncy, int* delta,
            int* mdeg, int* dhead, int* dforw, int* dbakw, int* qsize,
            int* llist, int* marker, int* maxint, int* tag)
{
    /* System generated locals */
    int i__1, i__2;

    /* Local variables */
    int node = 0, mtag = 0, link = 0, mdeg0 = 0, i = 0, j = 0, enode = 0, fnode = 0, nabor = 0, elmnt = 0,
            istop = 0, jstop = 0, q2head = 0, istrt = 0, jstrt = 0, qxhead = 0, iq2 = 0, deg = 0, deg0 = 0;


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

/*         INTEGER*2  ADJNCY(1), DBAKW(1) , DFORW(1) , DHEAD(1) , */
/*     1              LLIST(1) , MARKER(1), QSIZE(1) */

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

    /* Parameter adjustments */
    //--marker; --llist; --qsize; --dbakw; --dforw; --dhead;
    //--adjncy; --xadj;

    /* Function Body */
    mdeg0 = *mdeg + *delta;
    elmnt = *ehead;
L100:
/*            ------------------------------------------------------- */
/*            FOR EACH OF THE NEWLY FORMED ELEMENT, DO THE FOLLOWING. */
/*            (RESET TAG VALUE IF NECESSARY.)                         */
/*            ------------------------------------------------------- */
    if (elmnt <= 0) {
        return 0;
    }
    mtag = *tag + mdeg0;
    if (mtag < *maxint) {
        goto L300;
    }
    *tag = 1;
    i__1 = *neqns;
    for (i = 1; i <= i__1; ++i) {
        if (marker[i] < *maxint) {
            marker[i] = 0;
        }
/* L200: */
    }
    mtag = *tag + mdeg0;
L300:
/*            --------------------------------------------- */
/*            CREATE TWO LINKED LISTS FROM NODES ASSOCIATED */
/*            WITH ELMNT: ONE WITH TWO NABORS (Q2HEAD) IN   */
/*            ADJACENCY STRUCTURE, AND THE OTHER WITH MORE  */
/*            THAN TWO NABORS (QXHEAD).  ALSO COMPUTE DEG0, */
/*            NUMBER OF NODES IN THIS ELEMENT.              */
/*            --------------------------------------------- */
    q2head = 0;
    qxhead = 0;
    deg0 = 0;
    link = elmnt;
L400:
    istrt = xadj[link];
    istop = xadj[link + 1] - 1;
    i__1 = istop;
    for (i = istrt; i <= i__1; ++i) {
        enode = adjncy[i];
        link = -enode;
        if (enode < 0) {
            goto L400;
        } else if (enode == 0) {
            goto L800;
        } else {
            goto L500;
        }

L500:
        if (qsize[enode] == 0) {
            goto L700;
        }
        deg0 += qsize[enode];
        marker[enode] = mtag;
/*                        ---------------------------------- */
/*                        IF ENODE REQUIRES A DEGREE UPDATE, */
/*                        THEN DO THE FOLLOWING.             */
/*                        ---------------------------------- */
        if (dbakw[enode] != 0) {
            goto L700;
        }
/*                            ---------------------------------------*/
/*                            PLACE EITHER IN QXHEAD OR Q2HEAD LISTS.*/
/*                            ---------------------------------------*/
        if (dforw[enode] == 2) {
            goto L600;
        }
        llist[enode] = qxhead;
        qxhead = enode;
        goto L700;
L600:
        llist[enode] = q2head;
        q2head = enode;
L700:
        ;
    }
L800:
/*            -------------------------------------------- */
/*            FOR EACH ENODE IN Q2 LIST, DO THE FOLLOWING. */
/*            -------------------------------------------- */
    enode = q2head;
    iq2 = 1;
L900:
    if (enode <= 0) {
        goto L1500;
    }
    if (dbakw[enode] != 0) {
        goto L2200;
    }
    ++(*tag);
    deg = deg0;
/*                    ------------------------------------------ */
/*                    IDENTIFY THE OTHER ADJACENT ELEMENT NABOR. */
/*                    ------------------------------------------ */
    istrt = xadj[enode];
    nabor = adjncy[istrt];
    if (nabor == elmnt) {
        nabor = adjncy[istrt + 1];
    }
/*                    ------------------------------------------------ */
/*                    IF NABOR IS UNELIMINATED, INCREASE DEGREE COUNT. */
/*                    ------------------------------------------------ */
    link = nabor;
    if (dforw[nabor] < 0) {
        goto L1000;
    }
    deg += qsize[nabor];
    goto L2100;
L1000:
/*                        -------------------------------------------- */
/*                        OTHERWISE, FOR EACH NODE IN THE 2ND ELEMENT, */
/*                        DO THE FOLLOWING.                            */
/*                        -------------------------------------------- */
    istrt = xadj[link];
    istop = xadj[link + 1] - 1;
    i__1 = istop;
    for (i = istrt; i <= i__1; ++i) {
        node = adjncy[i];
        link = -node;
        if (node == enode) {
            goto L1400;
        }
        if (node < 0) {
            goto L1000;
        } else if (node == 0) {
            goto L2100;
        } else {
            goto L1100;
        }

L1100:
        if (qsize[node] == 0) {
            goto L1400;
        }
        if (marker[node] >= *tag) {
            goto L1200;
        }
/*                        ------------------------------------- */
/*                        CASE WHEN NODE IS NOT YET CONSIDERED. */
/*                        ------------------------------------- */
        marker[node] = *tag;
        deg += qsize[node];
        goto L1400;
L1200:
/*                        ---------------------------------------- */
/*                        CASE WHEN NODE IS INDISTINGUISHABLE FROM */
/*                        ENODE.  MERGE THEM INTO A NEW SUPERNODE. */
/*                        ---------------------------------------- */
        if (dbakw[node] != 0) {
            goto L1400;
        }
        if (dforw[node] != 2) {
            goto L1300;
        }
        qsize[enode] += qsize[node];
        qsize[node] = 0;
        marker[node] = *maxint;
        dforw[node] = -enode;
        dbakw[node] = -(*maxint);
        goto L1400;
L1300:
/*                -------------------------------------- */
/*                CASE WHEN NODE IS OUTMATCHED BY ENODE. */
/*                -------------------------------------- */
        if (dbakw[node] == 0) {
            dbakw[node] = -(*maxint);
        }
L1400:
        ;
    }
    goto L2100;
L1500:
/*                ------------------------------------------------ */
/*                FOR EACH ENODE IN THE QX LIST, DO THE FOLLOWING. */
/*                ------------------------------------------------ */
    enode = qxhead;
    iq2 = 0;
L1600:
    if (enode <= 0) {
        goto L2300;
    }
    if (dbakw[enode] != 0) {
        goto L2200;
    }
    ++(*tag);
    deg = deg0;
/*                        --------------------------------- */
/*                        FOR EACH UNMARKED NABOR OF ENODE, */
/*                        DO THE FOLLOWING.                 */
/*                        --------------------------------- */
    istrt = xadj[enode];
    istop = xadj[enode + 1] - 1;
    i__1 = istop;
    for (i = istrt; i <= i__1; ++i) {
        nabor = adjncy[i];
        if (nabor == 0) {
            goto L2100;
        }
        if (marker[nabor] >= *tag) {
            goto L2000;
        }
        marker[nabor] = *tag;
        link = nabor;
/*                                ------------------------------ */
/*                                IF UNELIMINATED, INCLUDE IT IN */
/*                                DEG COUNT.                     */
/*                                ------------------------------ */
        if (dforw[nabor] < 0) {
            goto L1700;
        }
        deg += qsize[nabor];
        goto L2000;
L1700:
/*                                ------------------------------- */
/*                                IF ELIMINATED, INCLUDE UNMARKED */
/*                                NODES IN THIS ELEMENT INTO THE  */
/*                                DEGREE COUNT.                   */
/*                                ------------------------------- */
        jstrt = xadj[link];
        jstop = xadj[link + 1] - 1;
        i__2 = jstop;
        for (j = jstrt; j <= i__2; ++j) {
            node = adjncy[j];
            link = -node;
            if (node < 0) {
                goto L1700;
            } else if (node == 0) {
                goto L2000;
            } else {
                goto L1800;
            }

L1800:
            if (marker[node] >= *tag) {
                goto L1900;
            }
            marker[node] = *tag;
            deg += qsize[node];
L1900:
            ;
        }
L2000:
        ;
    }
L2100:
/*                    ------------------------------------------- */
/*                    UPDATE EXTERNAL DEGREE OF ENODE IN DEGREE   */
/*                    STRUCTURE, AND MDEG (MIN DEG) IF NECESSARY. */
/*                    ------------------------------------------- */
    deg = deg - qsize[enode] + 1;
    fnode = dhead[deg];
    dforw[enode] = fnode;
    dbakw[enode] = -deg;
    if (fnode > 0) {
        dbakw[fnode] = enode;
    }
    dhead[deg] = enode;
    if (deg < *mdeg) {
        *mdeg = deg;
    }
L2200:
/*                    ---------------------------------- */
/*                    GET NEXT ENODE IN CURRENT ELEMENT. */
/*                    ---------------------------------- */
    enode = llist[enode];
    if (iq2 == 1) {
        goto L900;
    }
    goto L1600;
L2300:
/*            ----------------------------- */
/*            GET NEXT ELEMENT IN THE LIST. */
/*            ----------------------------- */
    *tag = mtag;
    elmnt = llist[elmnt];
    goto L100;

} /* mmdupd_ */

/* *************************************************************** */
/* *************************************************************** */
/* *****     MMDNUM ..... MULTI MINIMUM DEGREE NUMBERING     ***** */
/* *************************************************************** */
/* *************************************************************** */

/*     AUTHOR - JOSEPH W.H. LIU */
/*              DEPT OF COMPUTER SCIENCE, YORK UNIVERSITY. */

/*     PURPOSE - THIS ROUTINE PERFORMS THE FINAL STEP IN */
/*        PRODUCING THE PERMUTATION AND INVERSE PERMUTATION */
/*        VECTORS IN THE MULTIPLE ELIMINATION VERSION OF THE */
/*        MINIMUM DEGREE ORDERING ALGORITHM. */

/*     INPUT PARAMETERS - */
/*        NEQNS  - NUMBER OF EQUATIONS. */
/*        QSIZE  - SIZE OF SUPERNODES AT ELIMINATION. */

/*     UPDATED PARAMETERS - */
/*        INVP   - INVERSE PERMUTATION VECTOR.  ON INPUT, */
/*                 IF QSIZE(NODE)=0, THEN NODE HAS BEEN MERGED */
/*                 INTO THE NODE -INVP(NODE); OTHERWISE, */
/*                 -INVP(NODE) IS ITS INVERSE LABELLING. */

/*     OUTPUT PARAMETERS - */
/*        PERM   - THE PERMUTATION VECTOR. */

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

static int mmdnum_(int* neqns, int* perm, int* invp, int* qsize)
{
    /* System generated locals */
    int i__1;

    /* Local variables */
    int node = 0, root = 0, nextf = 0, father = 0, nqsize = 0, num = 0;


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

/*         INTEGER*2  INVP(1)  , PERM(1)  , QSIZE(1) */

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

    /* Parameter adjustments */
    //--qsize; --invp; --perm;

    /* Function Body */
    i__1 = *neqns;
    for (node = 1; node <= i__1; ++node) {
        nqsize = qsize[node];
        if (nqsize <= 0) {
            perm[node] = invp[node];
        }
        if (nqsize > 0) {
            perm[node] = -invp[node];
        }
/* L100: */
    }
/*        ------------------------------------------------------ */
/*        FOR EACH NODE WHICH HAS BEEN MERGED, DO THE FOLLOWING. */
/*        ------------------------------------------------------ */
    i__1 = *neqns;
    for (node = 1; node <= i__1; ++node) {
        if (perm[node] > 0) {
            goto L500;
        }
/*                ----------------------------------------- */
/*                TRACE THE MERGED TREE UNTIL ONE WHICH HAS */
/*                NOT BEEN MERGED, CALL IT ROOT.            */
/*                ----------------------------------------- */
        father = node;
L200:
        if (perm[father] > 0) {
            goto L300;
        }
        father = -perm[father];
        goto L200;
L300:
/*                ----------------------- */
/*                NUMBER NODE AFTER ROOT. */
/*                ----------------------- */
        root = father;
        num = perm[root] + 1;
        invp[node] = -num;
        perm[root] = num;
/*                ------------------------ */
/*                SHORTEN THE MERGED TREE. */
/*                ------------------------ */
        father = node;
L400:
        nextf = -perm[father];
        if (nextf <= 0) {
            goto L500;
        }
        perm[father] = -root;
        father = nextf;
        goto L400;
L500:
        ;
    }
/*        ---------------------- */
/*        READY TO COMPUTE PERM. */
/*        ---------------------- */
    i__1 = *neqns;
    for (node = 1; node <= i__1; ++node) {
        num = -invp[node];
        invp[node] = num;
        perm[num] = node;
/* L600: */
    }
    return 0;

} /* mmdnum_ */
