ana_orderings.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	mumps_ana_h (totel, compute_perm, n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent)
subroutine	mumps_amd_elt (n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent)
subroutine	mumps_hamd (n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent, listvar_schur, size_schur)
subroutine	mumps_hamf4 (norig, n, compute_perm, nbbuck, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, wf, next, w, head, parent)
subroutine	mumps_qamd (totel, compute_perm, iversion, thresh, ndense, n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent)
subroutine	mumps_cst_amf (n, nbbuck, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, wf, next, w, head, constraint, theson, parent)
subroutine	mumps_symqamd (thresh, ndense, n, totel, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, perm, listvar_schur, size_schur, agg6, parent)

Function/Subroutine Documentation

mumps_amd_elt()

subroutine mumps_amd_elt	(	integer, intent(in)	n,
		integer(8), intent(in)	iwlen,
		integer(8), dimension(n), intent(inout)	pe,
		integer(8), intent(inout)	pfree,
		integer, dimension(n), intent(inout)	len,
		integer, dimension(iwlen), intent(inout)	iw,
		integer, dimension(n), intent(out)	nv,
		integer, dimension(n), intent(out)	elen,
		integer, dimension(n), intent(out)	last,
		integer, intent(out)	ncmpa,
		integer, dimension(n)	degree,
		integer, dimension(n)	head,
		integer, dimension(n)	next,
		integer, dimension(n)	w,
		integer, dimension(n), intent(out)	parent )

Definition at line 1285 of file ana_orderings.F.

C 
C    Restrictive integer 64 bit variant :
C    it is assumed that IW array size can exceed 32-bit integer
C 
C     Input not modified
      INTEGER, INTENT(IN)    :: N
      INTEGER(8), INTENT(IN) :: IWLEN
C     Input undefined on output 
      INTEGER, INTENT(INOUT)  :: LEN(N), IW(IWLEN)
C 
C     Output only 
      INTEGER, INTENT(OUT)   :: NCMPA
      INTEGER, INTENT(OUT)   :: NV(N), ELEN(N), LAST(N), PARENT(N)
C 
C     Input/output
      INTEGER(8), INTENT(INOUT) :: PFREE
      INTEGER(8), INTENT(INOUT) :: PE(N)
C
C     Internal Workspace only
      INTEGER NEXT(N), DEGREE(N), HEAD(N), W(N)
C
C Description:
C   Given a representation of the nonzero pattern of a symmetric matrix,
C   A, (excluding the diagonal) perform an approximate minimum
C   degree ordering to compute a pivot order
C   such that fill-in in the Cholesky factors A = LL^T is kept low. 
C ---------------------
C Interface Description
C ---------------------
C INPUT ARGUMENTS (unaltered):
C-----------------------------
C n:    The matrix order.
C
C       Restriction:  n .ge. 1
C iwlen:        The length of iw (1..iwlen).  On input, the matrix is
C       stored in iw (1..pfree-1).  However, iw (1..iwlen) should be
C       slightly larger than what is required to hold the matrix, at
C       least iwlen .ge. pfree + n is recommended.  Otherwise,
C       excessive compressions will take place.
C       *** We do not recommend running this algorithm with ***
C       ***      iwlen .lt. pfree + n.                      ***
C       *** Better performance will be obtained if          ***
C       ***      iwlen .ge. pfree + n                       ***
C       *** or better yet                                   ***
C       ***      iwlen .gt. 1.2 * pfree                     ***
C       *** (where pfree is its value on input).            ***
C       The algorithm will not run at all if iwlen .lt. pfree-1.
C
C       Restriction: iwlen .ge. pfree-1
C-----------------------------------------------------------------------
C INPUT/OUPUT ARGUMENTS:
C-----------------------------------------------------------------------
C pe:   On input, pe (i) is the index in iw of the start of row i, or
C       zero if row i has no off-diagonal non-zeros.
C
C       During execution, it is used for both supervariables and
C       elements:
C
C       * Principal supervariable i:  index into iw of the
C               description of supervariable i.  A supervariable
C               represents one or more rows of the matrix
C               with identical nonzero pattern.
C       * Non-principal supervariable i:  if i has been absorbed
C               into another supervariable j, then pe (i) = -j.
C               That is, j has the same pattern as i.
C               Note that j might later be absorbed into another
C               supervariable j2, in which case pe (i) is still -j,
C               and pe (j) = -j2.
C       * Unabsorbed element e:  the index into iw of the description
C               of element e, if e has not yet been absorbed by a
C               subsequent element.  Element e is created when
C               the supervariable of the same name is selected as
C               the pivot.
C       * Absorbed element e:  if element e is absorbed into element
C               e2, then pe (e) = -e2.  This occurs when the pattern of
C               e (that is, Le) is found to be a subset of the pattern
C               of e2 (that is, Le2).  If element e is "null" (it has
C               no nonzeros outside its pivot block), then pe (e) = 0.
C
C       On output, pe holds the assembly tree/forest, which implicitly
C       represents a pivot order with identical fill-in as the actual
C       order (via a depth-first search of the tree).
C
C       On output:
C       If nv (i) .gt. 0, then i represents a node in the assembly tree,
C       and the parent of i is -pe (i), or zero if i is a root.
C       If nv (i) = 0, then (i,-pe (i)) represents an edge in a
C       subtree, the root of which is a node in the assembly tree.
C 
C       On output:  (PE is copied on output into PARENT array)
C pfree:        On input, the matrix is stored in iw (1..pfree-1) and
C       the rest of the array iw is free.
C       During execution, additional data is placed in iw, and pfree
C       is modified so that components  of iw from pfree are free.
C       On output, pfree is set equal to the size of iw that
C       would have been needed for no compressions to occur.  If
C       ncmpa is zero, then pfree (on output) is less than or equal to
C       iwlen, and the space iw (pfree+1 ... iwlen) was not used.
C       Otherwise, pfree (on output) is greater than iwlen, and all the
C       memory in iw was used.
C-----------------------------------------------------------------------
C INPUT/MODIFIED (undefined on output):
C-----------------------------------------------------------------------
C len:  On input, len (i) holds the number of entries in row i of the
C       matrix, excluding the diagonal.  The contents of len (1..n)
C       are undefined on output.
C iw:   On input, iw (1..pfree-1) holds the description of each row i
C       in the matrix.  The matrix must be symmetric, and both upper
C       and lower triangular parts must be present.  The diagonal must
C       not be present.  Row i is held as follows:
C
C               len (i):  the length of the row i data structure
C               iw (pe (i) ... pe (i) + len (i) - 1):
C                       the list of column indices for nonzeros
C                       in row i (simple supervariables), excluding
C                       the diagonal.  All supervariables start with
C                       one row/column each (supervariable i is just
C                       row i).
C               if len (i) is zero on input, then pe (i) is ignored
C               on input.
C
C               Note that the rows need not be in any particular order,
C               and there may be empty space between the rows.
C
C       During execution, the supervariable i experiences fill-in.
C       This is represented by placing in i a list of the elements
C       that cause fill-in in supervariable i:
C
C               len (i):  the length of supervariable i
C               iw (pe (i) ... pe (i) + elen (i) - 1):
C                       the list of elements that contain i.  This list
C                       is kept short by removing absorbed elements.
C               iw (pe (i) + elen (i) ... pe (i) + len (i) - 1):
C                       the list of supervariables in i.  This list
C                       is kept short by removing nonprincipal
C                       variables, and any entry j that is also
C                       contained in at least one of the elements
C                       (j in Le) in the list for i (e in row i).
C
C       When supervariable i is selected as pivot, we create an
C       element e of the same name (e=i):
C
C               len (e):  the length of element e
C               iw (pe (e) ... pe (e) + len (e) - 1):
C                       the list of supervariables in element e.
C
C       An element represents the fill-in that occurs when supervariable
C       i is selected as pivot (which represents the selection of row i
C       and all non-principal variables whose principal variable is i).
C       We use the term Le to denote the set of all supervariables
C       in element e.  Absorbed supervariables and elements are pruned
C       from these lists when computationally convenient.
C
C       CAUTION:  THE INPUT MATRIX IS OVERWRITTEN DURING COMPUTATION.
C       The contents of iw are undefined on output.
C-----------------------------------------------------------------------
C OUTPUT (need not be set on input):
C-----------------------------------------------------------------------
C nv:   During execution, abs (nv (i)) is equal to the number of rows
C       that are represented by the principal supervariable i.  If i is
C       a nonprincipal variable, then nv (i) = 0.  Initially,
C       nv (i) = 1 for all i.  nv (i) .lt. 0 signifies that i is a
C       principal variable in the pattern Lme of the current pivot
C       element me.  On output, nv (e) holds the true degree of element
C       e at the time it was created (including the diagonal part).
C elen: See the description of iw above.  At the start of execution,
C       elen (i) is set to zero.  During execution, elen (i) is the
C       number of elements in the list for supervariable i.  When e
C       becomes an element, elen (e) = -nel is set, where nel is the
C       current step of factorization.  elen (i) = 0 is done when i
C       becomes nonprincipal.
C
C       For variables, elen (i) .ge. 0 holds until just before the
C       permutation vectors are computed.  For elements,
C       elen (e) .lt. 0 holds.
C
C       On output elen (1..n) holds the inverse permutation (the same
C       as the 'INVP' argument in Sparspak).  That is, if k = elen (i),
C       then row i is the kth pivot row.  Row i of A appears as the
C       (elen(i))-th row in the permuted matrix, PAP^T.
C last: In a degree list, last (i) is the supervariable preceding i,
C       or zero if i is the head of the list.  In a hash bucket,
C       last (i) is the hash key for i.  last (head (hash)) is also
C       used as the head of a hash bucket if head (hash) contains a
C       degree list (see head, below).
C
C       On output, last (1..n) holds the permutation (the same as the
C       'PERM' argument in Sparspak).  That is, if i = last (k), then
C       row i is the kth pivot row.  Row last (k) of A is the k-th row
C       in the permuted matrix, PAP^T.
C ncmpa:        The number of times iw was compressed.  If this is
C       excessive, then the execution took longer than what could have
C       been.  To reduce ncmpa, try increasing iwlen to be 10% or 20%
C       larger than the value of pfree on input (or at least
C       iwlen .ge. pfree + n).  The fastest performance will be
C       obtained when ncmpa is returned as zero.  If iwlen is set to
C       the value returned by pfree on *output*, then no compressions
C       will occur.
C-----------------------------------------------------------------------
C LOCAL (not input or output - used only during execution):
C-----------------------------------------------------------------------
C degree:       If i is a supervariable, then degree (i) holds the
C       current approximation of the external degree of row i (an upper
C       bound).  The external degree is the number of nonzeros in row i,
C       minus abs (nv (i)) (the diagonal part).  The bound is equal to
C       the external degree if elen (i) is less than or equal to two.
C
C       We also use the term "external degree" for elements e to refer
C       to |Le \ Lme|.  If e is an element, then degree (e) holds |Le|,
C       which is the degree of the off-diagonal part of the element e
C       (not including the diagonal part).
C head: head is used for degree lists.  head (deg) is the first
C       supervariable in a degree list (all supervariables i in a
C       degree list deg have the same approximate degree, namely,
C       deg = degree (i)).  If the list deg is empty then
C       head (deg) = 0.
C
C       During supervariable detection head (hash) also serves as a
C       pointer to a hash bucket.
C       If head (hash) .gt. 0, there is a degree list of degree hash.
C               The hash bucket head pointer is last (head (hash)).
C       If head (hash) = 0, then the degree list and hash bucket are
C               both empty.
C       If head (hash) .lt. 0, then the degree list is empty, and
C               -head (hash) is the head of the hash bucket.
C       After supervariable detection is complete, all hash buckets
C       are empty, and the (last (head (hash)) = 0) condition is
C       restored for the non-empty degree lists.
C next: next (i) is the supervariable following i in a link list, or
C       zero if i is the last in the list.  Used for two kinds of
C       lists:  degree lists and hash buckets (a supervariable can be
C       in only one kind of list at a time).
C w:    The flag array w determines the status of elements and
C       variables, and the external degree of elements.
C
C       for elements:
C          if w (e) = 0, then the element e is absorbed
C          if w (e) .ge. wflg, then w (e) - wflg is the size of
C               the set |Le \ Lme|, in terms of nonzeros (the
C               sum of abs (nv (i)) for each principal variable i that
C               is both in the pattern of element e and NOT in the
C               pattern of the current pivot element, me).
C          if wflg .gt. w (e) .gt. 0, then e is not absorbed and has
C               not yet been seen in the scan of the element lists in
C               the computation of |Le\Lme| in loop 150 below.
C
C       for variables:
C          during supervariable detection, if w (j) .ne. wflg then j is
C          not in the pattern of variable i
C
C       The w array is initialized by setting w (i) = 1 for all i,
C       and by setting wflg = 2.  It is reinitialized if wflg becomes
C       too large (to ensure that wflg+n does not cause integer
C       overflow).
C-----------------------------------------------------------------------
C LOCAL INTEGERS:
C-----------------------------------------------------------------------
      INTEGER :: DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I,
     &        ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3,
     &        LENJ, LN, ME, MINDEG, NEL, 
     &        NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X, 
     &        NPRINC
      INTEGER KNT1_UPDATED, KNT2_UPDATED
      INTEGER(8) :: MAXMEM, MEM, NEWMEM
      INTEGER    :: MAXINT_N
      INTEGER(8) :: HASH, HMOD
C deg:        the degree of a variable or element
C degme:      size, |Lme|, of the current element, me (= degree (me))
C dext:       external degree, |Le \ Lme|, of some element e
C dmax:       largest |Le| seen so far
C e:          an element
C elenme:     the length, elen (me), of element list of pivotal var.
C eln:        the length, elen (...), of an element list
C hash:       the computed value of the hash function
C hmod:       the hash function is computed modulo hmod = max (1,n-1)
C i:          a supervariable
C ilast:      the entry in a link list preceding i
C inext:      the entry in a link list following i
C j:          a supervariable
C jlast:      the entry in a link list preceding j
C jnext:      the entry in a link list, or path, following j
C k:          the pivot order of an element or variable
C knt1:       loop counter used during element construction
C knt2:       loop counter used during element construction
C knt3:       loop counter used during compression
C lenj:       len (j)
C ln:         length of a supervariable list
C maxint_n    large integer to test risk of overflow on wflg
C maxmem:     amount of memory needed for no compressions
C me:         current supervariable being eliminated, and the
C                     current element created by eliminating that
C                     supervariable
C mem:        memory in use assuming no compressions have occurred
C mindeg:     current minimum degree
C nel:        number of pivots selected so far
C newmem:     amount of new memory needed for current pivot element
C nleft:      n - nel, the number of nonpivotal rows/columns remaining
C nvi:        the number of variables in a supervariable i (= nv (i))
C nvj:        the number of variables in a supervariable j (= nv (j))
C nvpiv:      number of pivots in current element
C slenme:     number of variables in variable list of pivotal variable
C we:         w (e)
C wflg:       used for flagging the w array.  See description of iw.
C wnvi:       wflg - nv (i)
C x:          either a supervariable or an element
C nprinc :    number of principal variables = number of varialbles
C             of the compressed graph.
C             (if the graph is not compressed then nprinc = n)
C-----------------------------------------------------------------------
C LOCAL POINTERS:
C-----------------------------------------------------------------------
      INTEGER(8) :: P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, 
     &              PN, PSRC 
C             Any parameter (pe (...) or pfree) or local variable
C             starting with "p" (for Pointer) is an index into iw,
C             and all indices into iw use variables starting with
C             "p."  The only exception to this rule is the iwlen
C             input argument.
C p:          pointer into lots of things
C p1:         pe (i) for some variable i (start of element list)
C p2:         pe (i) + elen (i) -  1 for some var. i (end of el. list)
C p3:         index of first supervariable in clean list
C pdst:       destination pointer, for compression
C pend:       end of memory to compress
C pj:         pointer into an element or variable
C pme:        pointer into the current element (pme1...pme2)
C pme1:       the current element, me, is stored in iw (pme1...pme2)
C pme2:       the end of the current element
C pn:         pointer into a "clean" variable, also used to compress
C psrc:       source pointer, for compression
C-----------------------------------------------------------------------
C  FUNCTIONS CALLED:
C-----------------------------------------------------------------------
      INTRINSIC max, min, mod
C=======================================================================
C  INITIALIZATIONS
C=======================================================================
      wflg = 2
      maxint_n=huge(wflg)-n
      mindeg = 1
      ncmpa = 0
      nel = 0
      hmod = int(max(1, n-1),kind=8)
      dmax = 0
      mem = pfree - 1
      maxmem = mem
      nprinc = 0
      DO i = 1, n
        last(i) = 0
        head(i) = 0
        nv(i) = 1
        w(i) = 1
        elen(i) = 0
      ENDDO
      DO i=1, n
        IF (len(i).GE.0) THEN
           degree(i) = len(i)
           nprinc = nprinc + 1
        ELSE
C          i is a secondary variable belonging 
C          to supervariable j=-len (i)
           j        = -len(i)
C          used only to skip secondary variables in loop 20
           degree(i) = - 1
           IF ( pe(i) .NE. 0_8 ) THEN
C            adjacency list of secondary variable was 
C            provided by the user, 
C            the space will be compressed if necessary
             len(i) = len(j)
           ELSE
             len(i) = 0
           ENDIF
           pe(i)   = int(-j,8)
           nv(j)   = nv(j) + nv(i)
           nv(i)   = 0
           elen(i) = 0
        ENDIF
      ENDDO
C     ----------------------------------------------------------------
C     initialize degree lists and eliminate rows with no off-diag. nz.
C     ----------------------------------------------------------------
      DO 20 i = 1, n
        deg = degree(i)
C       degree(i) < 0 corresponds to secondary variables
C       that need be skipped.
        IF (deg .GT. 0) THEN
C         ----------------------------------------------------------
C         place i in the degree list corresponding to its degree
C         ----------------------------------------------------------
          inext = head(deg)
          IF (inext .NE. 0) last(inext) = i
          next(i) = inext
          head(deg) = i
        ELSE IF ( deg.EQ. 0) THEN
C         ----------------------------------------------------------
C         we have a variable that can be eliminated at once because
C         there is no off-diagonal non-zero in its row.
C         ----------------------------------------------------------
C
C         We have a graph of supervariable and thus need to update 
C         singleton that might already be supervariables with nv(i)
C         When a supervariable is eliminated its 
C        principal variable must be set to the current step
C         (NEL+1) which must be stored (negated) in ELEN  
C         ONLY THEN (current step) NEL should be incremented.
C         This will be exploited when computing the global ordering
C         of all (secondary and principal) variables at the end of the AMD routine.
          elen(i) = - (nel + 1)
          nel = nel + nv(i)
          pe(i) = 0_8
          w(i) = 0
        ENDIF
   20 CONTINUE
C=======================================================================
C  WHILE (selecting pivots) DO
C=======================================================================
C
C  Note that we do want to loop until NEL = N since
C  we update NEL with the size of the eliminated supervariable
C  
   30 IF (nel .LT. n) THEN
C=======================================================================
C  GET PIVOT OF MINIMUM DEGREE
C=======================================================================
C       -------------------------------------------------------------
C       find next supervariable for elimination
C       -------------------------------------------------------------
        DO 40 deg = mindeg, n
          me = head(deg)
          IF (me .GT. 0) GO TO 50
   40   CONTINUE
   50   mindeg = deg
C       -------------------------------------------------------------
C       remove chosen variable from link list
C       -------------------------------------------------------------
        inext = next(me)
        IF (inext .NE. 0) last(inext) = 0
        head(deg) = inext
C       -------------------------------------------------------------
C       me represents the elimination of pivots nel+1 to nel+nv(me).
C       place me itself as the first in this set.  It will be moved
C       to the nel+nv(me) position when the permutation vectors are
C       computed.
C       -------------------------------------------------------------
        elenme = elen(me)
        elen(me) = - (nel + 1)
        nvpiv = nv(me)
        nel = nel + nvpiv
C=======================================================================
C  CONSTRUCT NEW ELEMENT
C=======================================================================
C       -------------------------------------------------------------
C       At this point, me is the pivotal supervariable.  It will be
C       converted into the current element.  Scan list of the
C       pivotal supervariable, me, setting tree pointers and
C       constructing new list of supervariables for the new element,
C       me.  p is a pointer to the current position in the old list.
C       -------------------------------------------------------------
C       flag the variable "me" as being in Lme by negating nv (me)
        nv(me) = -nvpiv
        degme = 0
        IF (elenme .EQ. 0) THEN
C         ----------------------------------------------------------
C         construct the new element in place
C         ----------------------------------------------------------
          pme1 = pe(me)
          pme2 = pme1 - 1
          DO 60 p = pme1, pme1 + int(len(me) - 1,8)
            i = iw(p)
            nvi = nv(i)
            IF (nvi .GT. 0) THEN
C             ----------------------------------------------------
C             i is a principal variable not yet placed in Lme.
C             store i in new list
C             ----------------------------------------------------
              degme = degme + nvi
C             flag i as being in Lme by negating nv (i)
              nv(i) = -nvi
              pme2 = pme2 + 1_8
              iw(pme2) = i
C             ----------------------------------------------------
C             remove variable i from degree list.
C             ----------------------------------------------------
              ilast = last(i)
              inext = next(i)
              IF (inext .NE. 0) last(inext) = ilast
              IF (ilast .NE. 0) THEN
                next(ilast) = inext
              ELSE
C               i is at the head of the degree list
                head(degree(i)) = inext
              ENDIF
            ENDIF
   60     CONTINUE
C         this element takes no new memory in iw:
          newmem = 0
        ELSE
C         ----------------------------------------------------------
C         construct the new element in empty space, iw (pfree ...)
C         ----------------------------------------------------------
          p = pe(me)
          pme1 = pfree
          slenme = len(me) - elenme
          knt1_updated = 0
          DO 120 knt1 = 1, elenme + 1
            knt1_updated = knt1_updated +1
            IF (knt1 .GT. elenme) THEN
C             search the supervariables in me.
              e = me
              pj = p
              ln = slenme
            ELSE
C             search the elements in me.
              e = iw(p)
              p = p + 1
              pj = pe(e)
              ln = len(e)
            ENDIF
C           -------------------------------------------------------
C           search for different supervariables and add them to the
C           new list, compressing when necessary. this loop is
C           executed once for each element in the list and once for
C           all the supervariables in the list.
C           -------------------------------------------------------
            knt2_updated = 0
            DO 110 knt2 = 1, ln
              knt2_updated = knt2_updated+1
              i = iw(pj)
              pj = pj + 1
              nvi = nv(i)
              IF (nvi .GT. 0) THEN
C               -------------------------------------------------
C               compress iw, if necessary
C               -------------------------------------------------
                IF (pfree .GT. iwlen) THEN
C                 prepare for compressing iw by adjusting
C                 pointers and lengths so that the lists being
C                 searched in the inner and outer loops contain
C                 only the remaining entries.
                  pe(me) = p
                  len(me) = len(me) - knt1_updated
C                 Reset KNT1_UPDATED in case of recompress 
C                 at same iteration of the loop 120
                  knt1_updated = 0
C                 Check if anything left in supervariable ME
                  IF (len(me) .EQ. 0) pe(me) = 0_8
                  pe(e) = pj
                  len(e) = ln - knt2_updated
C                 Reset KNT2_UPDATED in case of recompress 
C                 at same iteration of the loop 110
                  knt2_updated = 0
C                 Check if anything left in element E
                  IF (len(e) .EQ. 0) pe(e) = 0_8
                  ncmpa = ncmpa + 1
C                 store first item in pe
C                 set first entry to -item
                  DO 70 j = 1, n
                    pn = pe(j)
                    IF (pn .GT. 0_8) THEN
                      pe(j) = int(iw(pn),8)
                      iw(pn) = -j
                    ENDIF
   70             CONTINUE
C                 psrc/pdst point to source/destination
                  pdst = 1
                  psrc = 1
                  pend = pme1 - 1
C                 while loop:
   80             CONTINUE
                  IF (psrc .LE. pend) THEN
C                   search for next negative entry
                    j = -iw(psrc)
                    psrc = psrc + 1
                    IF (j .GT. 0) THEN
                      iw(pdst) = int(pe(j))
                      pe(j) = pdst
                      pdst = pdst + 1_8
C                     copy from source to destination
                      lenj = len(j)
                      DO 90 knt3 = 0, lenj - 2
                        iw(pdst + knt3) = iw(psrc + knt3)
   90                 CONTINUE
                      pdst = pdst + int(lenj - 1,8)
                      psrc = psrc + int(lenj - 1,8)
                    ENDIF
                    GO TO 80
                  ENDIF
C                 move the new partially-constructed element
                  p1 = pdst
                  DO 100 psrc = pme1, pfree - 1
                    iw(pdst) = iw(psrc)
                    pdst = pdst + 1
  100             CONTINUE
                  pme1 = p1
                  pfree = pdst
                  pj = pe(e)
                  p = pe(me)
                ENDIF
C               -------------------------------------------------
C               i is a principal variable not yet placed in Lme
C               store i in new list
C               -------------------------------------------------
                degme = degme + nvi
C               flag i as being in Lme by negating nv (i)
                nv(i) = -nvi
                iw(pfree) = i
                pfree = pfree + 1
C               -------------------------------------------------
C               remove variable i from degree link list
C               -------------------------------------------------
                ilast = last(i)
                inext = next(i)
                IF (inext .NE. 0) last(inext) = ilast
                IF (ilast .NE. 0) THEN
                  next(ilast) = inext
                ELSE
C                 i is at the head of the degree list
                  head(degree(i)) = inext
                ENDIF
              ENDIF
  110       CONTINUE
            IF (e .NE. me) THEN
C             set tree pointer and flag to indicate element e is
C             absorbed into new element me (the parent of e is me)
              pe(e) = int(-me,8)
              w(e) = 0
            ENDIF
  120     CONTINUE
          pme2 = pfree - 1
C         this element takes newmem new memory in iw (possibly zero)
          newmem = pfree - pme1
          mem = mem + newmem
          maxmem = max(maxmem, mem)
        ENDIF
C       -------------------------------------------------------------
C       me has now been converted into an element in iw (pme1..pme2)
C       -------------------------------------------------------------
C       degme holds the external degree of new element
        degree(me) = degme
        pe(me) = pme1
        len(me) = int(pme2 - pme1 + 1)
C       -------------------------------------------------------------
C       make sure that wflg is not too large.  With the current
C       value of wflg, wflg+n must not cause integer overflow
C       -------------------------------------------------------------
        IF (wflg .GT. maxint_n) THEN
          DO 130 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  130     CONTINUE
          wflg = 2
        ENDIF
C=======================================================================
C  COMPUTE (w (e) - wflg) = |Le\Lme| FOR ALL ELEMENTS
C=======================================================================
C       -------------------------------------------------------------
C       Scan 1:  compute the external degrees of previous elements
C       with respect to the current element.  That is:
C            (w (e) - wflg) = |Le \ Lme|
C       for each element e that appears in any supervariable in Lme.
C       The notation Le refers to the pattern (list of
C       supervariables) of a previous element e, where e is not yet
C       absorbed, stored in iw (pe (e) + 1 ... pe (e) + iw (pe (e))).
C       The notation Lme refers to the pattern of the current element
C       (stored in iw (pme1..pme2)).   If (w (e) - wflg) becomes
C       zero, then the element e will be absorbed in scan 2.
C       -------------------------------------------------------------
        DO 150 pme = pme1, pme2
          i = iw(pme)
          eln = elen(i)
          IF (eln .GT. 0) THEN
C           note that nv (i) has been negated to denote i in Lme:
            nvi = -nv(i)
            wnvi = wflg - nvi
            DO 140 p = pe(i), pe(i) + int(eln - 1,8)
              e = iw(p)
              we = w(e)
              IF (we .GE. wflg) THEN
C               unabsorbed element e has been seen in this loop
                we = we - nvi
              ELSE IF (we .NE. 0) THEN
C               e is an unabsorbed element
C               this is the first we have seen e in all of Scan 1
                we = degree(e) + wnvi
              ENDIF
              w(e) = we
  140       CONTINUE
          ENDIF
  150   CONTINUE
C=======================================================================
C  DEGREE UPDATE AND ELEMENT ABSORPTION
C=======================================================================
C       -------------------------------------------------------------
C       Scan 2:  for each i in Lme, sum up the degree of Lme (which
C       is degme), plus the sum of the external degrees of each Le
C       for the elements e appearing within i, plus the
C       supervariables in i.  Place i in hash list.
C       -------------------------------------------------------------
        DO 180 pme = pme1, pme2
          i = iw(pme)
          p1 = pe(i)
          p2 = p1 + int(elen(i) - 1,8)
          pn = p1
          hash = 0_8
          deg = 0
C         ----------------------------------------------------------
C         scan the element list associated with supervariable i
C         ----------------------------------------------------------
          DO 160 p = p1, p2
            e = iw(p)
C           dext = | Le \ Lme |
            dext = w(e) - wflg
            IF (dext .GT. 0) THEN
              deg = deg + dext
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e,kind=8)
            ELSE IF (dext .EQ. 0) THEN
#if defined (NOAGG2)
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e,kind=8)
#else
C             aggressive absorption: e is not adjacent to me, but
C             the |Le \ Lme| is 0, so absorb it into me
              pe(e) = int(-me,8)
              w(e) = 0
#endif
            ENDIF
  160     CONTINUE
C         count the number of elements in i (including me):
          elen(i) = int(pn - p1 + 1_8)
C         ----------------------------------------------------------
C         scan the supervariables in the list associated with i
C         ----------------------------------------------------------
          p3 = pn
          DO 170 p = p2 + 1, p1 + int(len(i) - 1,8)
            j = iw(p)
            nvj = nv(j)
            IF (nvj .GT. 0) THEN
C             j is unabsorbed, and not in Lme.
C             add to degree and add to new list
              deg = deg + nvj
              iw(pn) = j
              pn = pn + 1
              hash = hash + int(j,kind=8)
            ENDIF
  170     CONTINUE
C         ----------------------------------------------------------
C         update the degree and check for mass elimination
C         ----------------------------------------------------------
#if defined (NOAGG2)
          IF (deg.EQ.0.AND.(elen(i).GT.1)) THEN
C         When DEG is zero we need to 
C         absorb in ME all elements adjacent to I 
                   p1 = pe(i)
C                  exclude ME --> -2 
                   p2 = p1 + int(elen(i),8) - 2_8
                   DO p =p1,p2  
                     e      = iw(p)
                     pe(e) = int(-me,8)
                     w(e)  = 0
                   ENDDO
          ENDIF
C              .... Ready for mass elimination
#endif
          IF (deg .EQ. 0) THEN
C           -------------------------------------------------------
C           mass elimination
C           -------------------------------------------------------
C           There is nothing left of this node except for an
C           edge to the current pivot element.  elen (i) is 1,
C           and there are no variables adjacent to node i.
C           Absorb i into the current pivot element, me.
            pe(i) = int(-me,8)
            nvi = -nv(i)
            degme = degme - nvi
            nvpiv = nvpiv + nvi
            nel = nel + nvi
            nv(i) = 0
            elen(i) = 0
          ELSE
C           -------------------------------------------------------
C           update the upper-bound degree of i
C           -------------------------------------------------------
C           the following degree does not yet include the size
C           of the current element, which is added later:
            degree(i) = min(degree(i), deg)
C           -------------------------------------------------------
C           add me to the list for i
C           -------------------------------------------------------
C           move first supervariable to end of list
            iw(pn) = iw(p3)
C           move first element to end of element part of list
            iw(p3) = iw(p1)
C           add new element to front of list.
            iw(p1) = me
C           store the new length of the list in len (i)
            len(i) = int(pn - p1 + 1_8)
C           -------------------------------------------------------
C           place in hash bucket.  Save hash key of i in last (i).
C           -------------------------------------------------------
            hash = mod(hash, hmod) + 1_8
            j = head(hash)
            IF (j .LE. 0) THEN
C             the degree list is empty, hash head is -j
              next(i) = -j
              head(hash) = -i
            ELSE
C             degree list is not empty
C             use last (head (hash)) as hash head
              next(i) = last(j)
              last(j) = i
            ENDIF
            last(i) = int(hash,kind=kind(last))
          ENDIF
  180   CONTINUE
        degree(me) = degme
C       -------------------------------------------------------------
C       Clear the counter array, w (...), by incrementing wflg.
C       -------------------------------------------------------------
        dmax = max(dmax, degme)
        wflg = wflg + dmax
C       make sure that wflg+n does not cause integer overflow
        IF (wflg .GT. maxint_n) THEN
          DO 190 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  190     CONTINUE
          wflg = 2
        ENDIF
C       at this point, w (1..n) .lt. wflg holds
C=======================================================================
C  SUPERVARIABLE DETECTION
C=======================================================================
        DO 250 pme = pme1, pme2
          i = iw(pme)
          IF (nv(i) .LT. 0) THEN
C           i is a principal variable in Lme
C           -------------------------------------------------------
C           examine all hash buckets with 2 or more variables.  We
C           do this by examing all unique hash keys for super-
C           variables in the pattern Lme of the current element, me
C           -------------------------------------------------------
            hash = int(last(i),kind=8)
C           let i = head of hash bucket, and empty the hash bucket
            j = head(hash)
            IF (j .EQ. 0) GO TO 250
            IF (j .LT. 0) THEN
C             degree list is empty
              i = -j
              head(hash) = 0
            ELSE
C             degree list is not empty, restore last () of head
              i = last(j)
              last(j) = 0
            ENDIF
            IF (i .EQ. 0) GO TO 250
C           while loop:
  200       CONTINUE
            IF (next(i) .NE. 0) THEN
C             ----------------------------------------------------
C             this bucket has one or more variables following i.
C             scan all of them to see if i can absorb any entries
C             that follow i in hash bucket.  Scatter i into w.
C             ----------------------------------------------------
              ln = len(i)
              eln = elen(i)
C             do not flag the first element in the list (me)
              DO 210 p = pe(i) + 1, pe(i) + int(ln - 1,8)
                w(iw(p)) = wflg
  210         CONTINUE
C             ----------------------------------------------------
C             scan every other entry j following i in bucket
C             ----------------------------------------------------
              jlast = i
              j = next(i)
C             while loop:
  220         CONTINUE
              IF (j .NE. 0) THEN
C               -------------------------------------------------
C               check if j and i have identical nonzero pattern
C               -------------------------------------------------
C               jump if i and j do not have same size data structure
                IF (len(j) .NE. ln) GO TO 240
C               jump if i and j do not have same number adj elts
                IF (elen(j) .NE. eln) GO TO 240
C               do not flag the first element in the list (me)
                DO 230 p = pe(j) + 1, pe(j) + int(ln - 1,8)
C                 jump if an entry (iw(p)) is in j but not in i
                  IF (w(iw(p)) .NE. wflg) GO TO 240
  230           CONTINUE
C               -------------------------------------------------
C               found it!  j can be absorbed into i
C               -------------------------------------------------
                pe(j) = int(-i,8)
C               both nv (i) and nv (j) are negated since they
C               are in Lme, and the absolute values of each
C               are the number of variables in i and j:
                nv(i) = nv(i) + nv(j)
                nv(j) = 0
                elen(j) = 0
C               delete j from hash bucket
                j = next(j)
                next(jlast) = j
                GO TO 220
C               -------------------------------------------------
  240           CONTINUE
C               j cannot be absorbed into i
C               -------------------------------------------------
                jlast = j
                j = next(j)
              GO TO 220
              ENDIF
C             ----------------------------------------------------
C             no more variables can be absorbed into i
C             go to next i in bucket and clear flag array
C             ----------------------------------------------------
              wflg = wflg + 1
              i = next(i)
              IF (i .NE. 0) GO TO 200
            ENDIF
          ENDIF
  250   CONTINUE
C=======================================================================
C  RESTORE DEGREE LISTS AND REMOVE NONPRINCIPAL SUPERVAR. FROM ELEMENT
C=======================================================================
        p = pme1
        nleft = n - nel
        DO 260 pme = pme1, pme2
          i = iw(pme)
          nvi = -nv(i)
          IF (nvi .GT. 0) THEN
C           i is a principal variable in Lme
C           restore nv (i) to signify that i is principal
            nv(i) = nvi
C           -------------------------------------------------------
C           compute the external degree (add size of current elem)
C           -------------------------------------------------------
            deg = min(degree(i) + degme - nvi, nleft - nvi)
C           -------------------------------------------------------
C           place the supervariable at the head of the degree list
C           -------------------------------------------------------
            inext = head(deg)
            IF (inext .NE. 0) last(inext) = i
            next(i) = inext
            last(i) = 0
            head(deg) = i
C           -------------------------------------------------------
C           save the new degree, and find the minimum degree
C           -------------------------------------------------------
            mindeg = min(mindeg, deg)
            degree(i) = deg
C           -------------------------------------------------------
C           place the supervariable in the element pattern
C           -------------------------------------------------------
            iw(p) = i
            p = p + 1
          ENDIF
  260   CONTINUE
C=======================================================================
C  FINALIZE THE NEW ELEMENT
C=======================================================================
        nv(me) = nvpiv + degme
C       nv (me) is now the degree of pivot (including diagonal part)
C       save the length of the list for the new element me
        len(me) = int(p - pme1)
        IF (len(me) .EQ. 0) THEN
C         there is nothing left of the current pivot element
          pe(me) = 0_8
          w(me) = 0
        ENDIF
        IF (newmem .NE. 0) THEN
C         element was not constructed in place: deallocate part
C         of it (final size is less than or equal to newmem,
C         since newly nonprincipal variables have been removed).
          pfree = p
          mem = mem - newmem + int(len(me),8)
        ENDIF
C=======================================================================
C       END WHILE (selecting pivots)
      GO TO 30
      ENDIF
C=======================================================================
C=======================================================================
C  COMPUTE THE PERMUTATION VECTORS
C=======================================================================
C     ----------------------------------------------------------------
C     The time taken by the following code is O(n).  At this
C     point, elen (e) = -k has been done for all elements e,
C     and elen (i) = 0 has been done for all nonprincipal
C     variables i.  At this point, there are no principal
C     supervariables left, and all elements are absorbed.
C     ----------------------------------------------------------------
C     ----------------------------------------------------------------
C     compute the ordering of unordered nonprincipal variables
C     ----------------------------------------------------------------
      DO 290 i = 1, n
        IF (elen(i) .EQ. 0) THEN
C         ----------------------------------------------------------
C         i is an un-ordered row.  Traverse the tree from i until
C         reaching an element, e.  The element, e, was the
C         principal supervariable of i and all nodes in the path
C         from i to when e was selected as pivot.
C         ----------------------------------------------------------
          j = int(-pe(i))
C         while (j is a variable) do:
  270     CONTINUE
            IF (elen(j) .GE. 0) THEN
              j = int(-pe(j))
              GO TO 270
            ENDIF
            e = j
C           ----------------------------------------------------------
C           get the current pivot ordering of e
C           ----------------------------------------------------------
            k = -elen(e)
C           ----------------------------------------------------------
C           traverse the path again from i to e, and compress the
C           path (all nodes point to e).  Path compression allows
C           this code to compute in O(n) time.  Order the unordered
C           nodes in the path, and place the element e at the end.
C           ----------------------------------------------------------
            j = i
C           while (j is a variable) do:
  280       CONTINUE
            IF (elen(j) .GE. 0) THEN
              jnext = int(-pe(j))
              pe(j) = int(-e,8)
              IF (elen(j) .EQ. 0) THEN
C               j is an unordered row
                elen(j) = k
                k = k + 1
              ENDIF
              j = jnext
            GO TO 280
            ENDIF
C         leave elen (e) negative, so we know it is an element
          elen(e) = -k
        ENDIF
  290 CONTINUE
C     ----------------------------------------------------------------
C     reset the inverse permutation (elen (1..n)) to be positive,
C     and compute the permutation (last (1..n)).
C     ----------------------------------------------------------------
      DO 300 i = 1, n
        k = abs(elen(i))
        last(k) = i
        elen(i) = k
  300 CONTINUE
C=======================================================================
C  RETURN THE MEMORY USAGE IN IW
C=======================================================================
C     If maxmem is less than or equal to iwlen, then no compressions
C     occurred, and iw (maxmem+1 ... iwlen) was unused.  Otherwise
C     compressions did occur, and iwlen would have had to have been
C     greater than or equal to maxmem for no compressions to occur.
C     Return the value of maxmem in the pfree argument.
      pfree = maxmem
C===============================
C     Save PE in PARENT array
      DO i=1,n
       parent(i) = int(pe(i))
      ENDDO
C===============================
      RETURN

mumps_ana_h()

subroutine mumps_ana_h	(	integer, intent(in)	totel,
		logical, intent(in)	compute_perm,
		integer, intent(in)	n,
		integer(8), intent(in)	iwlen,
		integer(8), dimension(n), intent(inout)	pe,
		integer(8), intent(inout)	pfree,
		integer, dimension(n), intent(inout)	len,
		integer, dimension(iwlen), intent(inout)	iw,
		integer, dimension(n), intent(inout)	nv,
		integer, dimension(n), intent(out)	elen,
		integer, dimension(n), intent(out)	last,
		integer, intent(out)	ncmpa,
		integer, dimension(n)	degree,
		integer, dimension(totel)	head,
		integer, dimension(n)	next,
		integer, dimension(n)	w,
		integer, dimension(n), intent(out)	parent )

Definition at line 161 of file ana_orderings.F.

C 
C    Restrictive integer 64 bit variant :
C    it is assumed that IW array size can exceed 32-bit integer
C
C     Input not modified
      INTEGER, INTENT(IN)     :: TOTEL, N
      INTEGER(8), INTENT(IN)  :: IWLEN
      LOGICAL, INTENT(IN)     :: COMPUTE_PERM
C     Input undefined on output 
      INTEGER, INTENT(INOUT)  :: LEN(N), IW(IWLEN)
C 
C     Output only 
      INTEGER, INTENT(OUT)   :: NCMPA
      INTEGER, INTENT(OUT)   :: ELEN(N), LAST(N), PARENT(N)
C 
C     Input/output
      INTEGER(8), INTENT(INOUT) :: PFREE
      INTEGER(8), INTENT(INOUT) :: PE(N)
C     NV also meaningful as input to encode compressed graphs
      INTEGER, INTENT(INOUT) :: NV(N)
C 
C     Internal Workspace only
      INTEGER         :: NEXT(N), DEGREE(N), HEAD(TOTEL), W(N)
C ---------------------
C Interface Description
C ---------------------
C INPUT ARGUMENTS (unaltered):
C-----------------------------
C n     : The matrix order.
C         number of supervariables if compress/blocked format
C         Restriction:  n .ge. 1
C totel : Number of variables to eliminate
C         In case of blocked format:
C         each variable i is a supervariable of size nv(i)
C         totel is computed as the sum(nv(i)) for i \in [1:n]
C         the algorithm stops when totel variables are
C         eliminated.
C compute_perm : indicates if permutations should be computed 
C         on output in last/elen 
C iwlen:        The length of iw (1..iwlen).  On input, the matrix is
C       stored in iw (1..pfree-1).  However, iw (1..iwlen) should be
C       slightly larger than what is required to hold the matrix, at
C       least iwlen .ge. pfree + n is recommended.  Otherwise,
C       excessive compressions will take place.
C       *** We do not recommend running this algorithm with ***
C       ***      iwlen .lt. pfree + n.                      ***
C       *** Better performance will be obtained if          ***
C       ***      iwlen .ge. pfree + n                       ***
C       *** or better yet                                   ***
C       ***      iwlen .gt. 1.2 * pfree                     ***
C       *** (where pfree is its value on input).            ***
C       The algorithm will not run at all if iwlen .lt. pfree-1.
C
C       Restriction: iwlen .ge. pfree-1
C-----------------------------------------------------------------------
C INPUT/OUPUT ARGUMENTS:
C-----------------------------------------------------------------------
C pe:   On input, pe (i) is the index in iw of the start of row i, or
C       zero if row i has no off-diagonal non-zeros.
C
C       During execution, it is used for both supervariables and
C       elements:
C
C       * Principal supervariable i:  index into iw of the
C               description of supervariable i.  A supervariable
C               represents one or more rows of the matrix
C               with identical nonzero pattern.
C       * Non-principal supervariable i:  if i has been absorbed
C               into another supervariable j, then pe (i) = -j.
C               That is, j has the same pattern as i.
C               Note that j might later be absorbed into another
C               supervariable j2, in which case pe (i) is still -j,
C               and pe (j) = -j2.
C       * Unabsorbed element e:  the index into iw of the description
C               of element e, if e has not yet been absorbed by a
C               subsequent element.  Element e is created when
C               the supervariable of the same name is selected as
C               the pivot.
C       * Absorbed element e:  if element e is absorbed into element
C               e2, then pe (e) = -e2.  This occurs when the pattern of
C               e (that is, Le) is found to be a subset of the pattern
C               of e2 (that is, Le2).  If element e is "null" (it has
C               no nonzeros outside its pivot block), then pe (e) = 0.
C
C       On output, pe holds the assembly tree/forest, which implicitly
C       represents a pivot order with identical fill-in as the actual
C       order (via a depth-first search of the tree).
C
C       On output:  (PE is copied on output into PARENT array)
C       If nv (i) .gt. 0, then i represents a node in the assembly tree,
C       and the parent of i is -pe (i), or zero if i is a root.
C       If nv (i) = 0, then (i,-pe (i)) represents an edge in a
C       subtree, the root of which is a node in the assembly tree.
C pfree:On input, the matrix is stored in iw (1..pfree-1) and
C       the rest of the array iw is free.
C       During execution, additional data is placed in iw, and pfree
C       is modified so that components  of iw from pfree are free.
C       On output, pfree is set equal to the size of iw that
C       would have been needed for no compressions to occur.  If
C       ncmpa is zero, then pfree (on output) is less than or equal to
C       iwlen, and the space iw (pfree+1 ... iwlen) was not used.
C       Otherwise, pfree (on output) is greater than iwlen, and all the
C       memory in iw was used.
C nv:   On input, encoding of compressed graph:
C       if nv(1) = -1 then graph is not compressed otherwise
C       nv(I) holds the weight of node I. 
C       During execution, abs (nv (i)) is equal to the number of rows
C       that are represented by the principal supervariable i.  If i is
C       a nonprincipal variable, then nv (i) = 0.  
C       nv (i) .lt. 0 signifies that i is a
C       principal variable in the pattern Lme of the current pivot
C       element me.  
C       On output, nv (e) holds the true degree of element
C       e at the time it was created (including the diagonal part).
C-----------------------------------------------------------------------
C INPUT/MODIFIED (undefined on output):
C-----------------------------------------------------------------------
C len:  On input, len (i) holds the number of entries in row i of the
C       matrix, excluding the diagonal.  The contents of len (1..n)
C       are undefined on output.
C iw:   On input, iw (1..pfree-1) holds the description of each row i
C       in the matrix.  The matrix must be symmetric, and both upper
C       and lower triangular parts must be present.  The diagonal must
C       not be present.  
C       Row i is held as follows:
C               len (i):  the length of the row i data structure
C               iw (pe (i) ... pe (i) + len (i) - 1):
C                       the list of column indices for nonzeros
C                       in row i (simple supervariables), excluding
C                       the diagonal.  All supervariables start with
C                       one row/column each (supervariable i is just
C                       row i).
C               if len (i) is zero on input, then pe (i) is ignored
C               on input.
C
C               Note that the rows need not be in any particular order,
C               and there may be empty space between the rows.
C
C       During execution, the supervariable i experiences fill-in.
C       This is represented by placing in i a list of the elements
C       that cause fill-in in supervariable i:
C
C               len (i):  the length of supervariable i
C               iw (pe (i) ... pe (i) + elen (i) - 1):
C                       the list of elements that contain i.  This list
C                       is kept short by removing absorbed elements.
C               iw (pe (i) + elen (i) ... pe (i) + len (i) - 1):
C                       the list of supervariables in i.  This list
C                       is kept short by removing nonprincipal
C                       variables, and any entry j that is also
C                       contained in at least one of the elements
C                       (j in Le) in the list for i (e in row i).
C
C       When supervariable i is selected as pivot, we create an
C       element e of the same name (e=i):
C
C               len (e):  the length of element e
C               iw (pe (e) ... pe (e) + len (e) - 1):
C                       the list of supervariables in element e.
C
C       An element represents the fill-in that occurs when supervariable
C       i is selected as pivot (which represents the selection of row i
C       and all non-principal variables whose principal variable is i).
C       We use the term Le to denote the set of all supervariables
C       in element e.  Absorbed supervariables and elements are pruned
C       from these lists when computationally convenient.
C
C       CAUTION:  THE INPUT MATRIX IS OVERWRITTEN DURING COMPUTATION.
C       The contents of iw are undefined on output.
C-----------------------------------------------------------------------
C OUTPUT (need not be set on input):
C-----------------------------------------------------------------------
C elen: 
C       See the description of iw above.  At the start of execution,
C       elen (i) is set to zero.  During execution, elen (i) is the
C       number of elements in the list for supervariable i.  When e
C       becomes an element, elen (e) = -nel is set, where nel is the
C       current step of factorization.  elen (i) = 0 is done when i
C       becomes nonprincipal.
C
C       For variables, elen (i) .ge. 0 holds until just before the
C       permutation vectors are computed.  For elements,
C       elen (e) .lt. 0 holds.
C
C       On output elen (1..n) holds the inverse permutation (the same
C       as the 'INVP' argument in Sparspak).  That is, if k = elen (i),
C       then row i is the kth pivot row.  Row i of A appears as the
C       (elen(i))-th row in the permuted matrix, PAP^T.
C last: 
C       In a degree list, last (i) is the supervariable preceding i,
C       or zero if i is the head of the list.  In a hash bucket,
C       last (i) is the hash key for i.  last (head (hash)) is also
C       used as the head of a hash bucket if head (hash) contains a
C       degree list (see head, below).
C
C       On output, last (1..n) holds the permutation (the same as the
C       'PERM' argument in Sparspak).  That is, if i = last (k), then
C       row i is the kth pivot row.  Row last (k) of A is the k-th row
C       in the permuted matrix, PAP^T.
C ncmpa:        The number of times iw was compressed.  If this is
C       excessive, then the execution took longer than what could have
C       been.  To reduce ncmpa, try increasing iwlen to be 10% or 20%
C       larger than the value of pfree on input (or at least
C       iwlen .ge. pfree + n).  The fastest performance will be
C       obtained when ncmpa is returned as zero.  If iwlen is set to
C       the value returned by pfree on *output*, then no compressions
C       will occur.
C-----------------------------------------------------------------------
C LOCAL (not input or output - used only during execution):
C-----------------------------------------------------------------------
C degree:       If i is a supervariable, then degree (i) holds the
C       current approximation of the external degree of row i (an upper
C       bound).  The external degree is the number of nonzeros in row i,
C       minus abs (nv (i)) (the diagonal part).  The bound is equal to
C       the external degree if elen (i) is less than or equal to two.
C
C       We also use the term "external degree" for elements e to refer
C       to |Le \ Lme|.  If e is an element, then degree (e) holds |Le|,
C       which is the degree of the off-diagonal part of the element e
C       (not including the diagonal part).
C head: head is used for degree lists.  head (deg) is the first
C       supervariable in a degree list (all supervariables i in a
C       degree list deg have the same approximate degree, namely,
C       deg = degree (i)).  If the list deg is empty then
C       head (deg) = 0.
C
C       During supervariable detection head (hash) also serves as a
C       pointer to a hash bucket.
C       If head (hash) .gt. 0, there is a degree list of degree hash.
C               The hash bucket head pointer is last (head (hash)).
C       If head (hash) = 0, then the degree list and hash bucket are
C               both empty.
C       If head (hash) .lt. 0, then the degree list is empty, and
C               -head (hash) is the head of the hash bucket.
C       After supervariable detection is complete, all hash buckets
C       are empty, and the (last (head (hash)) = 0) condition is
C       restored for the non-empty degree lists.
C next: next (i) is the supervariable following i in a link list, or
C       zero if i is the last in the list.  Used for two kinds of
C       lists:  degree lists and hash buckets (a supervariable can be
C       in only one kind of list at a time).
C w:    The flag array w determines the status of elements and
C       variables, and the external degree of elements.
C
C       for elements:
C          if w (e) = 0, then the element e is absorbed
C          if w (e) .ge. wflg, then w (e) - wflg is the size of
C               the set |Le \ Lme|, in terms of nonzeros (the
C               sum of abs (nv (i)) for each principal variable i that
C               is both in the pattern of element e and NOT in the
C               pattern of the current pivot element, me).
C          if wflg .gt. w (e) .gt. 0, then e is not absorbed and has
C               not yet been seen in the scan of the element lists in
C               the computation of |Le\Lme| in loop 150 below.
C
C       for variables:
C          during supervariable detection, if w (j) .ne. wflg then j is
C          not in the pattern of variable i
C
C       The w array is initialized by setting w (i) = 1 for all i,
C       and by setting wflg = 2.  It is reinitialized if wflg becomes
C       too large (to ensure that wflg+n does not cause integer
C       overflow).
C-----------------------------------------------------------------------
C LOCAL INTEGERS:
C-----------------------------------------------------------------------
      INTEGER   :: DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I,
     &        ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3,
     &        LENJ, LN,  ME,  MINDEG, NEL, 
     &        NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X
      INTEGER KNT1_UPDATED, KNT2_UPDATED
      INTEGER(8) :: MAXMEM, MEM, NEWMEM
      INTEGER    :: MAXINT_N
      INTEGER(8) :: HASH, HMOD
C deg:        the degree of a variable or element
C degme:      size, |Lme|, of the current element, me (= degree (me))
C dext:       external degree, |Le \ Lme|, of some element e
C dmax:       largest |Le| seen so far
C e:          an element
C elenme:     the length, elen (me), of element list of pivotal var.
C eln:        the length, elen (...), of an element list
C hash:       the computed value of the hash function
C hmod:       the hash function is computed modulo hmod = max (1,n-1)
C i:          a supervariable
C ilast:      the entry in a link list preceding i
C inext:      the entry in a link list following i
C j:          a supervariable
C jlast:      the entry in a link list preceding j
C jnext:      the entry in a link list, or path, following j
C k:          the pivot order of an element or variable
C knt1:       loop counter used during element construction
C knt2:       loop counter used during element construction
C knt3:       loop counter used during compression
C lenj:       len (j)
C ln:         length of a supervariable list
C maxint_n    large integer to test risk of overflow on wflg
C maxmem:     amount of memory needed for no compressions
C me:         current supervariable being eliminated, and the
C                     current element created by eliminating that
C                     supervariable
C mem:        memory in use assuming no compressions have occurred
C mindeg:     current minimum degree
C nel:        number of pivots selected so far
C newmem:     amount of new memory needed for current pivot element
C nleft:      n - nel, the number of nonpivotal rows/columns remaining
C nvi:        the number of variables in a supervariable i (= nv (i))
C nvj:        the number of variables in a supervariable j (= nv (j))
C nvpiv:      number of pivots in current element
C slenme:     number of variables in variable list of pivotal variable
C we:         w (e)
C wflg:       used for flagging the w array.  See description of iw.
C wnvi:       wflg - nv (i)
C x:          either a supervariable or an element
C-----------------------------------------------------------------------
C LOCAL POINTERS:
C-----------------------------------------------------------------------
      INTEGER(8) P, P1, P2, P3, PDST, PEND, PJ, PME, 
     &           PME1, PME2, PN, PSRC
C             Any parameter (pe (...) or pfree) or local variable
C             starting with "p" (for Pointer) is an index into iw,
C             and all indices into iw use variables starting with
C             "p."  The only exception to this rule is the iwlen
C             input argument.
C p:          pointer into lots of things
C p1:         pe (i) for some variable i (start of element list)
C p2:         pe (i) + elen (i) -  1 for some var. i (end of el. list)
C p3:         index of first supervariable in clean list
C pdst:       destination pointer, for compression
C pend:       end of memory to compress
C pj:         pointer into an element or variable
C pme:        pointer into the current element (pme1...pme2)
C pme1:       the current element, me, is stored in iw (pme1...pme2)
C pme2:       the end of the current element
C pn:         pointer into a "clean" variable, also used to compress
C psrc:       source pointer, for compression
      LOGICAL COMPRESS
C-----------------------------------------------------------------------
C  FUNCTIONS CALLED:
C-----------------------------------------------------------------------
      INTRINSIC max, min, mod
C=======================================================================
C  INITIALIZATIONS
C=======================================================================
      wflg = 2
      maxint_n=huge(wflg)-n
      mindeg = 1
      ncmpa = 0
      nel = 0
      hmod = int(max(1, n-1),kind=8)
      dmax = 0
      mem = pfree - 1
      maxmem = mem
      DO i = 1, n
        last(i) = 0
        head(i) = 0
        w(i) = 1
        elen(i) = 0
      ENDDO
      DO i = 1, totel
        head(i) = 0
      ENDDO
      IF(nv(1) .LT. 0) THEN
         compress = .false.
      ELSE
         compress = .true.
      ENDIF
      IF (compress) THEN
         DO i=1,n
            degree(i) = 0
            DO p= pe(i) , pe(i)+int(len(i)-1,8)
               degree(i) = degree(i) + nv(iw(p))
            ENDDO
         ENDDO
      ELSE
         DO i=1,n
            nv(i) = 1
            degree(i) = len(i)
         ENDDO
      ENDIF
C
C     ----------------------------------------------------------------
C     initialize degree lists and eliminate rows with no off-diag. nz.
C     ----------------------------------------------------------------
      DO 20 i = 1, n
        deg = degree(i)
        IF (deg .GT. 0) THEN
C         ----------------------------------------------------------
C         place i in the degree list corresponding to its degree
C         ----------------------------------------------------------
          inext = head(deg)
          IF (inext .NE. 0) last(inext) = i
          next(i) = inext
          head(deg) = i
        ELSE
C         ----------------------------------------------------------
C         we have a variable that can be eliminated at once because
C         there is no off-diagonal non-zero in its row.
C         ----------------------------------------------------------
            nel = nel + nv(i)
          elen(i) = -nel
          pe(i) = 0
          w(i) = 0
        ENDIF
   20 CONTINUE
C =====================================================================
C  WHILE (selecting pivots) DO
C =====================================================================
   30 IF (nel .LT. totel) THEN
C =====================================================================
C  GET PIVOT OF MINIMUM DEGREE
C ======================================================================
C       -------------------------------------------------------------
C       find next supervariable for elimination
C       -------------------------------------------------------------
        DO 40 deg = mindeg, totel
          me = head (deg)
          IF (me .GT. 0) GO TO 50
   40   CONTINUE
   50   mindeg = deg
C       -------------------------------------------------------------
C       remove chosen variable from link list
C       -------------------------------------------------------------
        inext = next(me)
        IF (inext .NE. 0) last(inext) = 0
        head(deg) = inext
C       -------------------------------------------------------------
C       me represents the elimination of pivots nel+1 to nel+nv(me).
C       place me itself as the first in this set.  It will be moved
C       to the nel+nv(me) position when the permutation vectors are
C       computed.
C       -------------------------------------------------------------
        elenme = elen(me)
        elen(me) = - (nel + 1)
        nvpiv = nv(me)
        nel = nel + nvpiv
C=======================================================================
C  CONSTRUCT NEW ELEMENT
C=======================================================================
C       -------------------------------------------------------------
C       At this point, me is the pivotal supervariable.  It will be
C       converted into the current element.  Scan list of the
C       pivotal supervariable, me, setting tree pointers and
C       constructing new list of supervariables for the new element,
C       me.  p is a pointer to the current position in the old list.
C       -------------------------------------------------------------
C       flag the variable "me" as being in Lme by negating nv (me)
        nv(me) = -nvpiv
        degme = 0
        IF (elenme .EQ. 0) THEN
C         ----------------------------------------------------------
C         construct the new element in place
C         ----------------------------------------------------------
          pme1 = pe(me)
          pme2 = pme1 - 1
          DO 60 p = pme1, pme1 + len(me) - 1
            i = iw(p)
            nvi = nv(i)
            IF (nvi .GT. 0) THEN
C             ----------------------------------------------------
C             i is a principal variable not yet placed in Lme.
C             store i in new list
C             ----------------------------------------------------
              degme = degme + nvi
C             flag i as being in Lme by negating nv (i)
              nv(i) = -nvi
              pme2 = pme2 + 1
              iw(pme2) = i
C             ----------------------------------------------------
C             remove variable i from degree list.
C             ----------------------------------------------------
              ilast = last(i)
              inext = next(i)
              IF (inext .NE. 0) last(inext) = ilast
              IF (ilast .NE. 0) THEN
                next(ilast) = inext
              ELSE
C               i is at the head of the degree list
                head(degree(i)) = inext
              ENDIF
            ENDIF
   60     CONTINUE
C         this element takes no new memory in iw:
          newmem = 0
        ELSE
C         ----------------------------------------------------------
C         construct the new element in empty space, iw (pfree ...)
C         ----------------------------------------------------------
          p = pe(me)
          pme1 = pfree
          slenme = len(me) - elenme
          knt1_updated = 0
          DO 120 knt1 = 1, elenme + 1
            knt1_updated = knt1_updated +1
            IF (knt1 .GT. elenme) THEN
C             search the supervariables in me.
              e = me
              pj = p
              ln = slenme
            ELSE
C             search the elements in me.
              e = iw (p)
              p = p + 1
              pj = pe(e)
              ln = len(e)
            ENDIF
C           -------------------------------------------------------
C           search for different supervariables and add them to the
C           new list, compressing when necessary. this loop is
C           executed once for each element in the list and once for
C           all the supervariables in the list.
C           -------------------------------------------------------
            knt2_updated = 0
            DO 110 knt2 = 1, ln
              knt2_updated = knt2_updated+1
              i = iw(pj)
              pj = pj + 1
              nvi = nv(i)
              IF (nvi .GT. 0) THEN
C               -------------------------------------------------
C               compress iw, if necessary
C               -------------------------------------------------
                IF (pfree .GT. iwlen) THEN
C                 prepare for compressing iw by adjusting
C                 pointers and lengths so that the lists being
C                 searched in the inner and outer loops contain
C                 only the remaining entries.
                  pe(me) = p
                  len(me) = len(me) - knt1_updated
C                 Reset KNT1_UPDATED in case of recompress 
C                 at same iteration of the loop 120
                  knt1_updated = 0
C                 Check if anything left in supervariable ME
                  IF (len(me) .EQ. 0) pe(me) = 0
                  pe(e) = pj
                  len(e) = ln - knt2_updated
C                 Reset KNT2_UPDATED in case of recompress 
C                 at same iteration of the loop 110
                  knt2_updated = 0
C                 Check if anything left in element E
                  IF (len(e) .EQ. 0) pe(e) = 0
                  ncmpa = ncmpa + 1
C                 store first item in pe
C                 set first entry to -item
                  DO 70 j = 1, n
                    pn = pe(j)
                    IF (pn .GT. 0) THEN
                      pe(j) = int(iw(pn), 8)
                      iw(pn) = -j
                    ENDIF
   70             CONTINUE
C                 psrc/pdst point to source/destination
                  pdst = 1
                  psrc = 1
                  pend = pme1 - 1
C                 while loop:
   80             CONTINUE
                  IF (psrc .LE. pend) THEN
C                   search for next negative entry
                    j = -iw(psrc)
                    psrc = psrc + 1
                    IF (j .GT. 0) THEN
                      iw(pdst) = int(pe(j))
                      pe(j) = pdst
                      pdst = pdst + 1
C                     copy from source to destination
                      lenj = len(j)
                      DO 90 knt3 = 0, lenj - 2
                        iw(pdst + knt3) = iw(psrc + knt3)
   90                 CONTINUE
                      pdst = pdst + lenj - 1
                      psrc = psrc + lenj - 1
                    ENDIF
                    GO TO 80
                  ENDIF
C                 move the new partially-constructed element
                  p1 = pdst
                  DO 100 psrc = pme1, pfree - 1
                    iw(pdst) = iw(psrc)
                    pdst = pdst + 1
  100             CONTINUE
                  pme1 = p1
                  pfree = pdst
                  pj = pe(e)
                  p = pe(me)
                ENDIF
C               -------------------------------------------------
C               i is a principal variable not yet placed in Lme
C               store i in new list
C               -------------------------------------------------
                degme = degme + nvi
C               flag i as being in Lme by negating nv (i)
                nv(i) = -nvi
                iw(pfree) = i
                pfree = pfree + 1
C               -------------------------------------------------
C               remove variable i from degree link list
C               -------------------------------------------------
                ilast = last(i)
                inext = next(i)
                IF (inext .NE. 0) last(inext) = ilast
                IF (ilast .NE. 0) THEN
                  next(ilast) = inext
                ELSE
C                 i is at the head of the degree list
                  head(degree(i)) = inext
                ENDIF
              ENDIF
  110       CONTINUE
            IF (e .NE. me) THEN
C             set tree pointer and flag to indicate element e is
C             absorbed into new element me (the parent of e is me)
              pe(e) = int(-me,8)
              w(e) = 0
            ENDIF
  120     CONTINUE
          pme2 = pfree - 1
C         this element takes newmem new memory in iw (possibly zero)
          newmem = pfree - pme1
          mem = mem + newmem
          maxmem = max(maxmem, mem)
        ENDIF
C       -------------------------------------------------------------
C       me has now been converted into an element in iw (pme1..pme2)
C       -------------------------------------------------------------
C       degme holds the external degree of new element
        degree(me) = degme
        pe(me) = pme1
        len(me) = int(pme2 - pme1 + 1)
C       -------------------------------------------------------------
C       make sure that wflg is not too large.  With the current
C       value of wflg, wflg+n must not cause integer overflow
C       -------------------------------------------------------------
        IF (wflg .GT. maxint_n) THEN
          DO 130 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  130     CONTINUE
          wflg = 2
        ENDIF
C=======================================================================
C  COMPUTE (w (e) - wflg) = |Le\Lme| FOR ALL ELEMENTS
C=======================================================================
C       -------------------------------------------------------------
C       Scan 1:  compute the external degrees of previous elements
C       with respect to the current element.  That is:
C            (w (e) - wflg) = |Le \ Lme|
C       for each element e that appears in any supervariable in Lme.
C       The notation Le refers to the pattern (list of
C       supervariables) of a previous element e, where e is not yet
C       absorbed, stored in iw (pe (e) + 1 ... pe (e) + iw (pe (e))).
C       The notation Lme refers to the pattern of the current element
C       (stored in iw (pme1..pme2)).   If (w (e) - wflg) becomes
C       zero, then the element e will be absorbed in scan 2.
C       -------------------------------------------------------------
        DO 150 pme = pme1, pme2
          i = iw (pme)
          eln = elen(i)
          IF (eln .GT. 0) THEN
C           note that nv (i) has been negated to denote i in Lme:
            nvi = -nv(i)
            wnvi = wflg - nvi
            DO 140 p = pe(i), pe(i) + eln - 1
              e = iw(p)
              we = w (e)
              IF (we .GE. wflg) THEN
C               unabsorbed element e has been seen in this loop
                we = we - nvi
              ELSE IF (we .NE. 0) THEN
C               e is an unabsorbed element
C               this is the first we have seen e in all of Scan 1
                we = degree(e) + wnvi
              ENDIF
              w(e) = we
  140       CONTINUE
          ENDIF
  150   CONTINUE
C=======================================================================
C  DEGREE UPDATE AND ELEMENT ABSORPTION
C=======================================================================
C       -------------------------------------------------------------
C       Scan 2:  for each i in Lme, sum up the degree of Lme 
C       (which is degme), 
C       plus the sum of the external degrees of each Le
C       for the elements e appearing within i, plus the
C       supervariables in i.  Place i in hash list.
C       -------------------------------------------------------------
        DO 180 pme = pme1, pme2
          i = iw(pme)
          p1 = pe(i)
          p2 = p1 + elen(i) - 1
          pn = p1
          hash = 0_8
          deg = 0
C         ----------------------------------------------------------
C         scan the element list associated with supervariable i
C         ----------------------------------------------------------
          DO 160 p = p1, p2
            e = iw(p)
C           dext = | Le \ Lme |
            dext = w(e) - wflg
            IF (dext .GT. 0) THEN
              deg = deg + dext
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e,kind=8)
            ELSE IF (dext .EQ. 0) THEN
#if  defined (NOAGG1)
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e,kind=8)
#else
C             aggressive absorption: e is not adjacent to me, but
C             the |Le \ Lme| is 0, so absorb it into me
              pe(e) = int(-me,8)
              w(e) = 0
#endif
            ENDIF
  160     CONTINUE
C         count the number of elements in i (including me):
          elen(i) = int(pn - p1 + 1)
C         ----------------------------------------------------------
C         scan the supervariables in the list associated with i
C         ----------------------------------------------------------
          p3 = pn
          DO 170 p = p2 + 1, p1 + int(len(i) - 1,8)
            j = iw(p)
            nvj = nv(j)
            IF (nvj .GT. 0) THEN
C             j is unabsorbed, and not in Lme.
C             add to degree and add to new list
              deg = deg + nvj
              iw(pn) = j
              pn = pn + 1
              hash = hash + int(j,kind=8)
            ENDIF
  170     CONTINUE
C         ----------------------------------------------------------
C         update the degree and check for mass elimination
C         ----------------------------------------------------------
#if  defined (NOAGG1)
          IF (deg.EQ.0.AND.(elen(i).GT.1)) THEN
C         When DEG is zero we need to 
C         absorb in ME all elements adjacent to I 
                   p1 = pe(i)
C                  exclude ME --> -2 
                   p2 = p1 + int(elen(i),8) - 2_8
                   DO p =p1,p2  
                     e      = iw(p)
                     pe(e) = int(-me,8)
                     w (e)  = 0
                   ENDDO
          ENDIF
C              .... Ready for mass elimination
#endif
          IF (deg .EQ. 0) THEN
C           -------------------------------------------------------
C           mass elimination
C           -------------------------------------------------------
C           There is nothing left of this node except for an
C           edge to the current pivot element.  elen (i) is 1,
C           and there are no variables adjacent to node i.
C           Absorb i into the current pivot element, me.
            pe(i) = int(-me,8)
            nvi = -nv(i)
            degme = degme - nvi
            nvpiv = nvpiv + nvi
            nel = nel + nvi
            nv(i) = 0
            elen(i) = 0
          ELSE
C           -------------------------------------------------------
C           update the upper-bound degree of i
C           -------------------------------------------------------
C           the following degree does not yet include the size
C           of the current element, which is added later:
            degree(i) = min (degree(i), deg)
C           -------------------------------------------------------
C           add me to the list for i
C           -------------------------------------------------------
C           move first supervariable to end of list
            iw(pn) = iw(p3)
C           move first element to end of element part of list
            iw(p3) = iw(p1)
C           add new element to front of list.
            iw(p1) = me
C           store the new length of the list in len (i)
            len(i) = int(pn - p1 + 1)
C           -------------------------------------------------------
C           place in hash bucket.  Save hash key of i in last (i).
C           -------------------------------------------------------
            hash = mod(hash, hmod) + 1_8
            j = head(hash)
            IF (j .LE. 0) THEN
C             the degree list is empty, hash head is -j
              next(i) = -j
              head(hash) = -i
            ELSE
C             degree list is not empty
C             use last (head (hash)) as hash head
              next(i) = last(j)
              last(j) = i
            ENDIF
            last(i) = int(hash,kind=kind(last))
          ENDIF
  180   CONTINUE
        degree(me) = degme
C       -------------------------------------------------------------
C       Clear the counter array, w (...), by incrementing wflg.
C       -------------------------------------------------------------
        dmax = max(dmax, degme)
        wflg = wflg + dmax
C       make sure that wflg+n does not cause integer overflow
        IF (wflg .GT. maxint_n) THEN
          DO 190 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  190     CONTINUE
          wflg = 2
        ENDIF
C       at this point, w (1..n) .lt. wflg holds
C=======================================================================
C  SUPERVARIABLE DETECTION
C=======================================================================
        DO 250 pme = pme1, pme2
          i = iw(pme)
          IF (nv(i) .LT. 0) THEN
C           i is a principal variable in Lme
C           -------------------------------------------------------
C           examine all hash buckets with 2 or more variables.  We
C           do this by examing all unique hash keys for super-
C           variables in the pattern Lme of the current element, me
C           -------------------------------------------------------
            hash = int(last(i),kind=8)
C           let i = head of hash bucket, and empty the hash bucket
            j = head(hash)
            IF (j .EQ. 0) GO TO 250
            IF (j .LT. 0) THEN
C             degree list is empty
              i = -j
              head(hash) = 0
            ELSE
C             degree list is not empty, restore last () of head
              i = last(j)
              last(j) = 0
            ENDIF
            IF (i .EQ. 0) GO TO 250
C           while loop:
  200       CONTINUE
            IF (next(i) .NE. 0) THEN
C             ----------------------------------------------------
C             this bucket has one or more variables following i.
C             scan all of them to see if i can absorb any entries
C             that follow i in hash bucket.  Scatter i into w.
C             ----------------------------------------------------
              ln = len(i)
              eln = elen(i)
C             do not flag the first element in the list (me)
              DO 210 p = pe(i) + 1, pe(i) + ln - 1
                w(iw(p)) = wflg
  210         CONTINUE
C             ----------------------------------------------------
C             scan every other entry j following i in bucket
C             ----------------------------------------------------
              jlast = i
              j = next(i)
C             while loop:
  220         CONTINUE
              IF (j .NE. 0) THEN
C               -------------------------------------------------
C               check if j and i have identical nonzero pattern
C               -------------------------------------------------
C               jump if i and j do not have same size data structure
                IF (len(j) .NE. ln) GO TO 240
C               jump if i and j do not have same number adj elts
                IF (elen(j) .NE. eln) GO TO 240
C               do not flag the first element in the list (me)
                DO 230 p = pe(j) + 1, pe(j) + ln - 1
C                 jump if an entry (iw(p)) is in j but not in i
                  IF (w(iw(p)) .NE. wflg) GO TO 240
  230           CONTINUE
C               -------------------------------------------------
C               found it!  j can be absorbed into i
C               -------------------------------------------------
                pe(j) = int(-i,8)
C               both nv (i) and nv (j) are negated since they
C               are in Lme, and the absolute values of each
C               are the number of variables in i and j:
                nv(i) = nv(i) + nv(j)
                nv(j) = 0
                elen(j) = 0
C               delete j from hash bucket
                j = next(j)
                next(jlast) = j
                GO TO 220
C               -------------------------------------------------
  240           CONTINUE
C               j cannot be absorbed into i
C               -------------------------------------------------
                jlast = j
                j = next(j)
              GO TO 220
              ENDIF
C             ----------------------------------------------------
C             no more variables can be absorbed into i
C             go to next i in bucket and clear flag array
C             ----------------------------------------------------
              wflg = wflg + 1
              i = next(i)
              IF (i .NE. 0) GO TO 200
            ENDIF
          ENDIF
  250   CONTINUE
C=======================================================================
C  RESTORE DEGREE LISTS AND REMOVE NONPRINCIPAL SUPERVAR. FROM ELEMENT
C=======================================================================
        p = pme1
        nleft = totel - nel
        DO 260 pme = pme1, pme2
          i = iw(pme)
          nvi = -nv(i)
          IF (nvi .GT. 0) THEN
C           i is a principal variable in Lme
C           restore nv (i) to signify that i is principal
            nv(i) = nvi
C           -------------------------------------------------------
C           compute the external degree (add size of current elem)
C           -------------------------------------------------------
            deg = min(degree(i) + degme - nvi, nleft - nvi)
C           -------------------------------------------------------
C           place the supervariable at the head of the degree list
C           -------------------------------------------------------
            inext = head(deg)
            IF (inext .NE. 0) last(inext) = i
            next(i) = inext
            last(i) = 0
            head(deg) = i
C           -------------------------------------------------------
C           save the new degree, and find the minimum degree
C           -------------------------------------------------------
            mindeg = min(mindeg, deg)
            degree(i) = deg
C           -------------------------------------------------------
C           place the supervariable in the element pattern
C           -------------------------------------------------------
            iw(p) = i
            p = p + 1
          ENDIF
  260   CONTINUE
C=======================================================================
C  FINALIZE THE NEW ELEMENT
C=======================================================================
        nv(me) = nvpiv + degme
C       nv (me) is now the degree of pivot (including diagonal part)
C       save the length of the list for the new element me
        len(me) = int(p - pme1)
        IF (len(me) .EQ. 0) THEN
C         there is nothing left of the current pivot element
          pe(me) = 0_8
          w(me) = 0
        ENDIF
        IF (newmem .NE. 0) THEN
C         element was not constructed in place: deallocate part
C         of it (final size is less than or equal to newmem,
C         since newly nonprincipal variables have been removed).
          pfree = p
          mem = mem - newmem + len(me)
        ENDIF
C=======================================================================
C       END WHILE (selecting pivots)
      GO TO 30
      ENDIF
C=======================================================================
C=======================================================================
C     COMPUTE THE PERMUTATION VECTORS and update TREE
C=======================================================================
C     ----------------------------------------------------------------
C     The time taken by the following code is O(n).  At this
C     point, elen (e) = -k has been done for all elements e,
C     and elen (i) = 0 has been done for all nonprincipal
C     variables i.  At this point, there are no principal
C     supervariables left, and all elements are absorbed.
C     ----------------------------------------------------------------
C     ----------------------------------------------------------------
C     compute the ordering of unordered nonprincipal variables
C     ----------------------------------------------------------------
      DO 290 i = 1, n
        IF (elen(i) .EQ. 0) THEN
C         ----------------------------------------------------------
C         i is an un-ordered row.  Traverse the tree from i until
C         reaching an element, e.  The element, e, was the
C         principal supervariable of i and all nodes in the path
C         from i to when e was selected as pivot.
C         ----------------------------------------------------------
          j = int(-pe(i))
C         while (j is a variable) do:
  270     CONTINUE
            IF (elen(j) .GE. 0) THEN
              j = int(-pe(j))
              GO TO 270
            ENDIF
            e = j
C           ----------------------------------------------------------
C           get the current pivot ordering of e
C           ----------------------------------------------------------
            k = -elen(e)
C           ----------------------------------------------------------
C           traverse the path again from i to e, and compress the
C           path (all nodes point to e).  Path compression allows
C           this code to compute in O(n) time.  Order the unordered
C           nodes in the path, and place the element e at the end.
C           ----------------------------------------------------------
            j = i
C           while (j is a variable) do:
  280       CONTINUE
            IF (elen(j) .GE. 0) THEN
              jnext = int(-pe(j))
              pe(j) = int(-e,8)
              IF (elen(j) .EQ. 0) THEN
C               j is an unordered row
                elen(j) = k
                k = k + 1
              ENDIF
              j = jnext
            GO TO 280
            ENDIF
C         leave elen (e) negative, so we know it is an element
          elen(e) = -k
        ENDIF
  290 CONTINUE
C
      IF (compute_perm) THEN
C     ----------------------------------------------------------------
C     reset the inverse permutation (elen (1..n)) to be positive,
C     and compute the permutation (last (1..n)).
C     ----------------------------------------------------------------
      IF(compress) THEN
        last(1:n) = 0
        head(1:totel-n)=0  
        DO i = 1, n
          k = abs(elen(i))
          IF ( k <= n ) THEN
            last(k) = i
          ELSE
            head(k-n)=i
          ENDIF
        ENDDO
        i = 1
        DO k = 1, n
          IF(last(k) .NE. 0) THEN
            last(i) = last(k)
            elen(last(k)) = i
            i = i + 1
          ENDIF
        ENDDO
        DO k = n+1, totel
          IF (head(k-n) .NE. 0) THEN
            last(i)=head(k-n)
            elen(head(k-n)) = i
            i = i + 1
          ENDIF
        END DO
      ELSE
        DO 300 i = 1, n
          k = abs(elen(i))
          last(k) = i
          elen(i) = k
  300   CONTINUE
       ENDIF
C=======================================================================
C      END OF COMPUTING PERMUTATIONS
C=======================================================================
       ENDIF
C=======================================================================
C  RETURN THE MEMORY USAGE IN IW
C=======================================================================
C     If maxmem is less than or equal to iwlen, then no compressions
C     occurred, and iw (maxmem+1 ... iwlen) was unused.  Otherwise
C     compressions did occur, and iwlen would have had to have been
C     greater than or equal to maxmem for no compressions to occur.
C     Return the value of maxmem in the pfree argument.
      pfree = maxmem
C===============================
C     Save IPE in PARENT array
      DO i=1,n
       parent(i) = int(pe(i))
      ENDDO
C===============================
      RETURN

mumps_cst_amf()

subroutine mumps_cst_amf	(	integer, intent(in)	n,
		integer, intent(in)	nbbuck,
		integer(8), intent(in)	iwlen,
		integer(8), dimension(n), intent(inout)	pe,
		integer(8), intent(inout)	pfree,
		integer, dimension(n), intent(inout)	len,
		integer, dimension(iwlen), intent(inout)	iw,
		integer, dimension(n), intent(inout)	nv,
		integer, dimension(n), intent(out)	elen,
		integer, dimension(n), intent(out)	last,
		integer, intent(out)	ncmpa,
		integer, dimension(n)	degree,
		integer, dimension(n)	wf,
		integer, dimension(n)	next,
		integer, dimension(n)	w,
		integer, dimension(0:nbbuck+1)	head,
		integer, dimension(n), intent(inout)	constraint,
		integer, dimension(n), intent(out)	theson,
		integer, dimension(n), intent(out)	parent )

Definition at line 6742 of file ana_orderings.F.

      IMPLICIT NONE
C
C Parameters
C    Input not modified
      INTEGER, INTENT(IN)    :: N, NBBUCK
      INTEGER(8), INTENT(IN) :: IWLEN
C     Input undefined on output 
      INTEGER, INTENT(INOUT)  :: LEN(N), IW(IWLEN)
C     NV meaningful as input to encode compressed graphs
      INTEGER, INTENT(INOUT)  :: NV(N)
C 
C     Output only 
      INTEGER, INTENT(OUT)   :: NCMPA
      INTEGER, INTENT(OUT)   :: ELEN(N), LAST(N), PARENT(N)
C 
C     Input/output
      INTEGER(8), INTENT(INOUT) :: PFREE
      INTEGER(8), INTENT(INOUT) :: PE(N)
C 
C     Internal Workspace only
C       Min fill approximation one extra array of size NBBUCK+2 
C       is also needed
      INTEGER     :: NEXT(N), DEGREE(N), W(N)
      INTEGER     :: HEAD(0:NBBUCK+1), WF(N)
C
C  Comments on the OUTPUT:
C  ----------------------
C  Let V= V0 U V1 the nodes of the initial graph (|V|=n). 
C  The assembly tree corresponds to the tree 
C    of the supernodes (or supervariables). Each node of the 
C    assembly tree is then composed of one principal variable 
C    and a list of secondary variables. The list of 
C    variable of a node (principal + secondary variables) then 
C    describes the structure of the diagonal bloc of the 
C    supernode. 
C  The elimination tree denotes the tree of all the variables(=node) and 
C    is therefore of order n.
C
C  The arrays NV(N) and PE(N) give a description of the 
C  assembly tree. 
C  
C   1/ Description of array nv(N) (on OUPUT)
C    nv(i)=0 i is a secondary variable 
C    N+1> nv(i) >0 i is a principal variable, nv(i) holds the 
C                  the number of elements in column i of L (true degree of i)
C
C   2/ Description of array PE(N) (on OUPUT)
C       pe(i) = -(father of variable/node i) in the elimination tree:
C       If nv (i) .gt. 0, then i represents a node in the assembly tree,
C       and the parent of i is -pe (i), or zero if i is a root.
C       If nv (i) = 0, then (i,-pe (i)) represents an edge in a
C       subtree, the root of which is a node in the assembly tree.
C   
C   3/ Example:
C      Let If be a root node father of Is in the assembly tree. 
C      If is the principal 
C      variable of the node If and let If1, If2, If3 be the secondary variables
C      of node If.
C      Is is the principal 
C      variable of the node Is and let Is1, Is2 be the secondary variables
C      of node Is.
C      
C      THEN: 
C        NV(If1)=NV(If2)=NV(If3) = 0  (secondary variables)
C        NV(Is1)=NV(Is2) = 0  (secondary variables)
C        NV(If) > 0  ( principal variable)
C        NV(Is) > 0  ( principal variable)
C        PE(If)  = 0 (root node)
C        PE(Is)  = -If (If is the father of Is in the assembly tree)
C        PE(If1)=PE(If2)=PE(If3)= -If  ( If is the principal variable)
C        PE(Is1)=PE(Is2)= -Is  ( Is is the principal variable)
C      
C
C
C HALOAMD_V1: (September 1997)
C **********
C Initial version designed to experiment the numerical (fill-in) impact 
C of taking into account the halo. This code should be able 
C to experiment no-halo, partial halo, complete halo.
C DATE: September 17th 1997
C
C HALOAMD is designed to process a gragh composed of two types
C            of nodes, V0 and V1, extracted from a larger gragh. 
C            V0^V1 = {}, 
C       
C            We used Min. degree heuristic to order only 
C            nodes in V0, but the adjacency to nodes
C            in V1 is taken into account during ordering.
C            Nodes in V1 are odered at last.
C            Adjacency between nodes of V1 need not be provided,
C            however |len(i)| must always corresponds to the number of 
C            edges effectively provided in the adjacency list of i.
C          On input :
c          ********
C            Nodes INODE in V1 are flagged with len(INODE) = -degree 
C            modif version HALO V3 (August 1998): 
C                                 if len(i) =0 and i \in V1 then 
C                                 len(i) must be set on input to -N-1
C          ERROR return (negative values in ncmpa)
C          ************
C            negative value in ncmpa indicates an error detected 
C               by HALOAMD.
C
C            The graph provided MUST follow the rule:
C             if (i,j) is an edge in the gragh then 
C             j must be in the adjacency list of i AND 
C             i must be in the adjacency list of j.
C    REMARKS
C    -------
C        
C        1/  Providing edges between nodes of V1 should not 
C            affect the final ordering, only the amount of edges 
C            of the halo should effectively affect the solution.
C            This code should work in the following cases:
C              1/ halo not provided
C              2/ halo partially provided
C              3/ complete halo
C              4/ complete halo+interconnection between nodes of V1.
C
C              1/ should run and provide identical results (w.r.t to current 
C               implementation of AMD in SCOTCH).
C             3/ and 4 should provide identical results.
C
C        2/ All modifications of the AMD initial code are indicated
C           with begin HALO .. end HALO
C
C            
C   Ordering of nodes in V0 is based on  approximate minimum
C       fill-in heuristic.
C   
C-----------------------------------------------------------------------
C begin CONSTRAINT
C CONSTRAINT(I) >= 0 : I can be selected
C                < 0 : I cannot be selected
C                > 0 : I release CONSTRAINT(I) 
C THESON(I) = 0 : I is a leaf in the supervariable representation
C THESON(I) > I : THESON(I) belongs to the same supervariable as I
C  Parameters:
      INTEGER, INTENT(INOUT) :: CONSTRAINT(N)
      INTEGER, INTENT(out) :: THESON(N)
      INTEGER PREV,TOTO
C end CONSTRAINT
C-----------------------------------------------------------------------
C INPUT ARGUMENTS (unaltered):
C-----------------------------------------------------------------------
C n:    The matrix order.
C
C       Restriction:  n .ge. 1
C iwlen:        The length of iw (1..iwlen).  On input, the matrix is
C       stored in iw (1..pfree-1).  However, iw (1..iwlen) should be
C       slightly larger than what is required to hold the matrix, at
C       least iwlen .ge. pfree + n is recommended.  Otherwise,
C       excessive compressions will take place.
C       *** We do not recommend running this algorithm with ***
C       ***      iwlen .lt. pfree + n.                      ***
C       *** Better performance will be obtained if          ***
C       ***      iwlen .ge. pfree + n                       ***
C       *** or better yet                                   ***
C       ***      iwlen .gt. 1.2 * pfree                     ***
C       *** (where pfree is its value on input).            ***
C       The algorithm will not run at all if iwlen .lt. pfree-1.
C
C       Restriction: iwlen .ge. pfree-1
C-----------------------------------------------------------------------
C INPUT/OUPUT ARGUMENTS:
C-----------------------------------------------------------------------
C pe:   On input, pe (i) is the index in iw of the start of row i, or
C       zero if row i has no off-diagonal non-zeros.
C
C       During execution, it is used for both supervariables and
C       elements:
C
C       * Principal supervariable i:  index into iw of the
C               description of supervariable i.  A supervariable
C               represents one or more rows of the matrix
C               with identical nonzero pattern.
C       * Non-principal supervariable i:  if i has been absorbed
C               into another supervariable j, then pe (i) = -j.
C               That is, j has the same pattern as i.
C               Note that j might later be absorbed into another
C               supervariable j2, in which case pe (i) is still -j,
C               and pe (j) = -j2.
C       * Unabsorbed element e:  the index into iw of the description
C               of element e, if e has not yet been absorbed by a
C               subsequent element.  Element e is created when
C               the supervariable of the same name is selected as
C               the pivot.
C       * Absorbed element e:  if element e is absorbed into element
C               e2, then pe (e) = -e2.  This occurs when the pattern of
C               e (that is, Le) is found to be a subset of the pattern
C               of e2 (that is, Le2).  If element e is "null" (it has
C               no nonzeros outside its pivot block), then pe (e) = 0.
C
C       On output, pe holds the assembly tree/forest, which implicitly
C       represents a pivot order with identical fill-in as the actual
C       order (via a depth-first search of the tree).
C
C       On output:
C       If nv (i) .gt. 0, then i represents a node in the assembly tree,
C       and the parent of i is -pe (i), or zero if i is a root.
C       If nv (i) = 0, then (i,-pe (i)) represents an edge in a
C       subtree, the root of which is a node in the assembly tree.
C       On output:  (PE is copied on output into PARENT array)
C
C pfree:        On input, the matrix is stored in iw (1..pfree-1) and
C       the rest of the array iw is free.
C       During execution, additional data is placed in iw, and pfree
C       is modified so that components  of iw from pfree are free.
C       On output, pfree is set equal to the size of iw that
C       would have been needed for no compressions to occur.  If
C       ncmpa is zero, then pfree (on output) is less than or equal to
C       iwlen, and the space iw (pfree+1 ... iwlen) was not used.
C       Otherwise, pfree (on output) is greater than iwlen, and all the
C       memory in iw was used.
C
C nv: On input, encoding of compressed graph:
C        if NV(1) = -1 then graph is not compressed otherwise
C        NV(I) holds the weight of node I. 
C       During execution, abs (nv (i)) is equal to the number of rows
C       that are represented by the principal supervariable i.  If i is
C       a nonprincipal variable, then nv (i) = 0.  Initially,
C       nv (i) = 1 for all i.  nv (i) .lt. 0 signifies that i is a
C       principal variable in the pattern Lme of the current pivot
C       element me.  On output, nv (e) holds the true degree of element
C       e at the time it was created (including the diagonal part).
C begin HALO
C       On output, nv(I) can be used to find node in set V1.
C       Not true anymore : ( nv(I) = N+1 characterizes nodes in V1. 
C                 instead nodes in V1 are considered as a dense root node )
C end HALO
C-----------------------------------------------------------------------
C INPUT/MODIFIED (undefined on output):
C-----------------------------------------------------------------------
C len:  On input, len (i) 
C           positive or null (>=0) : i \in V0 and 
C                     len(i) holds the number of entries in row i of the
C                     matrix, excluding the diagonal.  
C           negative (<0) : i \in V1, and 
C                     -len(i) hold the number of entries in row i of the
C                     matrix, excluding the diagonal.
C                     len(i) = - | Adj(i) | if i \in V1                    
C                              or -N -1 if  | Adj(i) | = 0 and i \in V1 
C       The contents of len (1..n)
C       are undefined on output.
C iw:   On input, iw (1..pfree-1) holds the description of each row i
C       in the matrix.  The matrix must be symmetric, and both upper
C       and lower triangular parts must be present.  The diagonal must
C       not be present.  Row i is held as follows:
C
C               len (i):  the length of the row i data structure
C               iw (pe (i) ... pe (i) + len (i) - 1):
C                       the list of column indices for nonzeros
C                       in row i (simple supervariables), excluding
C                       the diagonal.  All supervariables start with
C                       one row/column each (supervariable i is just
C                       row i).
C               if len (i) is zero on input, then pe (i) is ignored
C               on input.
C
C               Note that the rows need not be in any particular order,
C               and there may be empty space between the rows.
C
C       During execution, the supervariable i experiences fill-in.
C       This is represented by placing in i a list of the elements
C       that cause fill-in in supervariable i:
C
C               len (i):  the length of supervariable i
C               iw (pe (i) ... pe (i) + elen (i) - 1):
C                       the list of elements that contain i.  This list
C                       is kept short by removing absorbed elements.
C               iw (pe (i) + elen (i) ... pe (i) + len (i) - 1):
C                       the list of supervariables in i.  This list
C                       is kept short by removing nonprincipal
C                       variables, and any entry j that is also
C                       contained in at least one of the elements
C                       (j in Le) in the list for i (e in row i).
C
C       When supervariable i is selected as pivot, we create an
C       element e of the same name (e=i):
C
C               len (e):  the length of element e
C               iw (pe (e) ... pe (e) + len (e) - 1):
C                       the list of supervariables in element e.
C
C       An element represents the fill-in that occurs when supervariable
C       i is selected as pivot (which represents the selection of row i
C       and all non-principal variables whose principal variable is i).
C       We use the term Le to denote the set of all supervariables
C       in element e.  Absorbed supervariables and elements are pruned
C       from these lists when computationally convenient.
C
C       CAUTION:  THE INPUT MATRIX IS OVERWRITTEN DURING COMPUTATION.
C       The contents of iw are undefined on output.
C-----------------------------------------------------------------------
C OUTPUT (need not be set on input):
C-----------------------------------------------------------------------
C elen: See the description of iw above.  At the start of execution,
C       elen (i) is set to zero.  During execution, elen (i) is the
C       number of elements in the list for supervariable i.  When e
C       becomes an element, elen (e) = -nel is set, where nel is the
C       current step of factorization.  elen (i) = 0 is done when i
C       becomes nonprincipal.
C
C       For variables, elen (i) .ge. 0 holds until just before the
C       permutation vectors are computed.  For elements,
C       elen (e) .lt. 0 holds.
C
C       On output elen (1..n) holds the inverse permutation (the same
C       as the 'INVP' argument in Sparspak).  That is, if k = elen (i),
C       then row i is the kth pivot row.  Row i of A appears as the
C       (elen(i))-th row in the permuted matrix, PAP^T.
C last: In a degree list, last (i) is the supervariable preceding i,
C       or zero if i is the head of the list.  In a hash bucket,
C       last (i) is the hash key for i.  last (head (hash)) is also
C       used as the head of a hash bucket if head (hash) contains a
C       degree list (see head, below).
C
C       On output, last (1..n) holds the permutation (the same as the
C       'PERM' argument in Sparspak).  That is, if i = last (k), then
C       row i is the kth pivot row.  Row last (k) of A is the k-th row
C       in the permuted matrix, PAP^T.
C ncmpa:        The number of times iw was compressed.  If this is
C       excessive, then the execution took longer than what could have
C       been.  To reduce ncmpa, try increasing iwlen to be 10% or 20%
C       larger than the value of pfree on input (or at least
C       iwlen .ge. pfree + n).  The fastest performance will be
C       obtained when ncmpa is returned as zero.  If iwlen is set to
C       the value returned by pfree on *output*, then no compressions
C       will occur.
C begin HALO
C        on output ncmpa <0 --> error detected during HALO_AMD:
C           error 1: ncmpa = -N , ordering was stopped.
C end HALO
C
C-----------------------------------------------------------------------
C LOCAL (not input or output - used only during execution):
C-----------------------------------------------------------------------
C degree:       If i is a supervariable, then degree (i) holds the
C       current approximation of the external degree of row i (an upper
C       bound).  The external degree is the number of nonzeros in row i,
C       minus abs (nv (i)) (the diagonal part).  The bound is equal to
C       the external degree if elen (i) is less than or equal to two.
C       We also use the term "external degree" for elements e to refer
C       to |Le \ Lme|.  If e is an element, then degree (e) holds |Le|,
C       which is the degree of the off-diagonal part of the element e
C       (not including the diagonal part).
C begin HALO
C       degree(I) = n+1 indicates that i belongs to V1
C end HALO
C
C head: head is used for degree lists.  head (deg) is the first
C       supervariable in a degree list (all supervariables i in a
C       degree list deg have the same approximate degree, namely,
C       deg = degree (i)).  If the list deg is empty then
C       head (deg) = 0.
C
C       During supervariable detection head (hash) also serves as a
C       pointer to a hash bucket.
C       If head (hash) .gt. 0, there is a degree list of degree hash.
C               The hash bucket head pointer is last (head (hash)).
C       If head (hash) = 0, then the degree list and hash bucket are
C               both empty.
C       If head (hash) .lt. 0, then the degree list is empty, and
C               -head (hash) is the head of the hash bucket.
C       After supervariable detection is complete, all hash buckets
C       are empty, and the (last (head (hash)) = 0) condition is
C       restored for the non-empty degree lists.
C next: next (i) is the supervariable following i in a link list, or
C       zero if i is the last in the list.  Used for two kinds of
C       lists:  degree lists and hash buckets (a supervariable can be
C       in only one kind of list at a time).
C w:    The flag array w determines the status of elements and
C       variables, and the external degree of elements.
C
C       for elements:
C          if w (e) = 0, then the element e is absorbed
C          if w (e) .ge. wflg, then w (e) - wflg is the size of
C               the set |Le \ Lme|, in terms of nonzeros (the
C               sum of abs (nv (i)) for each principal variable i that
C               is both in the pattern of element e and NOT in the
C               pattern of the current pivot element, me).
C          if wflg .gt. w (e) .gt. 0, then e is not absorbed and has
C               not yet been seen in the scan of the element lists in
C               the computation of |Le\Lme| in loop 150 below.
C
C       for variables:
C          during supervariable detection, if w (j) .ne. wflg then j is
C          not in the pattern of variable i
C
C       The w array is initialized by setting w (i) = 1 for all i,
C       and by setting wflg = 2.  It is reinitialized if wflg becomes
C       too large (to ensure that wflg+n does not cause integer
C       overflow).
C
C wf : integer array  used to store the already filled area of 
C      the variables adajcent to current pivot. 
C      wf is then used to update the score of variable i.
C
C-----------------------------------------------------------------------
C LOCAL INTEGERS:
C-----------------------------------------------------------------------
      INTEGER :: DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I,
     &        ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3,
     &        LENJ, LN, ME, MINDEG, NEL, 
     &        NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X,
     &        NBFLAG, NREAL, LASTD, NELME, WF3, WF4, N2, PAS
       INTEGER KNT1_UPDATED, KNT2_UPDATED
       INTEGER(8) :: MAXMEM, MEM, NEWMEM
       INTEGER   :: MAXINT_N
       INTEGER(8)::  HASH, HMOD
       DOUBLE PRECISION ::   RMF, RMF1 
       DOUBLE PRECISION ::   dummy
       INTEGER :: idummy
C deg:        the degree of a variable or element
C degme:      size, |Lme|, of the current element, me (= degree (me))
C dext:       external degree, |Le \ Lme|, of some element e
C dmax:       largest |Le| seen so far
C e:          an element
C elenme:     the length, elen (me), of element list of pivotal var.
C eln:        the length, elen (...), of an element list
C hash:       the computed value of the hash function
C hmod:       the hash function is computed modulo hmod = max (1,n-1)
C i:          a supervariable
C ilast:      the entry in a link list preceding i
C inext:      the entry in a link list following i
C j:          a supervariable
C jlast:      the entry in a link list preceding j
C jnext:      the entry in a link list, or path, following j
C k:          the pivot order of an element or variable
C knt1:       loop counter used during element construction
C knt2:       loop counter used during element construction
C knt3:       loop counter used during compression
C lenj:       len (j)
C ln:         length of a supervariable list
C maxint_n:   large integer to test risk of overflow on wflg
C maxmem:     amount of memory needed for no compressions
C me:         current supervariable being eliminated, and the
C                     current element created by eliminating that
C                     supervariable
C mem:        memory in use assuming no compressions have occurred
C mindeg:     current minimum degree
C nel:        number of pivots selected so far
C newmem:     amount of new memory needed for current pivot element
C nleft:      n - nel, the number of nonpivotal rows/columns remaining
C nvi:        the number of variables in a supervariable i (= nv (i))
C nvj:        the number of variables in a supervariable j (= nv (j))
C nvpiv:      number of pivots in current element
C slenme:     number of variables in variable list of pivotal variable
C we:         w (e)
C wflg:       used for flagging the w array.  See description of iw.
C wnvi:       wflg - nv (i)
C x:          either a supervariable or an element
C wf3:  off diagonal block area
C wf4:  diagonal block area
C mf : Minimum fill
C begin HALO
C nbflag:     number of flagged entries in the initial gragh.
C nreal :     number of entries on which ordering must be perfomed
C             (nreel = N- nbflag)
C nelme number of pivots selected when reaching the root
C lastd index of the last row in the list of dense rows
C end HALO
C-----------------------------------------------------------------------
C LOCAL POINTERS:
C-----------------------------------------------------------------------
      INTEGER(8) P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, 
     &           PN, PSRC
C             Any parameter (pe (...) or pfree) or local variable
C             starting with "p" (for Pointer) is an index into iw,
C             and all indices into iw use variables starting with
C             "p."  The only exception to this rule is the iwlen
C             input argument.
C p:          pointer into lots of things
C p1:         pe (i) for some variable i (start of element list)
C p2:         pe (i) + elen (i) -  1 for some var. i (end of el. list)
C p3:         index of first supervariable in clean list
C pdst:       destination pointer, for compression
C pend:       end of memory to compress
C pj:         pointer into an element or variable
C pme:        pointer into the current element (pme1...pme2)
C pme1:       the current element, me, is stored in iw (pme1...pme2)
C pme2:       the end of the current element
C pn:         pointer into a "clean" variable, also used to compress
C psrc:       source pointer, for compression
C-----------------------------------------------------------------------
C  FUNCTIONS CALLED:
C-----------------------------------------------------------------------
      INTRINSIC max, min, mod, huge
      INTEGER TOTEL
C=======================================================================
C  INITIALIZATIONS
C=======================================================================
C     HEAD (0:NBBUCK+1)
C begin HALO
C
C idummy holds the largest integer - 1
C dummy  = dble (idummy)
      idummy = huge(idummy) - 1
      dummy = dble(idummy)
C     variable with degree equal to N2 are in halo
C     bucket NBBUCK+1 used for HALO variables
      n2 = -nbbuck-1
C end HALO
C Distance betweeen elements of the N, ..., NBBUCK entries of HEAD
C
C update done on 20 Feb 2002 (PAS>= 1)
      pas = max((n/8), 1)
      wflg = 2
      maxint_n=huge(wflg)-n
      ncmpa = 0
      nel = 0
      hmod = int(max(1, nbbuck-1),kind=8)
      dmax = 0
      mem = pfree - 1
      maxmem = mem
      mindeg = 0
C
      nbflag = 0
      lastd  = 0
      head(0:nbbuck+1) = 0
      DO 10 i = 1, n
         theson(i) = 0
         last(i) = 0
C        NV (I) = 1
         w(i) = 1
         elen(i) = 0
   10 CONTINUE
      totel = 0
      DO i=1,n
         IF (len(i).LT.0) THEN 
            degree(i) = n2
            nbflag     = nbflag +1
            IF (len(i).EQ.-n-1) THEN
C     variable in V1 with empty adj list 
               len(i)    = 0
C     Because of compress, we force skipping this
C     entry which is anyway empty
               pe(i)     = 0_8
            ELSE
               len(i)    = - len(i)
            ENDIF
C       end HALO V3
         ELSE
            totel = totel + nv(i)
            degree(i) = 0
            DO p= pe(i) , pe(i)+int(len(i)-1,8)
               degree(i) = degree(i) + nv(iw(p))
            ENDDO
         ENDIF
      ENDDO
C
C
C     number of entries to be ordered.
      nreal = n - nbflag
C     ----------------------------------------------------------------
C     initialize degree lists and eliminate rows with no off-diag. nz.
C     ----------------------------------------------------------------
      DO 20 i = 1, n
        deg = degree(i)
        IF (deg.EQ.n2) THEN
C            DEG = N2 (flagged variables are stored 
C                  in the degree list of NBBUCK + 1
C                  (safe: because max 
C                         max value of degree is NBBUCK)
C
             deg = nbbuck + 1
             IF (lastd.EQ.0) THEN
C              degree list is empty
               lastd     = i
               head(deg) = i
               next(i)   = 0
               last(i)   = 0
             ELSE
               next(lastd) = i
               last(i)     = lastd
               lastd       = i
               next(i)     = 0
             ENDIF
         GOTO 20
        ENDIF
C
C
        IF (deg .GT. 0) THEN
           wf(i) = deg
           IF (deg.GT.n) THEN
            deg = min(((deg-n)/pas) + n , nbbuck)
           ENDIF
C           Note that if deg=0 then 
C           No fill-in will occur, 
C           but one variable is adjacent to I
C          ----------------------------------------------------------
C          place i in the degree list corresponding to its degree
C          ----------------------------------------------------------
           inext = head(deg)
           IF (inext .NE. 0) last(inext) = i
           next(i) = inext
           head(deg) = i
        ELSE
C         ----------------------------------------------------------
C         we have a variable that can be eliminated at once because
C         there is no off-diagonal non-zero in its row.
C         ----------------------------------------------------------
           nel = nel + nv(i)
           elen(i) = -nel
           pe(i) = 0_8
           w(i) = 0
        ENDIF
C=======================================================================
C
   20 CONTINUE
C=======================================================================
C  WHILE (selecting pivots) DO
C=======================================================================
      nleft = totel-nel
C=======================================================================
C =====================================================================
 30   IF (nel .LT. totel) THEN
C =====================================================================
C  GET PIVOT OF MINIMUM DEGREE
C=======================================================================
C       -------------------------------------------------------------
C       find next supervariable for elimination
C       -------------------------------------------------------------
         DO 40 deg = mindeg, nbbuck
            me = head(deg)
            IF (me .GT. 0) GO TO 50
 40      CONTINUE
 50      mindeg = deg
         IF (me.LE.0) THEN
            ncmpa = -n
            CALL mumps_abort()
         ENDIF
         IF (deg.GT.n) THEN
C        -------------------------------
C        Linear search to find variable 
C        with best score in the list
C        -------------------------------
C        While end of list list not reached
C         NEXT(J) = 0
            j = next(me)
            k = wf(me)
C     if ME is not available
            IF(constraint(me) .LT. 0) THEN
               k = -1
            ENDIF
 55         CONTINUE
            IF (j.GT.0) THEN
C     j is  available
               IF(constraint(j) .GE. 0) THEN
                  IF (wf(j).LT.k .OR. k .LT. 0) THEN
                     me = j
                     k  = wf(me)
                  ENDIF
               ENDIF
               j= next(j)
               GOTO 55
            ENDIF
            ilast = last(me)
            inext = next(me)
            IF (inext .NE. 0) last(inext) = ilast
            IF (ilast .NE. 0) THEN
               next(ilast) = inext
            ELSE
C          me is at the head of the degree list
               head(deg) = inext
            ENDIF
C     
         ELSE
C     select ME which verify the constraint           
C     if it is directly ok
            IF(constraint(me) .GE. 0) GOTO 59
 56         CONTINUE
C     if ME has a successor exaine it
            IF(next(me) .NE. 0) THEN
               me = next(me)
               IF(constraint(me) .GE. 0) THEN
                  GOTO 59
               ELSE
                  GOTO 56
               ENDIF
            ELSE
C     ME has no successor -> increase deg till finding a valid ME
C     57: increase deg till a non empty list is found
 57            deg = deg+1
               me = head(deg) 
C     no empty found 
               IF(me .GT. 0) THEN
C     good piv found
                  IF(constraint(me) .GE. 0) THEN
                     GOTO 59
                  ELSE
C     else loop on next
                     GOTO 56
                  ENDIF
               ELSE
C     increase degree
                  GOTO 57
               ENDIF
            ENDIF   
 59         prev = last(me)
            inext = next(me)
            IF(prev .NE. 0) THEN
               next(prev) = inext
            ELSE
               head(deg) = inext
            ENDIF
C     remove ME from the x2 linked lists
            IF (inext .NE. 0) last(inext) = prev
         ENDIF
C         -------------------------------------------------------------
C         remove chosen variable from link list
C         -------------------------------------------------------------
         toto = me
 5910    IF(toto .NE. 0) THEN
            j = constraint(toto)
            IF(j .GT. 0) THEN
               constraint(j) = 0
            ENDIF
            toto = theson(toto)
            GOTO 5910
         ENDIF
C       -------------------------------------------------------------
C       me represents the elimination of pivots nel+1 to nel+nv(me).
C       place me itself as the first in this set.  It will be moved
C       to the nel+nv(me) position when the permutation vectors are
C       computed.
C       -------------------------------------------------------------
            elenme = elen(me)
            elen(me) = - (nel + 1)
            nvpiv = nv(me)
            nel = nel + nvpiv
C=======================================================================
C  CONSTRUCT NEW ELEMENT
C=======================================================================
C       -------------------------------------------------------------
C       At this point, me is the pivotal supervariable.  It will be
C       converted into the current element.  Scan list of the
C       pivotal supervariable, me, setting tree pointers and
C       constructing new list of supervariables for the new element,
C       me.  p is a pointer to the current position in the old list.
C       -------------------------------------------------------------
C       flag the variable "me" as being in Lme by negating nv (me)
            nv(me) = -nvpiv
            degme = 0
            IF (elenme .EQ. 0) THEN
C         ----------------------------------------------------------
C         construct the new element in place
C         ----------------------------------------------------------
               pme1 = pe(me)
               pme2 = pme1 - 1
               DO 60 p = pme1, pme1 + len(me) - 1
                  i = iw(p)
                  nvi = nv(i)
                  IF (nvi .GT. 0) THEN
C             ----------------------------------------------------
C             i is a principal variable not yet placed in Lme.
C             store i in new list
C             ----------------------------------------------------
                     degme = degme + nvi
C             flag i as being in Lme by negating nv (i)
                     nv(i) = -nvi
                     pme2 = pme2 + 1
                     iw(pme2) = i
                     IF (degree(i).NE.n2) THEN
C             ----------------------------------------------------
C             remove variable i from degree list. (only if i \in V0)
C             ----------------------------------------------------
                        ilast = last(i)
                        inext = next(i)
                        IF (inext .NE. 0) last(inext) = ilast
                        IF (ilast .NE. 0) THEN
                           next(ilast) = inext
                        ELSE
C               i is at the head of the degree list
                           IF (wf(i).GT.n) THEN
                              deg = min(((wf(i)-n)/pas) + n , nbbuck)
                           ELSE
                              deg = wf(i)
                           ENDIF
                           head(deg) = inext
                        ENDIF
                     ENDIF
                  ENDIF
 60            CONTINUE
C         this element takes no new memory in iw:
               newmem = 0
            ELSE
C         ----------------------------------------------------------
C         construct the new element in empty space, iw (pfree ...)
C         ----------------------------------------------------------
          p = pe(me)
          pme1 = pfree
          slenme = len(me) - elenme
          knt1_updated = 0
          DO 120 knt1 = 1, elenme + 1
            knt1_updated = knt1_updated +1
            IF (knt1 .GT. elenme) THEN
C             search the supervariables in me.
              e = me
              pj = p
              ln = slenme
            ELSE
C             search the elements in me.
              e = iw(p)
              p = p + 1
              pj = pe(e)
              ln = len(e)
            ENDIF
C           -------------------------------------------------------
C           search for different supervariables and add them to the
C           new list, compressing when necessary. this loop is
C           executed once for each element in the list and once for
C           all the supervariables in the list.
C           -------------------------------------------------------
            knt2_updated = 0
            DO 110 knt2 = 1, ln
              knt2_updated = knt2_updated+1
              i = iw(pj)
              pj = pj + 1
              nvi = nv(i)
              IF (nvi .GT. 0) THEN
C               -------------------------------------------------
C               compress iw, if necessary
C               -------------------------------------------------
                IF (pfree .GT. iwlen) THEN
C                 prepare for compressing iw by adjusting
C                 pointers and lengths so that the lists being
C                 searched in the inner and outer loops contain
C                 only the remaining entries.
                  pe(me) = p
                  len(me) = len(me) - knt1_updated
C                 Reset KNT1_UPDATED in case of recompress 
C                 at same iteration of the loop 120
                  knt1_updated = 0
C                 Check if anything left in supervariable ME
                  IF (len(me) .EQ. 0) pe(me) = 0_8
                  pe(e) = pj
                  len(e) = ln - knt2_updated
C                 Reset KNT2_UPDATED in case of recompress 
C                 at same iteration of the loop 110
                  knt2_updated = 0
C                 Check if anything left in element E
                  IF (len(e) .EQ. 0) pe(e) = 0_8
                  ncmpa = ncmpa + 1
C                 store first item in pe
C                 set first entry to -item
                  DO 70 j = 1, n
                    pn = pe(j)
                    IF (pn .GT. 0) THEN
                      pe(j) = int(iw(pn),8)
                      iw(pn) = -j
                    ENDIF
   70             CONTINUE
C                 psrc/pdst point to source/destination
                  pdst = 1
                  psrc = 1
                  pend = pme1 - 1
C                 while loop:
   80             CONTINUE
                  IF (psrc .LE. pend) THEN
C                   search for next negative entry
                    j = -iw(psrc)
                    psrc = psrc + 1
                    IF (j .GT. 0) THEN
                      iw(pdst) = int(pe(j))
                      pe(j) = pdst
                      pdst = pdst + 1_8
C                     copy from source to destination
                      lenj = len(j)
                      DO 90 knt3 = 0, lenj - 2
                        iw(pdst + knt3) = iw(psrc + knt3)
   90                 CONTINUE
                      pdst = pdst + int(lenj - 1,8)
                      psrc = psrc + int(lenj - 1,8)
                    ENDIF
                    GO TO 80
                  ENDIF
C                 move the new partially-constructed element
                  p1 = pdst
                  DO 100 psrc = pme1, pfree - 1
                    iw(pdst) = iw(psrc)
                    pdst = pdst + 1
  100             CONTINUE
                  pme1 = p1
                  pfree = pdst
                  pj = pe(e)
                  p = pe(me)
                ENDIF
C               -------------------------------------------------
C               i is a principal variable not yet placed in Lme
C               store i in new list
C               -------------------------------------------------
                degme = degme + nvi
C               flag i as being in Lme by negating nv (i)
                nv(i) = -nvi
                iw(pfree) = i
                pfree = pfree + 1
              IF (degree(i).NE.n2) THEN
C               -------------------------------------------------
C               remove variable i from degree link list 
C                            (only if i in V0)
C               -------------------------------------------------
                ilast = last(i)
                inext = next(i)
                IF (inext .NE. 0) last(inext) = ilast
                IF (ilast .NE. 0) THEN
                  next(ilast) = inext
                ELSE
                  IF (wf(i).GT.n) THEN
                   deg = min(((wf(i)-n)/pas) + n , nbbuck)
                  ELSE
                   deg = wf(i)
                  ENDIF
C                 i is at the head of the degree list
                  head(deg) = inext
                ENDIF
              ENDIF
              ENDIF
  110       CONTINUE
            IF (e .NE. me) THEN
C             set tree pointer and flag to indicate element e is
C             absorbed into new element me (the parent of e is me)
              pe(e) = int(-me,8)
              w(e) = 0
            ENDIF
  120     CONTINUE
          pme2 = pfree - 1
C         this element takes newmem new memory in iw (possibly zero)
          newmem = pfree - pme1
          mem = mem + newmem
          maxmem = max(maxmem, mem)
        ENDIF
C       -------------------------------------------------------------
C       me has now been converted into an element in iw (pme1..pme2)
C       -------------------------------------------------------------
C       degme holds the external degree of new element
        degree(me) = degme
        pe(me) = pme1
        len(me) = int(pme2 - pme1 + 1_8)
C       -------------------------------------------------------------
C       make sure that wflg is not too large.  With the current
C       value of wflg, wflg+n must not cause integer overflow
C       -------------------------------------------------------------
        IF (wflg .GT. maxint_n) THEN
          DO 130 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  130     CONTINUE
          wflg = 2
        ENDIF
C=======================================================================
C  COMPUTE (w (e) - wflg) = |Le\Lme| FOR ALL ELEMENTS
C=======================================================================
C       -------------------------------------------------------------
C       Scan 1:  compute the external degrees of previous elements
C       with respect to the current element.  That is:
C            (w (e) - wflg) = |Le \ Lme|
C       for each element e that appears in any supervariable in Lme.
C       The notation Le refers to the pattern (list of
C       supervariables) of a previous element e, where e is not yet
C       absorbed, stored in iw (pe (e) + 1 ... pe (e) + iw (pe (e))).
C       The notation Lme refers to the pattern of the current element
C       (stored in iw (pme1..pme2)).   If (w (e) - wflg) becomes
C       zero, then the element e will be absorbed in scan 2.
C       -------------------------------------------------------------
        DO 150 pme = pme1, pme2
          i = iw(pme)
          eln = elen(i)
          IF (eln .GT. 0) THEN
C           note that nv (i) has been negated to denote i in Lme:
            nvi = -nv(i)
            wnvi = wflg - nvi
            DO 140 p = pe(i), pe(i) + int(eln - 1,8)
              e = iw(p)
              we = w(e)
              IF (we .GE. wflg) THEN
C               unabsorbed element e has been seen in this loop
                we = we - nvi
              ELSE IF (we .NE. 0) THEN
C               e is an unabsorbed element
C               this is the first we have seen e in all of Scan 1
                we = degree(e) + wnvi
                wf(e) = 0
              ENDIF
              w(e) = we
  140       CONTINUE
          ENDIF
  150   CONTINUE
C=======================================================================
C  DEGREE UPDATE AND ELEMENT ABSORPTION
C=======================================================================
C       -------------------------------------------------------------
C       Scan 2:  for each i in Lme, sum up the degree of Lme (which
C       is degme), plus the sum of the external degrees of each Le
C       for the elements e appearing within i, plus the
C       supervariables in i.  Place i in hash list.
C       -------------------------------------------------------------
        DO 180 pme = pme1, pme2
          i = iw(pme)
          p1 = pe(i)
          p2 = p1 + int(elen(i) - 1,8)
          pn = p1
          hash = 0_8
          deg  = 0
          wf3  = 0
          wf4  = 0
          nvi  = -nv(i)
C         ----------------------------------------------------------
C         scan the element list associated with supervariable i
C         ----------------------------------------------------------
          DO 160 p = p1, p2
            e = iw(p)
C           dext = | Le \ Lme |
            dext = w(e) - wflg
            IF (dext .GT. 0) THEN
              IF ( wf(e) .EQ. 0 ) THEN
C              First time we meet e : compute wf(e) 
C              which holds the surface associated to element e 
C              it will later be deducted from fill-in 
C              area of all variables adjacent to e
               wf(e) = dext * ( (2 * degree(e))  -  dext - 1)
              ENDIF
              wf4 = wf4 + wf(e)
              deg = deg + dext
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e,kind=8)
            ELSE IF (dext .EQ. 0) THEN
#if defined (NOAGG4)
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e,kind=8)
#else
C             aggressive absorption: e is not adjacent to me, but
C             the |Le \ Lme| is 0, so absorb it into me
              pe(e) = int(-me,8)
              w(e) = 0
#endif
            ENDIF
  160     CONTINUE
C         count the number of elements in i (including me):
          elen(i) = int(pn - p1 + 1_8)
C         ----------------------------------------------------------
C         scan the supervariables in the list associated with i
C         ----------------------------------------------------------
          p3 = pn
          DO 170 p = p2 + 1, p1 + int(len(i) - 1,8)
            j = iw(p)
            nvj = nv(j)
            IF (nvj .GT. 0) THEN
C             j is unabsorbed, and not in Lme.
C             add to degree and add to new list
              deg = deg + nvj
              wf3 = wf3 + nvj
              iw(pn) = j
              pn = pn + 1
              hash = hash + int(j,kind=8)
            ENDIF
  170     CONTINUE
C
          IF (degree(i).EQ.n2) deg = n2
C         ----------------------------------------------------------
C         update the degree and check for mass elimination
C         ----------------------------------------------------------
#if defined (NOAGG4)
          IF (elen(i).EQ.1 .AND. p3.EQ.pn) THEN
#else
          IF (deg .EQ. 0) THEN
#endif
C           -------------------------------------------------------
C           mass elimination
C           -------------------------------------------------------
C           There is nothing left of this node except for an
C           edge to the current pivot element.  elen (i) is 1,
C           and there are no variables adjacent to node i.
C           Absorb i into the current pivot element, me.
             toto = i
 5911        IF(toto .NE. 0) THEN
                j = constraint(toto)
                IF(j .GT. 0) THEN
                   constraint(j) = 0
                ENDIF
                toto = theson(toto)
                GOTO 5911
             ENDIF
            pe(i) = int(-me,8)
            nvi = -nv(i)
            degme = degme - nvi
            nvpiv = nvpiv + nvi
            nel = nel + nvi
            nv(i) = 0
            elen(i) = 0
          ELSE
C           -------------------------------------------------------
C           update the upper-bound degree of i
C           -------------------------------------------------------
C           the following degree does not yet include the size
C           of the current element, which is added later:
C AMD            DEGREE (I) = min (DEGREE (I), DEG)
            IF (degree(i).NE.n2) THEN
C                I does not belong to halo
C                dk = min (d(k-1)+degme, deg+degme)
                 IF ( degree(i).LT.deg ) THEN
C                  Our appox degree is loose.
C                  we keep old value. Note that in 
C                  this case we cannot substract WF(I)
C                  for min-fill score.
                   wf4 = 0
                   wf3 = 0
                 ELSE
                   degree(i)  = deg
                 ENDIF
            ENDIF
C
C           compute WF(I) taking into account size of block 3.0
            wf(i)      = wf4 + 2*nvi*wf3
C           -------------------------------------------------------
C           add me to the list for i
C           -------------------------------------------------------
C           move first supervariable to end of list
            iw(pn) = iw(p3)
C           move first element to end of element part of list
            iw(p3) = iw(p1)
C           add new element to front of list.
            iw(p1) = me
C           store the new length of the list in len (i)
            len(i) = int(pn - p1 + 1_8)
            IF (deg.NE.n2) THEN
C           -------------------------------------------------------
C           place in hash bucket.  Save hash key of i in last (i).
C           -------------------------------------------------------
            hash = mod(hash, hmod) + 1_8
            j = head(hash)
            IF (j .LE. 0) THEN
C             the degree list is empty, hash head is -j
              next(i) = -j
              head(hash) = -i
            ELSE
C             degree list is not empty
C             use last (head (hash)) as hash head
              next(i) = last(j)
              last(j) = i
            ENDIF
            last(i) = int(hash,kind=kind(last))
            ENDIF
          ENDIF
  180   CONTINUE
        degree(me) = degme
C       -------------------------------------------------------------
C       Clear the counter array, w (...), by incrementing wflg.
C       -------------------------------------------------------------
        dmax = max(dmax, degme)
        wflg = wflg + dmax
C       make sure that wflg+n does not cause integer overflow
        IF (wflg .GT. maxint_n) THEN
          DO 190 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  190     CONTINUE
          wflg = 2
        ENDIF
C       at this point, w (1..n) .lt. wflg holds
C=======================================================================
C  SUPERVARIABLE DETECTION
C=======================================================================
        DO 250 pme = pme1, pme2
          i = iw(pme)
          IF ( (nv(i) .LT. 0) .AND. (degree(i).NE.n2) ) THEN
C           i is a principal variable in Lme
C           -------------------------------------------------------
C           examine all hash buckets with 2 or more variables.  We
C           do this by examing all unique hash keys for super-
C           variables in the pattern Lme of the current element, me
C           -------------------------------------------------------
            hash = int(last(i),kind=8)
C           let i = head of hash bucket, and empty the hash bucket
            j = head(hash)
            IF (j .EQ. 0) GO TO 250
            IF (j .LT. 0) THEN
C             degree list is empty
              i = -j
              head(hash) = 0
            ELSE
C             degree list is not empty, restore last () of head
              i = last(j)
              last(j) = 0
            ENDIF
            IF (i .EQ. 0) GO TO 250
C           while loop:
  200       CONTINUE
            IF (next(i) .NE. 0) THEN
C             ----------------------------------------------------
C             this bucket has one or more variables following i.
C             scan all of them to see if i can absorb any entries
C             that follow i in hash bucket.  Scatter i into w.
C             ----------------------------------------------------
              ln = len(i)
              eln = elen(i)
C             do not flag the first element in the list (me)
              DO 210 p = pe(i) + 1, pe(i) + int(ln - 1,8)
                w(iw(p)) = wflg
  210         CONTINUE
C             ----------------------------------------------------
C             scan every other entry j following i in bucket
C             ----------------------------------------------------
              jlast = i
              j = next(i)
C             while loop:
  220         CONTINUE
              IF (j .NE. 0) THEN
                 IF(constraint(j) .LT. 0
     &                .AND. constraint(i) .LT. 0) THEN
                    GOTO 240
                 ENDIF
                 IF(constraint(i) .GE. 0) THEN
                    IF(constraint(j) .LT. 0) THEN
                       toto = i
 221                   IF(toto .NE. 0) THEN
                          IF(constraint(toto) .EQ. j) THEN
                             GOTO 225
                          ENDIF
                          toto =theson(toto)
                          GOTO 221
                       ENDIF
                    ELSE
                       GOTO 225
                    ENDIF
                 ELSE
C     if I is locked see if it is freed thanks to J
                    IF(constraint(j) .GE. 0) THEN
                       toto = j
 222                   IF(toto .NE. 0) THEN
                          IF(constraint(toto) .EQ. i) THEN
                             GOTO 225
                          ENDIF
                          toto =theson(toto)
                          GOTO 222
                       ENDIF
                    ENDIF
                 ENDIF
                 GOTO 240
 225             CONTINUE
C               -------------------------------------------------
C               check if j and i have identical nonzero pattern
C               -------------------------------------------------
C               jump if i and j do not have same size data structure
                 IF (len(j) .NE. ln) GO TO 240
C               jump if i and j do not have same number adj elts
                 IF (elen(j) .NE. eln) GO TO 240
C               do not flag the first element in the list (me)
                 DO 230 p = pe(j) + 1_8, pe(j) + int(ln - 1,8)
C                 jump if an entry (iw(p)) is in j but not in i
                    IF (w(iw(p)) .NE. wflg) GO TO 240
 230             CONTINUE
C               -------------------------------------------------
C               found it!  j can be absorbed into i
C               -------------------------------------------------
C     update the supervariable composition
                 toto = i
 231             IF(theson(toto) .NE. 0) THEN
                    toto = theson(toto)
                    GOTO 231
                 ENDIF
                 theson(toto) = j
                 IF(constraint(i) .LT. 0) THEN
                    constraint(i) = 0
                 ENDIF
                 pe(j) = int(-i,8)
                 wf(i)  = max(wf(i),wf(j))
C               both nv (i) and nv (j) are negated since they
C               are in Lme, and the absolute values of each
C               are the number of variables in i and j:
                 nv(i) = nv(i) + nv(j)
                 nv(j) = 0
                 elen(j) = 0
C               delete j from hash bucket
                 j = next(j)
                 next(jlast) = j
                 GO TO 220
C               -------------------------------------------------
 240             CONTINUE
C               j cannot be absorbed into i
C               -------------------------------------------------
                 jlast = j
                 j = next(j)
                 GO TO 220
              ENDIF
C             ----------------------------------------------------
C             no more variables can be absorbed into i
C             go to next i in bucket and clear flag array
C             ----------------------------------------------------
              wflg = wflg + 1
              i = next(i)
              IF (i .NE. 0) GO TO 200
           ENDIF
          ENDIF
 250   CONTINUE
C=======================================================================
C  RESTORE DEGREE LISTS AND REMOVE NONPRINCIPAL SUPERVAR. FROM ELEMENT
C=======================================================================
        p = pme1
        nleft = totel - nel
        DO 260 pme = pme1, pme2
           i = iw(pme)
           nvi = -nv(i)
           IF (nvi .GT. 0) THEN
C           i is a principal variable in Lme
C           restore nv (i) to signify that i is principal
              nv(i) = nvi
              IF (degree(i).NE.n2) THEN
C           -------------------------------------------------------
C           compute the external degree (add size of current elem)
C           -------------------------------------------------------
                 deg = min(degree(i) + degme - nvi, nleft - nvi)
                 IF (degree(i) + degme .GT. nleft ) THEN
C
                  deg = degree(i)
                  rmf1  = dble(deg)*dble( (deg-1) + 2*degme )
     &                 - dble(wf(i))
                  degree(i) = nleft - nvi
                  deg       = degree(i) 
                  rmf = dble(deg)*dble(deg-1) 
     &                 -  dble(degme-nvi)*dble(degme-nvi-1)
                  rmf = min(rmf, rmf1)
               ELSE 
                  deg = degree(i)
                  degree(i) = degree(i) + degme - nvi
                  rmf  = dble(deg)*dble( (deg-1) + 2*degme ) 
     &                 - dble(wf(i))
               ENDIF
               rmf =  rmf / dble(nvi+1)
C
               IF (rmf.LT.dummy) THEN
                  wf(i) = int( anint( rmf ))
               ELSEIF (rmf / dble(n) .LT. dummy) THEN 
                  wf(i) = int( anint( rmf/dble(n) ))
               ELSE
                  wf(i) = idummy
               ENDIF
               wf(i) = max(1,wf(i))
C           -------------------------------------------------------
C           place the supervariable at the head of the degree list
C           -------------------------------------------------------
               deg = wf(i)
               IF (deg.GT.n) THEN
                  deg = min(((deg-n)/pas) + n , nbbuck)
               ENDIF
               inext = head(deg)
               IF (inext .NE. 0) last(inext) = i
               next(i) = inext
               last (i) = 0
               head(deg) = i
C           -------------------------------------------------------
C           save the new degree, and find the minimum degree
C           -------------------------------------------------------
               mindeg = min(mindeg, deg)
            ENDIF
C           -------------------------------------------------------
C           place the supervariable in the element pattern
C           -------------------------------------------------------
            iw(p) = i
            p = p + 1
         ENDIF
 260  CONTINUE
C=======================================================================
C  FINALIZE THE NEW ELEMENT
C=======================================================================
      nv(me) = nvpiv + degme
C       fill_est = fill_est + nvpiv * (nvpiv + 2 * degme)
C       nv (me) is now the degree of pivot (including diagonal part)
C       save the length of the list for the new element me
      len(me) = int(p - pme1)
      IF (len(me) .EQ. 0) THEN
C         there is nothing left of the current pivot element
         pe(me) = 0_8
         w(me) = 0
      ENDIF
      IF (newmem .NE. 0) THEN
C         element was not constructed in place: deallocate part
C         of it (final size is less than or equal to newmem,
C         since newly nonprincipal variables have been removed).
         pfree = p
         mem = mem - newmem + int(len(me),8)
      ENDIF
C=======================================================================
C       END WHILE (selecting pivots)
      GO TO 30
      ENDIF
C=======================================================================
C begin HALO V2
      IF (nbflag.GT.0) THEN
C
C     All possible pivots (not flagged have been eliminated).
C     We amalgamate all flagged variables at the root and 
C     we finish the elimination tree.
C          1/ Go through all
C          non absorbed elements (root of the subgraph)
C          and absorb in ME
C          2/ perform mass elimination of all dense rows
           DO deg = mindeg, nbbuck+1
             me = head(deg)
             IF (me .GT. 0) GO TO 51
           ENDDO
   51      mindeg = deg
           nelme    = -(nel+1)
           DO x=1,n
            IF ((pe(x).GT.0_8) .AND. (elen(x).LT.0)) THEN
C            X is an unabsorbed element
             pe(x) = int(-me,8)
C            W(X) = 0 could be suppressed ?? check it
            ELSEIF (degree(x).EQ.n2) THEN
C            X is a dense row, absorb it in ME (mass elimination)
             nel   = nel + nv(x)
             pe(x) = int(-me,8)
             elen(x) = 0
C            Correct value of NV is (secondary variable)
             nv(x) = 0
            ENDIF
           ENDDO
C          ME is the root node
           elen(me) = nelme
C          Correct value of NV is (principal variable)
           nv(me)   = n-nreal
           pe(me)   = 0_8
C
      ENDIF
C end HALO
C=======================================================================
C  COMPUTE THE PERMUTATION VECTORS
C=======================================================================
C     ----------------------------------------------------------------
C     The time taken by the following code is O(n).  At this
C     point, elen (e) = -k has been done for all elements e,
C     and elen (i) = 0 has been done for all nonprincipal
C     variables i.  At this point, there are no principal
C     supervariables left, and all elements are absorbed.
C     ----------------------------------------------------------------
C     ----------------------------------------------------------------
C     compute the ordering of unordered nonprincipal variables
C     ----------------------------------------------------------------
      DO 290 i = 1, n
         IF (elen(i) .EQ. 0) THEN
C         ----------------------------------------------------------
C         i is an un-ordered row.  Traverse the tree from i until
C         reaching an element, e.  The element, e, was the
C         principal supervariable of i and all nodes in the path
C         from i to when e was selected as pivot.
C         ----------------------------------------------------------
            j = int(-pe(i))
C         while (j is a variable) do:
 270        CONTINUE
            IF (elen(j) .GE. 0) THEN
               j = int(-pe(j))
               GO TO 270
            ENDIF
            e = j
C           ----------------------------------------------------------
C           get the current pivot ordering of e
C           ----------------------------------------------------------
            k = -elen(e)
C           ----------------------------------------------------------
C           traverse the path again from i to e, and compress the
C           path (all nodes point to e).  Path compression allows
C           this code to compute in O(n) time.  Order the unordered
C           nodes in the path, and place the element e at the end.
C           ----------------------------------------------------------
            j = i
C           while (j is a variable) do:
 280        CONTINUE
            IF (elen(j) .GE. 0) THEN
               jnext = int(-pe(j))
               pe(j) = int(-e,8)
               IF (elen(j) .EQ. 0) THEN
C               j is an unordered row
                  elen(j) = k
                  k = k + 1
               ENDIF
               j = jnext
               GO TO 280
            ENDIF
C         leave elen (e) negative, so we know it is an element
            elen(e) = -k
         ENDIF
 290  CONTINUE
C     ----------------------------------------------------------------
C     reset the inverse permutation (elen (1..n)) to be positive,
C     and compute the permutation (last (1..n)).
C     ----------------------------------------------------------------
      IF(.true.) THEN
C       N is the size of the compressed graph.
C       If the graph was compressed on input then
C       indices in ELEN are in [1,TOTEL]
C       We build the inverse of ELEN in LAST (similar to
C       the pivot order but has zeros in it) and then compress
C       it. Since LAST is assumed to be of size N at the
C       interface level, we need another array to store
C       the inverse of ELEN for entries greater than N
C       We use DEGREE.
        last(1:n) = 0
        degree(1:totel-n)=0
        DO i = 1, n
          k = abs(elen(i))
          IF ( k <= n ) THEN
            last(k) = i
          ELSE
            degree(k-n)=i
          ENDIF
        ENDDO
        i = 1
        DO k = 1, n
          IF(last(k) .NE. 0) THEN
            last(i) = last(k)
            elen(last(k)) = i
            i = i + 1
          ENDIF
        ENDDO
        DO k = n+1, totel
          IF (degree(k-n) .NE. 0) THEN
            last(i)=degree(k-n)
            elen(degree(k-n)) = i
            i = i + 1
          ENDIF
        END DO
      ELSE
        DO 300 i = 1, n
           k = abs(elen(i))
           last(k) = i
           elen(i) = k
300     CONTINUE
      ENDIF
C=======================================================================
C  RETURN THE MEMORY USAGE IN IW
C=======================================================================
C     If maxmem is less than or equal to iwlen, then no compressions
C     occurred, and iw (maxmem+1 ... iwlen) was unused.  Otherwise
C     compressions did occur, and iwlen would have had to have been
C     greater than or equal to maxmem for no compressions to occur.
C     Return the value of maxmem in the pfree argument.
      pfree = maxmem
C===============================
C     Save PE in PARENT array
      DO i=1,n
       parent(i) = int(pe(i))
      ENDDO
C===============================
      RETURN

mumps_hamd()

subroutine mumps_hamd	(	integer, intent(in)	n,
		integer(8), intent(in)	iwlen,
		integer(8), dimension(n), intent(inout)	pe,
		integer(8), intent(inout)	pfree,
		integer, dimension(n), intent(inout)	len,
		integer, dimension(iwlen), intent(inout)	iw,
		integer, dimension(n), intent(out)	nv,
		integer, dimension(n), intent(out)	elen,
		integer, dimension(n), intent(out)	last,
		integer, intent(out)	ncmpa,
		integer, dimension(n)	degree,
		integer, dimension(n)	head,
		integer, dimension(n)	next,
		integer, dimension(n)	w,
		integer, dimension(n), intent(out)	parent,
		integer, dimension(size_schur), intent(in)	listvar_schur,
		integer, intent(in)	size_schur )

Definition at line 2369 of file ana_orderings.F.

C
C Parameters
C    Input not modified
      INTEGER, intent(in) :: SIZE_SCHUR
      INTEGER, intent(in) :: LISTVAR_SCHUR(SIZE_SCHUR)
      INTEGER, INTENT(IN)    :: N
      INTEGER(8), INTENT(IN) :: IWLEN
C     Input undefined on output 
      INTEGER, INTENT(INOUT)  :: LEN(N), IW(IWLEN)
C 
C     Output only 
      INTEGER, INTENT(OUT)   :: NCMPA
      INTEGER, INTENT(OUT)   :: NV(N), ELEN(N), LAST(N), PARENT(N)
C 
C     Input/output
      INTEGER(8), INTENT(INOUT) :: PFREE
      INTEGER(8), INTENT(INOUT) :: PE(N)
C 
C     Internal Workspace only
      INTEGER     :: NEXT(N), DEGREE(N), HEAD(N), W(N)
C
C ---------------------
C Interface Description
C ---------------------
C    HAMD (short for HALOAMD)
C    The initial version (so called HALOAMD_V1, developped in September 1997)
C    is designed to experiment the numerical (fill-in) impact 
C    of taking into account the halo. This code should be able 
C    to experiment no-halo, partial halo, complete halo.
C    DATE: September 17th 1997
C
C    HALOAMD is designed to process a gragh composed of two types
C            of nodes, V0 and V1, extracted from a larger gragh. 
C            V0^V1 = {}, 
C       
C            We used Min. degree heuristic to order only 
C            nodes in V0, but the adjacency to nodes
C            in V1 is taken into account during ordering.
C            Nodes in V1 are odered at last.
C            Adjacency between nodes of V1 need not be provided,
C            however |len(i)| must always corresponds to the number of 
C            edges effectively provided in the adjacency list of i.
C          On input :
C          ********
C            Nodes INODE in V1 are flagged with len(INODE) = -degree 
C            modif version HALO V3 (August 1998): 
C                                 if len(i) =0 and i \in V1 then 
C                                 len(i) must be set on input to -N-1
C          ERROR return (negative values in ncmpa)
C          ************
C            negative value in ncmpa indicates an error detected 
C               by HALOAMD.
C
C            The graph provided MUST follow the rule:
C             if (i,j) is an edge in the gragh then 
C             j must be in the adjacency list of i AND 
C             i must be in the adjacency list of j.
C    REMARKS:
C        1/  Providing edges between nodes of V1 should not 
C            affect the final ordering, only the amount of edges 
C            of the halo should effectively affect the solution.
C            This code should work in the following cases:
C              1/ halo not provided
C              2/ halo partially provided
C              3/ complete halo
C              4/ complete halo+interconnection between nodes of V1.
C
C              1/ should run and provide identical results (w.r.t to current 
C               implementation of AMD in SCOTCH).
C             3/ and 4 should provide identical results.
C
C        2/ All modifications of the AMD initial code are indicated
C           with begin HALO .. end HALO
C
C            
C   Ordering of nodes in V0 is based on 
C   Approximate Minimum Degree ordering algorithm, 
C   with aggressive absorption:
C   Given a representation of the nonzero pattern of a symmetric matrix,
C   A, (excluding the diagonal) perform an approximate minimum
C   degree ordering to compute a pivot order
C   such that fill-in in the Cholesky factors A = LL^T is kept low. 
C
C ------------------------------
C Modification history:
C ---------------------
C Date:  September, 1997 (V1)
C        April, 1998 (V2)
C        August, 1998 (V3)
C        Octobre, 1998 (V4)
C        December, 1998 (V5)
C        January, 1999 (V6)
C   HALOAMD_V6: 
C   ----------
C    1/ ERROR 2 detection followed by stop statement suppressed 
C  . 2/ pb 1  identified in V5 was not correctly solved
C
C   HALOAMD_V5:
C   ----------
C    1/ Pb with matrix psmigr 1, because upper bound 
C      degree DEG  >N was considered as a node in V1 
C
C   HALOAMD_V4: 
C   ---------- 
C    Only UnsymetrizedMultifrontal interface 
C    (ok for both scotch and UnsymetricMultifrontal) is 
C    included in this file
C
C   HALOAMD_V3: 
C   ----------
C    Problem in version 2 : variables of V1 with len(i) =0 
C                        are not well processed. 
C                        See modification of the 
C                        input to characterize those variables.
C 
C    Problem detected by Jacko Koster while experimenting with 
C    version 2 of haloAMD in the context of multiple front method :
C    "if for an interface variable i, row i in the matrix has only a
C    nonzero entry on the diagonal, we first remove this entry and len(i)  
C    is set to zero on input to HALOAMD. However, this means that HALOAMD 
C    will treat variable i as an interior variable (in V0) instead as an 
C    interface variable (in V1). (It is indeed a bit strange to have such 
C    interface variables but we encountered some in our debugging 
C    experiments with some random partitionings.)
C
C    Solution : 
C     IF on input i \in V1 and len(i) =0 (that is adjlist(i)={}) THEN
C      len(i) must be set on input to -N-1. 
C     ENDIF
C     therefore all variables i / len(i) < 0 an only those are in V1
C     variable with len(i) = -N-1 are then processed differently at 
C     the beginning of the code
C
C   HALOAMD_V2:
C   ----------
C    The end of the tree (including links to block of flagged indices
C                       is built) . The list of flagged indices is 
C                       considered as a dense amalgamated node.
C
C    Comments on the OUTPUT:
C    ----------------------
C    Let V= V0 U V1 the nodes of the initial graph (|V|=n). 
C    The assembly tree corresponds to the tree 
C    of the supernodes (or supervariables). Each node of the 
C    assembly tree is then composed of one principal variable 
C    and a list of secondary variables. The list of 
C    variable of a node (principal + secondary variables) then 
C    describes the structure of the diagonal bloc of the 
C    supernode. 
C    The elimination tree denotes the tree of all the variables(=node) and 
C    is therefore of order n.
C
C    The arrays NV(N) and PE(N) give a description of the 
C    assembly tree. 
C     1/ Description of array nv(N) (on OUPUT)
C        nv(i)=0 i is a secondary variable 
C        N+1> nv(i) >0 i is a principal variable, nv(i) holds the 
C                the number of elements in column i of L (true degree of i)
C     2/ Description of array PE(N) (on OUPUT)
C       pe(i) = -(father of variable/node i) in the elimination tree:
C       If nv (i) .gt. 0, then i represents a node in the assembly tree,
C       and the parent of i is -pe (i), or zero if i is a root.
C       If nv (i) = 0, then (i,-pe (i)) represents an edge in a
C       subtree, the root of which is a node in the assembly tree.
C     3/ Example:
C       Let If be a root node father of Is in the assembly tree. 
C       If is the principal 
C       variable of the node If and let If1, If2, If3 be the 
C       secondary variables of node If.
C       Is is the principal 
C       variable of the node Is and let Is1, Is2 be the secondary variables
C       of node Is.
C      
C       THEN: 
C        NV(If1)=NV(If2)=NV(If3) = 0  (secondary variables)
C        NV(Is1)=NV(Is2) = 0  (secondary variables)
C        NV(If) > 0  ( principal variable)
C        NV(Is) > 0  ( principal variable)
C        PE(If)  = 0 (root node)
C        PE(Is)  = -If (If is the father of Is in the assembly tree)
C        PE(If1)=PE(If2)=PE(If3)= -If  ( If is the principal variable)
C        PE(Is1)=PE(Is2)= -Is  ( Is is the principal variable)
C-----------------------------------------------------------------------
C INPUT ARGUMENTS (unaltered):
C-----------------------------------------------------------------------
C n:    The matrix order.
C
C       Restriction:  n .ge. 1
C iwlen:        The length of iw (1..iwlen).  On input, the matrix is
C       stored in iw (1..pfree-1).  However, iw (1..iwlen) should be
C       slightly larger than what is required to hold the matrix, at
C       least iwlen .ge. pfree + n is recommended.  Otherwise,
C       excessive compressions will take place.
C       *** We do not recommend running this algorithm with ***
C       ***      iwlen .lt. pfree + n.                      ***
C       *** Better performance will be obtained if          ***
C       ***      iwlen .ge. pfree + n                       ***
C       *** or better yet                                   ***
C       ***      iwlen .gt. 1.2 * pfree                     ***
C       *** (where pfree is its value on input).            ***
C       The algorithm will not run at all if iwlen .lt. pfree-1.
C
C       Restriction: iwlen .ge. pfree-1
C-----------------------------------------------------------------------
C INPUT/OUPUT ARGUMENTS:
C-----------------------------------------------------------------------
C pe:   On input, pe (i) is the index in iw of the start of row i, or
C       zero if row i has no off-diagonal non-zeros.
C
C       During execution, it is used for both supervariables and
C       elements:
C
C       * Principal supervariable i:  index into iw of the
C               description of supervariable i.  A supervariable
C               represents one or more rows of the matrix
C               with identical nonzero pattern.
C       * Non-principal supervariable i:  if i has been absorbed
C               into another supervariable j, then pe (i) = -j.
C               That is, j has the same pattern as i.
C               Note that j might later be absorbed into another
C               supervariable j2, in which case pe (i) is still -j,
C               and pe (j) = -j2.
C       * Unabsorbed element e:  the index into iw of the description
C               of element e, if e has not yet been absorbed by a
C               subsequent element.  Element e is created when
C               the supervariable of the same name is selected as
C               the pivot.
C       * Absorbed element e:  if element e is absorbed into element
C               e2, then pe (e) = -e2.  This occurs when the pattern of
C               e (that is, Le) is found to be a subset of the pattern
C               of e2 (that is, Le2).  If element e is "null" (it has
C               no nonzeros outside its pivot block), then pe (e) = 0.
C
C       On output, pe holds the assembly tree/forest, which implicitly
C       represents a pivot order with identical fill-in as the actual
C       order (via a depth-first search of the tree).
C
C       On output:
C       If nv (i) .gt. 0, then i represents a node in the assembly tree,
C       and the parent of i is -pe (i), or zero if i is a root.
C       If nv (i) = 0, then (i,-pe (i)) represents an edge in a
C       subtree, the root of which is a node in the assembly tree.
C       On output:  (PE is copied on output into PARENT array)
C
C pfree:        On input, the matrix is stored in iw (1..pfree-1) and
C       the rest of the array iw is free.
C       During execution, additional data is placed in iw, and pfree
C       is modified so that components  of iw from pfree are free.
C       On output, pfree is set equal to the size of iw that
C       would have been needed for no compressions to occur.  If
C       ncmpa is zero, then pfree (on output) is less than or equal to
C       iwlen, and the space iw (pfree+1 ... iwlen) was not used.
C       Otherwise, pfree (on output) is greater than iwlen, and all the
C       memory in iw was used.
C-----------------------------------------------------------------------
C INPUT/MODIFIED (undefined on output):
C-----------------------------------------------------------------------
C len:  On input, len (i) 
C           positive or null (>=0) : i \in V0 and 
C                     len(i) holds the number of entries in row i of the
C                     matrix, excluding the diagonal.  
C           negative (<0) : i \in V1, and 
C                     -len(i) hold the number of entries in row i of the
C                     matrix, excluding the diagonal.
C                     len(i) = - | Adj(i) | if i \in V1                    
C                              or -N -1 if  | Adj(i) | = 0 and i \in V1 
C       The contents of len (1..n)
C       are undefined on output.
C iw:   On input, iw (1..pfree-1) holds the description of each row i
C       in the matrix.  The matrix must be symmetric, and both upper
C       and lower triangular parts must be present.  The diagonal must
C       not be present.  Row i is held as follows:
C
C               len (i):  the length of the row i data structure
C               iw (pe (i) ... pe (i) + len (i) - 1):
C                       the list of column indices for nonzeros
C                       in row i (simple supervariables), excluding
C                       the diagonal.  All supervariables start with
C                       one row/column each (supervariable i is just
C                       row i).
C               if len (i) is zero on input, then pe (i) is ignored
C               on input.
C
C               Note that the rows need not be in any particular order,
C               and there may be empty space between the rows.
C
C       During execution, the supervariable i experiences fill-in.
C       This is represented by placing in i a list of the elements
C       that cause fill-in in supervariable i:
C
C               len (i):  the length of supervariable i
C               iw (pe (i) ... pe (i) + elen (i) - 1):
C                       the list of elements that contain i.  This list
C                       is kept short by removing absorbed elements.
C               iw (pe (i) + elen (i) ... pe (i) + len (i) - 1):
C                       the list of supervariables in i.  This list
C                       is kept short by removing nonprincipal
C                       variables, and any entry j that is also
C                       contained in at least one of the elements
C                       (j in Le) in the list for i (e in row i).
C
C       When supervariable i is selected as pivot, we create an
C       element e of the same name (e=i):
C
C               len (e):  the length of element e
C               iw (pe (e) ... pe (e) + len (e) - 1):
C                       the list of supervariables in element e.
C
C       An element represents the fill-in that occurs when supervariable
C       i is selected as pivot (which represents the selection of row i
C       and all non-principal variables whose principal variable is i).
C       We use the term Le to denote the set of all supervariables
C       in element e.  Absorbed supervariables and elements are pruned
C       from these lists when computationally convenient.
C
C       CAUTION:  THE INPUT MATRIX IS OVERWRITTEN DURING COMPUTATION.
C       The contents of iw are undefined on output.
C-----------------------------------------------------------------------
C OUTPUT (need not be set on input):
C-----------------------------------------------------------------------
C nv:   During execution, abs (nv (i)) is equal to the number of rows
C       that are represented by the principal supervariable i.  If i is
C       a nonprincipal variable, then nv (i) = 0.  Initially,
C       nv (i) = 1 for all i.  nv (i) .lt. 0 signifies that i is a
C       principal variable in the pattern Lme of the current pivot
C       element me.  On output, nv (e) holds the true degree of element
C       e at the time it was created (including the diagonal part).
C begin HALO
C       On output, nv(I) can be used to find node in set V1.
C       nv(I) = N+1 characterizes nodes in V1. 
C end HALO
C elen: See the description of iw above.  At the start of execution,
C       elen (i) is set to zero.  During execution, elen (i) is the
C       number of elements in the list for supervariable i.  When e
C       becomes an element, elen (e) = -nel is set, where nel is the
C       current step of factorization.  elen (i) = 0 is done when i
C       becomes nonprincipal.
C
C       For variables, elen (i) .ge. 0 holds until just before the
C       permutation vectors are computed.  For elements,
C       elen (e) .lt. 0 holds.
C
C       On output elen (1..n) holds the inverse permutation (the same
C       as the 'INVP' argument in Sparspak).  That is, if k = elen (i),
C       then row i is the kth pivot row.  Row i of A appears as the
C       (elen(i))-th row in the permuted matrix, PAP^T.
C last: In a degree list, last (i) is the supervariable preceding i,
C       or zero if i is the head of the list.  In a hash bucket,
C       last (i) is the hash key for i.  last (head (hash)) is also
C       used as the head of a hash bucket if head (hash) contains a
C       degree list (see head, below).
C
C       On output, last (1..n) holds the permutation (the same as the
C       'PERM' argument in Sparspak).  That is, if i = last (k), then
C       row i is the kth pivot row.  Row last (k) of A is the k-th row
C       in the permuted matrix, PAP^T.
C ncmpa:        The number of times iw was compressed.  If this is
C       excessive, then the execution took longer than what could have
C       been.  To reduce ncmpa, try increasing iwlen to be 10% or 20%
C       larger than the value of pfree on input (or at least
C       iwlen .ge. pfree + n).  The fastest performance will be
C       obtained when ncmpa is returned as zero.  If iwlen is set to
C       the value returned by pfree on *output*, then no compressions
C       will occur.
C begin HALO
C        on output ncmpa <0 --> error detected during HALO_AMD:
C           error 1: ncmpa = -N , ordering was stopped.
C end HALO
C
C-----------------------------------------------------------------------
C LOCAL (not input or output - used only during execution):
C-----------------------------------------------------------------------
C degree:       If i is a supervariable, then degree (i) holds the
C       current approximation of the external degree of row i (an upper
C       bound).  The external degree is the number of nonzeros in row i,
C       minus abs (nv (i)) (the diagonal part).  The bound is equal to
C       the external degree if elen (i) is less than or equal to two.
C       We also use the term "external degree" for elements e to refer
C       to |Le \ Lme|.  If e is an element, then degree (e) holds |Le|,
C       which is the degree of the off-diagonal part of the element e
C       (not including the diagonal part).
C begin HALO
C       degree(I) = n+1 indicates that i belongs to V1
C end HALO
C
C head: head is used for degree lists.  head (deg) is the first
C       supervariable in a degree list (all supervariables i in a
C       degree list deg have the same approximate degree, namely,
C       deg = degree (i)).  If the list deg is empty then
C       head (deg) = 0.
C
C       During supervariable detection head (hash) also serves as a
C       pointer to a hash bucket.
C       If head (hash) .gt. 0, there is a degree list of degree hash.
C               The hash bucket head pointer is last (head (hash)).
C       If head (hash) = 0, then the degree list and hash bucket are
C               both empty.
C       If head (hash) .lt. 0, then the degree list is empty, and
C               -head (hash) is the head of the hash bucket.
C       After supervariable detection is complete, all hash buckets
C       are empty, and the (last (head (hash)) = 0) condition is
C       restored for the non-empty degree lists.
C next: next (i) is the supervariable following i in a link list, or
C       zero if i is the last in the list.  Used for two kinds of
C       lists:  degree lists and hash buckets (a supervariable can be
C       in only one kind of list at a time).
C w:    The flag array w determines the status of elements and
C       variables, and the external degree of elements.
C
C       for elements:
C          if w (e) = 0, then the element e is absorbed
C          if w (e) .ge. wflg, then w (e) - wflg is the size of
C               the set |Le \ Lme|, in terms of nonzeros (the
C               sum of abs (nv (i)) for each principal variable i that
C               is both in the pattern of element e and NOT in the
C               pattern of the current pivot element, me).
C          if wflg .gt. w (e) .gt. 0, then e is not absorbed and has
C               not yet been seen in the scan of the element lists in
C               the computation of |Le\Lme| in loop 150 below.
C
C       for variables:
C          during supervariable detection, if w (j) .ne. wflg then j is
C          not in the pattern of variable i
C
C       The w array is initialized by setting w (i) = 1 for all i,
C       and by setting wflg = 2.  It is reinitialized if wflg becomes
C       too large (to ensure that wflg+n does not cause integer
C       overflow).
C-----------------------------------------------------------------------
C LOCAL INTEGERS:
C-----------------------------------------------------------------------
      INTEGER    :: DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I,
     &        ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3,
     &        LENJ, LN, ME, MINDEG, NEL, 
     &        NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X,
     &        NBFLAG, NREAL, LASTD, NELME
      INTEGER KNT1_UPDATED, KNT2_UPDATED
      INTEGER(8) ::  MAXMEM, MEM, NEWMEM
      INTEGER    :: MAXINT_N
      INTEGER(8) :: HASH, HMOD
C deg:        the degree of a variable or element
C degme:      size, |Lme|, of the current element, me (= degree (me))
C dext:       external degree, |Le \ Lme|, of some element e
C dmax:       largest |Le| seen so far
C e:          an element
C elenme:     the length, elen (me), of element list of pivotal var.
C eln:        the length, elen (...), of an element list
C hash:       the computed value of the hash function
C hmod:       the hash function is computed modulo hmod = max (1,n-1)
C i:          a supervariable
C ilast:      the entry in a link list preceding i
C inext:      the entry in a link list following i
C j:          a supervariable
C jlast:      the entry in a link list preceding j
C jnext:      the entry in a link list, or path, following j
C k:          the pivot order of an element or variable
C knt1:       loop counter used during element construction
C knt2:       loop counter used during element construction
C knt3:       loop counter used during compression
C lenj:       len (j)
C ln:         length of a supervariable list
C maxint_n:   large integer to test risk of overflow on wflg
C maxmem:     amount of memory needed for no compressions
C me:         current supervariable being eliminated, and the
C                     current element created by eliminating that
C                     supervariable
C mem:        memory in use assuming no compressions have occurred
C mindeg:     current minimum degree
C nel:        number of pivots selected so far
C newmem:     amount of new memory needed for current pivot element
C nleft:      n - nel, the number of nonpivotal rows/columns remaining
C nvi:        the number of variables in a supervariable i (= nv (i))
C nvj:        the number of variables in a supervariable j (= nv (j))
C nvpiv:      number of pivots in current element
C slenme:     number of variables in variable list of pivotal variable
C we:         w (e)
C wflg:       used for flagging the w array.  See description of iw.
C wnvi:       wflg - nv (i)
C x:          either a supervariable or an element
C begin HALO
C nbflag:     number of flagged entries in the initial gragh.
C nreal :     number of entries on which ordering must be perfomed
C             (nreel = N- nbflag)
C nelme number of pivots selected when reaching the root
C lastd index of the last row in the list of dense rows
C end HALO
C-----------------------------------------------------------------------
C LOCAL POINTERS:
C-----------------------------------------------------------------------
      INTEGER(8) :: P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, 
     &              PN, PSRC
C             Any parameter (pe (...) or pfree) or local variable
C             starting with "p" (for Pointer) is an index into iw,
C             and all indices into iw use variables starting with
C             "p."  The only exception to this rule is the iwlen
C             input argument.
C p:          pointer into lots of things
C p1:         pe (i) for some variable i (start of element list)
C p2:         pe (i) + elen (i) -  1 for some var. i (end of el. list)
C p3:         index of first supervariable in clean list
C pdst:       destination pointer, for compression
C pend:       end of memory to compress
C pj:         pointer into an element or variable
C pme:        pointer into the current element (pme1...pme2)
C pme1:       the current element, me, is stored in iw (pme1...pme2)
C pme2:       the end of the current element
C pn:         pointer into a "clean" variable, also used to compress
C psrc:       source pointer, for compression
C-----------------------------------------------------------------------
C  FUNCTIONS CALLED:
C-----------------------------------------------------------------------
      INTRINSIC max, min, mod
C=======================================================================
C  INITIALIZATIONS
C=======================================================================
      wflg = 2
      maxint_n=huge(wflg)-n
      mindeg = 1
      ncmpa = 0
      nel = 0
      hmod = int(max(1, n-1),kind=8)
      dmax = 0
      mem = pfree - 1
      maxmem = mem
C begin HALO 
      nbflag = 0
      lastd  = 0
C end HALO 
      DO 10 i = 1, n
        last(i) = 0
        head(i) = 0
        nv(i) = 1
        w(i) = 1
        elen(i) = 0
        degree(i) = len(i)
   10 CONTINUE
C
C begin HALO-SCHUR
      nbflag = size_schur
C
      DO k=1,size_schur
C
       i = listvar_schur(k)
       degree(i) = n+1
       IF ((len(i) .EQ.0).OR.(len(i).EQ.-n-1)) THEN
C      Both ways of characterizing i \in Schur with Adj(I) = 0
C        Because of compress, we force skipping this
C        entry which is anyway empty
         pe(i)     = 0_8
         len(i)     = 0
       ENDIF
C      insert I at the end of degree list of n
C                  (safe: because max external degree is N-1)
       deg = n
       IF (lastd.EQ.0) THEN
C              degree list is empty
               lastd     = i
               head(deg) = i
               next(i)   = 0
               last(i)   = 0
       ELSE
               next(lastd) = i
               last(i)     = lastd
               lastd       = i
               next(i)     = 0
       ENDIF
C
      ENDDO
C     number of entries to be ordered.
      nreal = n - nbflag
C end HALO-SCHUR
C     ----------------------------------------------------------------
C     initialize degree lists and eliminate rows with no off-diag. nz.
C     ----------------------------------------------------------------
      DO 20 i = 1, n
        deg = degree(i)
C begin HALO-SCHUR
        IF (deg.EQ.n+1)  GOTO 20
C end HALO-SCHUR
C
        IF (deg .GT. 0) THEN
C         ----------------------------------------------------------
C         place i in the degree list corresponding to its degree
C         ----------------------------------------------------------
          inext = head(deg)
          IF (inext .NE. 0) last(inext) = i
          next(i) = inext
          head(deg) = i
        ELSE
C         ----------------------------------------------------------
C         we have a variable that can be eliminated at once because
C         there is no off-diagonal non-zero in its row.
C         ----------------------------------------------------------
          nel = nel + nv(i)
          elen(i) = -nel
          pe (i) = 0_8
          w(i) = 0
        ENDIF
   20 CONTINUE
C=======================================================================
C  WHILE (selecting pivots) DO
C=======================================================================
C begin HALO V5
      nleft = n-nel
C end HALO V5
C begin HALO
C AMD test:   30 IF (NEL .LT. N) THEN
   30 IF (nel .LT. nreal) THEN
C end HALO
C=======================================================================
C  GET PIVOT OF MINIMUM DEGREE
C=======================================================================
C       -------------------------------------------------------------
C       find next supervariable for elimination
C       -------------------------------------------------------------
        DO 40 deg = mindeg, n
          me = head(deg)
          IF (me .GT. 0) GO TO 50
   40   CONTINUE
   50   mindeg = deg
C begin HALO
        IF (me.LE.0) THEN
          write (*,*) ' ERROR 1 in HALO_AMD '
C         return to calling program with error return
          ncmpa = -n
          GOTO 500
        ENDIF
C end HALO
C         -------------------------------------------------------------
C         remove chosen variable from link list
C         -------------------------------------------------------------
          inext = next(me)
          IF (inext .NE. 0) last(inext) = 0
          head(deg) = inext
C       -------------------------------------------------------------
C       me represents the elimination of pivots nel+1 to nel+nv(me).
C       place me itself as the first in this set.  It will be moved
C       to the nel+nv(me) position when the permutation vectors are
C       computed.
C       -------------------------------------------------------------
        elenme = elen(me)
        elen(me) = - (nel + 1)
        nvpiv = nv(me)
        nel = nel + nvpiv
C=======================================================================
C  CONSTRUCT NEW ELEMENT
C=======================================================================
C       -------------------------------------------------------------
C       At this point, me is the pivotal supervariable.  It will be
C       converted into the current element.  Scan list of the
C       pivotal supervariable, me, setting tree pointers and
C       constructing new list of supervariables for the new element,
C       me.  p is a pointer to the current position in the old list.
C       -------------------------------------------------------------
C       flag the variable "me" as being in Lme by negating nv (me)
        nv(me) = -nvpiv
        degme = 0
        IF (elenme .EQ. 0) THEN
C         ----------------------------------------------------------
C         construct the new element in place
C         ----------------------------------------------------------
          pme1 = pe(me)
          pme2 = pme1 - 1
          DO 60 p = pme1, pme1 + len(me) - 1
            i = iw(p)
            nvi = nv(i)
            IF (nvi .GT. 0) THEN
C             ----------------------------------------------------
C             i is a principal variable not yet placed in Lme.
C             store i in new list
C             ----------------------------------------------------
              degme = degme + nvi
C             flag i as being in Lme by negating nv (i)
              nv(i) = -nvi
              pme2 = pme2 + 1
              iw(pme2) = i
C begin HALO
              IF (degree(i).LE.n) THEN
C end HALO
C             ----------------------------------------------------
C             remove variable i from degree list. (only if i \in V0)
C             ----------------------------------------------------
              ilast = last(i)
              inext = next (i)
              IF (inext .NE. 0) last(inext) = ilast
              IF (ilast .NE. 0) THEN
                next(ilast) = inext
              ELSE
C               i is at the head of the degree list
                head(degree(i)) = inext
              ENDIF
C begin HALO
              ENDIF
C end HALO
            ENDIF
   60     CONTINUE
C         this element takes no new memory in iw:
          newmem = 0
        ELSE
C         ----------------------------------------------------------
C         construct the new element in empty space, iw (pfree ...)
C         ----------------------------------------------------------
          p = pe(me)
          pme1 = pfree
          slenme = len(me) - elenme
          knt1_updated = 0
          DO 120 knt1 = 1, elenme + 1
            knt1_updated = knt1_updated +1
            IF (knt1 .GT. elenme) THEN
C             search the supervariables in me.
              e = me
              pj = p
              ln = slenme
            ELSE
C             search the elements in me.
              e = iw(p)
              p = p + 1
              pj = pe(e)
              ln = len(e)
            ENDIF
C           -------------------------------------------------------
C           search for different supervariables and add them to the
C           new list, compressing when necessary. this loop is
C           executed once for each element in the list and once for
C           all the supervariables in the list.
C           -------------------------------------------------------
            knt2_updated = 0
            DO 110 knt2 = 1, ln
              knt2_updated = knt2_updated+1
              i = iw(pj)
              pj = pj + 1
              nvi = nv(i)
              IF (nvi .GT. 0) THEN
C               -------------------------------------------------
C               compress iw, if necessary
C               -------------------------------------------------
                IF (pfree .GT. iwlen) THEN
C                 prepare for compressing iw by adjusting
C                 pointers and lengths so that the lists being
C                 searched in the inner and outer loops contain
C                 only the remaining entries.
                  pe(me) = p
                  len(me) = len(me) - knt1_updated
C                 Reset KNT1_UPDATED in case of recompress 
C                 at same iteration of the loop 120
                  knt1_updated = 0
C                 Check if anything left in supervariable ME
                  IF (len(me) .EQ. 0) pe(me) = 0_8
                  pe(e) = pj
                  len(e) = ln - knt2_updated
C                 Reset KNT2_UPDATED in case of recompress 
C                 at same iteration of the loop 110
                  knt2_updated = 0
C                 Check if anything left in element E
                  IF (len(e) .EQ. 0) pe(e) = 0
                  ncmpa = ncmpa + 1
C                 store first item in pe
C                 set first entry to -item
                  DO 70 j = 1, n
                    pn = pe(j)
                    IF (pn .GT. 0) THEN
                      pe(j) = int(iw(pn),8)
                      iw(pn) = -j
                    ENDIF
   70             CONTINUE
C                 psrc/pdst point to source/destination
                  pdst = 1
                  psrc = 1
                  pend = pme1 - 1
C                 while loop:
   80             CONTINUE
                  IF (psrc .LE. pend) THEN
C                   search for next negative entry
                    j = -iw(psrc)
                    psrc = psrc + 1
                    IF (j .GT. 0) THEN
                      iw(pdst) = int(pe(j))
                      pe(j) = pdst
                      pdst = pdst + 1
C                     copy from source to destination
                      lenj = len(j)
                      DO 90 knt3 = 0, lenj - 2
                        iw(pdst + knt3) = iw(psrc + knt3)
   90                 CONTINUE
                      pdst = pdst + lenj - 1
                      psrc = psrc + lenj - 1
                    ENDIF
                    GO TO 80
                  ENDIF
C                 move the new partially-constructed element
                  p1 = pdst
                  DO 100 psrc = pme1, pfree - 1
                    iw(pdst) = iw(psrc)
                    pdst = pdst + 1
  100             CONTINUE
                  pme1 = p1
                  pfree = pdst
                  pj = pe(e)
                  p = pe (me)
                ENDIF
C               -------------------------------------------------
C               i is a principal variable not yet placed in Lme
C               store i in new list
C               -------------------------------------------------
                degme = degme + nvi
C               flag i as being in Lme by negating nv (i)
                nv(i) = -nvi
                iw(pfree) = i
                pfree = pfree + 1
C begin HALO
              IF (degree(i).LE.n) THEN
C end HALO
C               -------------------------------------------------
C               remove variable i from degree link list 
C                            (only if i in V0)
C               -------------------------------------------------
                ilast = last(i)
                inext = next(i)
                IF (inext .NE. 0) last(inext) = ilast
                IF (ilast .NE. 0) THEN
                  next(ilast) = inext
                ELSE
C                 i is at the head of the degree list
                  head(degree(i)) = inext
                ENDIF
C begin HALO
              ENDIF
C end HALO
              ENDIF
  110       CONTINUE
            IF (e .NE. me) THEN
C             set tree pointer and flag to indicate element e is
C             absorbed into new element me (the parent of e is me)
              pe(e) = int(-me,8)
              w(e) = 0
            ENDIF
  120     CONTINUE
          pme2 = pfree - 1
C         this element takes newmem new memory in iw (possibly zero)
          newmem = pfree - pme1
          mem = mem + newmem
          maxmem = max(maxmem, mem)
        ENDIF
C       -------------------------------------------------------------
C       me has now been converted into an element in iw (pme1..pme2)
C       -------------------------------------------------------------
C       degme holds the external degree of new element
        degree(me) = degme
        pe(me) = pme1
        len(me) = int(pme2 - pme1 + 1_8)
C       -------------------------------------------------------------
C       make sure that wflg is not too large.  With the current
C       value of wflg, wflg+n must not cause integer overflow
C       -------------------------------------------------------------
        IF (wflg .GT. maxint_n) THEN
          DO 130 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  130     CONTINUE
          wflg = 2
        ENDIF
C=======================================================================
C  COMPUTE (w (e) - wflg) = |Le\Lme| FOR ALL ELEMENTS
C=======================================================================
C       -------------------------------------------------------------
C       Scan 1:  compute the external degrees of previous elements
C       with respect to the current element.  That is:
C            (w (e) - wflg) = |Le \ Lme|
C       for each element e that appears in any supervariable in Lme.
C       The notation Le refers to the pattern (list of
C       supervariables) of a previous element e, where e is not yet
C       absorbed, stored in iw (pe (e) + 1 ... pe (e) + iw (pe (e))).
C       The notation Lme refers to the pattern of the current element
C       (stored in iw (pme1..pme2)).   If (w (e) - wflg) becomes
C       zero, then the element e will be absorbed in scan 2.
C       -------------------------------------------------------------
        DO 150 pme = pme1, pme2
          i = iw(pme)
          eln = elen(i)
          IF (eln .GT. 0) THEN
C           note that nv (i) has been negated to denote i in Lme:
            nvi = -nv(i)
            wnvi = wflg - nvi
            DO 140 p = pe(i), pe(i) + int(eln - 1,8)
              e = iw(p)
              we = w(e)
              IF (we .GE. wflg) THEN
C               unabsorbed element e has been seen in this loop
                we = we - nvi
              ELSE IF (we .NE. 0) THEN
C               e is an unabsorbed element
C               this is the first we have seen e in all of Scan 1
                we = degree(e) + wnvi
              ENDIF
              w(e) = we
  140       CONTINUE
          ENDIF
  150   CONTINUE
C=======================================================================
C  DEGREE UPDATE AND ELEMENT ABSORPTION
C=======================================================================
C       -------------------------------------------------------------
C       Scan 2:  for each i in Lme, sum up the degree of Lme (which
C       is degme), plus the sum of the external degrees of each Le
C       for the elements e appearing within i, plus the
C       supervariables in i.  Place i in hash list.
C       -------------------------------------------------------------
        DO 180 pme = pme1, pme2
          i = iw(pme)
          p1 = pe(i)
          p2 = p1 + elen(i) - 1
          pn = p1
          hash = 0_8
          deg = 0
C         ----------------------------------------------------------
C         scan the element list associated with supervariable i
C         ----------------------------------------------------------
          DO 160 p = p1, p2
            e = iw(p)
C           dext = | Le \ Lme |
            dext = w(e) - wflg
            IF (dext .GT. 0) THEN
              deg = deg + dext
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e,kind=8)
            ELSE IF (dext .EQ. 0) THEN
#if defined (NOAGG3)
              iw(pn) = e
              pn = pn + 1
              hash = hash + e
#else
C             aggressive absorption: e is not adjacent to me, but
C             the |Le \ Lme| is 0, so absorb it into me
              pe(e) = int(-me,8)
              w(e) = 0
#endif
            ENDIF
  160     CONTINUE
C         count the number of elements in i (including me):
          elen(i) = int(pn - p1 + 1_8)
C         ----------------------------------------------------------
C         scan the supervariables in the list associated with i
C         ----------------------------------------------------------
          p3 = pn
          DO 170 p = p2 + 1, p1 + int(len(i) - 1,8)
            j = iw(p)
            nvj = nv(j)
            IF (nvj .GT. 0) THEN
C             j is unabsorbed, and not in Lme.
C             add to degree and add to new list
              deg = deg + nvj
              iw(pn) = j
              pn = pn + 1
              hash = hash + int(j,kind=8)
            ENDIF
  170     CONTINUE
C begin HALO
          IF (degree(i).EQ.n+1) deg = n+1
C end HALO
C         ----------------------------------------------------------
C         update the degree and check for mass elimination
C         ----------------------------------------------------------
#if defined (NOAGG3)
          IF (elen(i).EQ.1 .AND. p3.EQ.pn) THEN
#else
          IF (deg .EQ. 0) THEN
#endif
C           -------------------------------------------------------
C           mass elimination
C           -------------------------------------------------------
C           There is nothing left of this node except for an
C           edge to the current pivot element.  elen (i) is 1,
C           and there are no variables adjacent to node i.
C           Absorb i into the current pivot element, me.
            pe(i) = int(-me,8)
            nvi = -nv(i)
            degme = degme - nvi
            nvpiv = nvpiv + nvi
            nel = nel + nvi
            nv(i) = 0
            elen(i) = 0
          ELSE
C           -------------------------------------------------------
C           update the upper-bound degree of i
C           -------------------------------------------------------
C           the following degree does not yet include the size
C           of the current element, which is added later:
C begin HALO V6
            IF (degree(i).NE.n+1) THEN
C                I does not belong to halo
                 deg        = min(deg, nleft)
                 degree(i) = min(degree(i), deg)
            ENDIF
C end HALO V6
C           -------------------------------------------------------
C           add me to the list for i
C           -------------------------------------------------------
C           move first supervariable to end of list
            iw(pn) = iw(p3)
C           move first element to end of element part of list
            iw(p3) = iw(p1)
C           add new element to front of list.
            iw(p1) = me
C           store the new length of the list in len (i)
            len(i) = int(pn - p1 + 1)
C begin HALO
            IF (deg.LE.n) THEN
C end HALO
C           -------------------------------------------------------
C           place in hash bucket.  Save hash key of i in last (i).
C           -------------------------------------------------------
            hash = mod(hash, hmod) + 1_8
            j = head(hash)
            IF (j .LE. 0) THEN
C             the degree list is empty, hash head is -j
              next(i) = -j
              head(hash) = -i
            ELSE
C             degree list is not empty
C             use last (head (hash)) as hash head
              next(i) = last(j)
              last(j) = i
            ENDIF
            last(i) = int(hash, kind=kind(last))
C begin HALO
            ENDIF
C end HALO
          ENDIF
  180   CONTINUE
        degree(me) = degme
C       -------------------------------------------------------------
C       Clear the counter array, w (...), by incrementing wflg.
C       -------------------------------------------------------------
        dmax = max(dmax, degme)
        wflg = wflg + dmax
C       make sure that wflg+n does not cause integer overflow
        IF (wflg .GT. maxint_n) THEN
          DO 190 x = 1, n
            IF (w(x) .NE. 0) w (x) = 1
  190     CONTINUE
          wflg = 2
        ENDIF
C       at this point, w (1..n) .lt. wflg holds
C=======================================================================
C  SUPERVARIABLE DETECTION
C=======================================================================
        DO 250 pme = pme1, pme2
          i = iw(pme)
C begin HALO
C old AMD          IF (NV (I) .LT. 0) THEN
          IF ( (nv(i) .LT. 0) .AND. (degree(i) .LE. n) ) THEN
C end HALO
C           i is a principal variable in Lme
C           -------------------------------------------------------
C           examine all hash buckets with 2 or more variables.  We
C           do this by examing all unique hash keys for super-
C           variables in the pattern Lme of the current element, me
C           -------------------------------------------------------
            hash = int(last(i),kind=8)
C           let i = head of hash bucket, and empty the hash bucket
            j = head(hash)
            IF (j .EQ. 0) GO TO 250
            IF (j .LT. 0) THEN
C             degree list is empty
              i = -j
              head(hash) = 0
            ELSE
C             degree list is not empty, restore last () of head
              i = last(j)
              last(j) = 0
            ENDIF
            IF (i .EQ. 0) GO TO 250
C           while loop:
  200       CONTINUE
            IF (next(i) .NE. 0) THEN
C             ----------------------------------------------------
C             this bucket has one or more variables following i.
C             scan all of them to see if i can absorb any entries
C             that follow i in hash bucket.  Scatter i into w.
C             ----------------------------------------------------
              ln = len(i)
              eln = elen(i)
C             do not flag the first element in the list (me)
              DO 210 p = pe(i) + 1, pe(i) + ln - 1
                w(iw(p)) = wflg
  210         CONTINUE
C             ----------------------------------------------------
C             scan every other entry j following i in bucket
C             ----------------------------------------------------
              jlast = i
              j = next(i)
C             while loop:
  220         CONTINUE
              IF (j .NE. 0) THEN
C               -------------------------------------------------
C               check if j and i have identical nonzero pattern
C               -------------------------------------------------
C               jump if i and j do not have same size data structure
                IF (len(j) .NE. ln) GO TO 240
C               jump if i and j do not have same number adj elts
                IF (elen(j) .NE. eln) GO TO 240
C               do not flag the first element in the list (me)
                DO 230 p = pe(j) + 1, pe(j) + ln - 1
C                 jump if an entry (iw(p)) is in j but not in i
                  IF (w(iw(p)) .NE. wflg) GO TO 240
  230           CONTINUE
C               -------------------------------------------------
C               found it!  j can be absorbed into i
C               -------------------------------------------------
                pe(j) = int(-i,8)
C               both nv (i) and nv (j) are negated since they
C               are in Lme, and the absolute values of each
C               are the number of variables in i and j:
                nv(i) = nv(i) + nv(j)
                nv(j) = 0
                elen(j) = 0
C               delete j from hash bucket
                j = next(j)
                next(jlast) = j
                GO TO 220
C               -------------------------------------------------
  240           CONTINUE
C               j cannot be absorbed into i
C               -------------------------------------------------
                jlast = j
                j = next(j)
              GO TO 220
              ENDIF
C             ----------------------------------------------------
C             no more variables can be absorbed into i
C             go to next i in bucket and clear flag array
C             ----------------------------------------------------
              wflg = wflg + 1
              i = next(i)
              IF (i .NE. 0) GO TO 200
            ENDIF
          ENDIF
  250   CONTINUE
C=======================================================================
C  RESTORE DEGREE LISTS AND REMOVE NONPRINCIPAL SUPERVAR. FROM ELEMENT
C=======================================================================
        p = pme1
        nleft = n - nel
        DO 260 pme = pme1, pme2
          i = iw(pme)
          nvi = -nv(i)
          IF (nvi .GT. 0) THEN
C           i is a principal variable in Lme
C           restore nv (i) to signify that i is principal
            nv(i) = nvi
C begin HALO
            IF (degree(i).LE.n) THEN
C end HALO
C           -------------------------------------------------------
C           compute the external degree (add size of current elem)
C           -------------------------------------------------------
            deg = min(degree(i) + degme - nvi, nleft - nvi)
C           -------------------------------------------------------
C           place the supervariable at the head of the degree list
C           -------------------------------------------------------
            inext = head(deg)
            IF (inext .NE. 0) last(inext) = i
            next(i) = inext
            last(i) = 0
            head(deg) = i
C           -------------------------------------------------------
C           save the new degree, and find the minimum degree
C           -------------------------------------------------------
            mindeg = min(mindeg, deg)
            degree(i) = deg
C begin HALO
              ENDIF
C end HALO
C           -------------------------------------------------------
C           place the supervariable in the element pattern
C           -------------------------------------------------------
            iw(p) = i
            p = p + 1
          ENDIF
  260   CONTINUE
C=======================================================================
C  FINALIZE THE NEW ELEMENT
C=======================================================================
        nv(me) = nvpiv + degme
C       nv (me) is now the degree of pivot (including diagonal part)
C       save the length of the list for the new element me
        len(me) = int(p - pme1)
        IF (len(me) .EQ. 0) THEN
C         there is nothing left of the current pivot element
          pe(me) = 0_8
          w(me) = 0
        ENDIF
        IF (newmem .NE. 0) THEN
C         element was not constructed in place: deallocate part
C         of it (final size is less than or equal to newmem,
C         since newly nonprincipal variables have been removed).
          pfree = p
          mem = mem - newmem + len(me)
        ENDIF
C=======================================================================
C       END WHILE (selecting pivots)
      GO TO 30
      ENDIF
C=======================================================================
C begin HALO V2
      IF (nel.LT.n) THEN 
C
C     All possible pivots (not flagged have been eliminated).
C     We amalgamate all flagged variables at the root and 
C     we finish the elimination tree.
C          1/ Go through all
C          non absorbed elements (root of the subgraph)
C          and absorb in ME
C          2/ perform mass elimination of all dense rows
           DO deg = mindeg, n
             me = head(deg)
             IF (me .GT. 0) GO TO 51
           ENDDO
   51      mindeg = deg
C
           IF (me.NE.listvar_schur(1)) THEN
             write(6,*) ' ERROR 2 in MUMPS_HAMD '
             write(6,*) ' wrong principal var for Schur !!'
             ncmpa = -n - 2
             CALL mumps_abort()
           ENDIF
C
           nelme    = -(nel+1)
           DO x=1,n
            IF ((pe(x).GT.0) .AND. (elen(x).LT.0)) THEN
C            X is an unabsorbed element
             pe(x) = int(-me,8)
C            W(X) = 0 could be suppressed ?? check it
            ELSEIF (degree(x).EQ.n+1) THEN
C            X is a dense row, absorb it in ME (mass elimination)
             nel   = nel + nv(x)
             pe(x) = int(-me,8)
             elen(x) = 0
C            Correct value of NV is (secondary variable)
             nv(x) = 0
            ENDIF
           ENDDO
C          ME is the root node
           elen(me) = nelme
C          Correct value of NV is (principal variable)
           nv(me)   = n-nreal
           pe(me)   = 0
C end HALO V2
C
C begin HALO
           IF (nel.NE.n) THEN
         write(*,*) ' ERROR 2 in MUMPS_HAMD NEL, N=', nel,n
         ncmpa = -n - 1
        ENDIF
      ENDIF
C end HALO
C=======================================================================
C  COMPUTE THE PERMUTATION VECTORS
C=======================================================================
C     ----------------------------------------------------------------
C     The time taken by the following code is O(n).  At this
C     point, elen (e) = -k has been done for all elements e,
C     and elen (i) = 0 has been done for all nonprincipal
C     variables i.  At this point, there are no principal
C     supervariables left, and all elements are absorbed.
C     ----------------------------------------------------------------
C     ----------------------------------------------------------------
C     compute the ordering of unordered nonprincipal variables
C     ----------------------------------------------------------------
      DO 290 i = 1, n
        IF (elen(i) .EQ. 0) THEN
C         ----------------------------------------------------------
C         i is an un-ordered row.  Traverse the tree from i until
C         reaching an element, e.  The element, e, was the
C         principal supervariable of i and all nodes in the path
C         from i to when e was selected as pivot.
C         ----------------------------------------------------------
          j = int(-pe(i))
C         while (j is a variable) do:
  270     CONTINUE
            IF (elen(j) .GE. 0) THEN
              j = int(-pe(j))
              GO TO 270
            ENDIF
            e = j
C           ----------------------------------------------------------
C           get the current pivot ordering of e
C           ----------------------------------------------------------
            k = -elen(e)
C           ----------------------------------------------------------
C           traverse the path again from i to e, and compress the
C           path (all nodes point to e).  Path compression allows
C           this code to compute in O(n) time.  Order the unordered
C           nodes in the path, and place the element e at the end.
C           ----------------------------------------------------------
            j = i
C           while (j is a variable) do:
  280       CONTINUE
            IF (elen(j) .GE. 0) THEN
              jnext = int(-pe(j))
              pe(j) = int(-e,8)
              IF (elen(j) .EQ. 0) THEN
C               j is an unordered row
                elen(j) = k
                k = k + 1
              ENDIF
              j = jnext
            GO TO 280
            ENDIF
C         leave elen (e) negative, so we know it is an element
          elen(e) = -k
        ENDIF
  290 CONTINUE
C     ----------------------------------------------------------------
C     reset the inverse permutation (elen (1..n)) to be positive,
C     and compute the permutation (last (1..n)).
C     ----------------------------------------------------------------
      DO 300 i = 1, n
        k = abs(elen(i))
        last(k) = i
        elen(i) = k
  300 CONTINUE
C=======================================================================
C  RETURN THE MEMORY USAGE IN IW
C=======================================================================
C     If maxmem is less than or equal to iwlen, then no compressions
C     occurred, and iw (maxmem+1 ... iwlen) was unused.  Otherwise
C     compressions did occur, and iwlen would have had to have been
C     greater than or equal to maxmem for no compressions to occur.
C     Return the value of maxmem in the pfree argument.
 500  pfree = maxmem
C===============================
C     Save IPE in PARENT array
      DO i=1,n
       parent(i) = int(pe(i))
      ENDDO
C===============================
      RETURN

mumps_hamf4()

subroutine mumps_hamf4	(	integer, intent(in)	norig,
		integer, intent(in)	n,
		logical, intent(in)	compute_perm,
		integer, intent(in)	nbbuck,
		integer(8), intent(in)	iwlen,
		integer(8), dimension(n), intent(inout)	pe,
		integer(8), intent(inout)	pfree,
		integer, dimension(n), intent(inout)	len,
		integer, dimension(iwlen), intent(inout)	iw,
		integer, dimension(n), intent(inout)	nv,
		integer, dimension(n), intent(out)	elen,
		integer, dimension(n), intent(out)	last,
		integer, intent(out)	ncmpa,
		integer, dimension(n)	degree,
		integer, dimension(n)	wf,
		integer, dimension(n)	next,
		integer, dimension(n)	w,
		integer, dimension(0:nbbuck+1)	head,
		integer, dimension(n), intent(out)	parent )

Definition at line 3722 of file ana_orderings.F.

      IMPLICIT NONE
C
C Parameters
C    Input not modified
C    N : number of nodes in the complete graph including halo
C    NORIG :
C       if compressed graph (nv(1).ne-1) then
C         NORIG is the sum(nv(i)) for i \in [1:N]
C       else NORIG = N 
      INTEGER, INTENT(IN)    :: NORIG, N, NBBUCK
      LOGICAL, INTENT(IN)     :: COMPUTE_PERM
      INTEGER(8), INTENT(IN) :: IWLEN
C     Input undefined on output 
      INTEGER, INTENT(INOUT)  :: LEN(N), IW(IWLEN)
C     NV also meaningful as input to encode compressed graphs
      INTEGER, INTENT(INOUT)  :: NV(N)
C 
C     Output only 
      INTEGER, INTENT(OUT)   :: NCMPA
      INTEGER, INTENT(OUT)   :: ELEN(N), LAST(N)
      INTEGER, INTENT(OUT)   :: PARENT(N)
C 
C     Input/output
      INTEGER(8), INTENT(INOUT) :: PFREE
      INTEGER(8), INTENT(INOUT) :: PE(N)
C 
C     Internal Workspace only
C       Min fill approximation one extra array of size NBBUCK+2 
C       is also needed
      INTEGER     :: NEXT(N), DEGREE(N), W(N)
      INTEGER     :: HEAD(0:NBBUCK+1), WF(N)
C
C  Comments on the OUTPUT:
C  ----------------------
C  Let V= V0 U V1 the nodes of the initial graph (|V|=n). 
C  The assembly tree corresponds to the tree 
C    of the supernodes (or supervariables). Each node of the 
C    assembly tree is then composed of one principal variable 
C    and a list of secondary variables. The list of 
C    variable of a node (principal + secondary variables) then 
C    describes the structure of the diagonal bloc of the 
C    supernode. 
C  The elimination tree denotes the tree of all the variables(=node) and 
C    is therefore of order n.
C
C  The arrays NV(N) and PE(N) give a description of the 
C  assembly tree. 
C  Note that on output 
C   INTEGER(8) PE array is copied on output into
C   INTEGER PARENT array
C  
C   1/ Description of array nv(N) (on OUTPUT)
C    nv(i)=0 i is a secondary variable 
C    nv(i) >0 i is a principal variable, nv(i) holds the 
C                  the number of elements in column i of L (true degree of i)
C    With compressed graph (nv(1).ne.-1 on input), 
C    nv(i) can be greater than N since degree can be as large as NORIG
C
C   2/ Description of array PE(N) (on OUTPUT)
C       Note that on 
C       pe(i) = -(father of variable/node i) in the elimination tree:
C       If nv (i) .gt. 0, then i represents a node in the assembly tree,
C       and the parent of i is -pe (i), or zero if i is a root.
C       If nv (i) = 0, then (i,-pe (i)) represents an edge in a
C       subtree, the root of which is a node in the assembly tree.
C   
C   3/ Example:
C      Let If be a root node father of Is in the assembly tree. 
C      If is the principal 
C      variable of the node If and let If1, If2, If3 be the secondary variables
C      of node If.
C      Is is the principal 
C      variable of the node Is and let Is1, Is2 be the secondary variables
C      of node Is.
C      
C      THEN: 
C        NV(If1)=NV(If2)=NV(If3) = 0  (secondary variables)
C        NV(Is1)=NV(Is2) = 0  (secondary variables)
C        NV(If) > 0  ( principal variable)
C        NV(Is) > 0  ( principal variable)
C        PE(If)  = 0 (root node)
C        PE(Is)  = -If (If is the father of Is in the assembly tree)
C        PE(If1)=PE(If2)=PE(If3)= -If  ( If is the principal variable)
C        PE(Is1)=PE(Is2)= -Is  ( Is is the principal variable)
C      
C
C
C HALOAMD_V1: (September 1997)
C **********
C Initial version designed to experiment the numerical (fill-in) impact 
C of taking into account the halo. This code should be able 
C to experiment no-halo, partial halo, complete halo.
C DATE: September 17th 1997
C
C HALOAMD is designed to process a gragh composed of two types
C            of nodes, V0 and V1, extracted from a larger gragh. 
C            V0^V1 = {}, 
C       
C            We used Min. degree heuristic to order only 
C            nodes in V0, but the adjacency to nodes
C            in V1 is taken into account during ordering.
C            Nodes in V1 are odered at last.
C            Adjacency between nodes of V1 need not be provided,
C            however |len(i)| must always corresponds to the number of 
C            edges effectively provided in the adjacency list of i.
C          On input :
c          ********
C            Nodes INODE in V1 are flagged with len(INODE) = -degree 
C                           if len(i) =0 and i \in V1 then 
C                           len(i) must be set on input to -NORIG-1
C          ERROR return (negative values in ncmpa)
C          ************
C            negative value in ncmpa indicates an error detected 
C               by HALOAMD.
C
C            The graph provided MUST follow the rule:
C             if (i,j) is an edge in the gragh then 
C             j must be in the adjacency list of i AND 
C             i must be in the adjacency list of j.
C    REMARKS
C    -------
C        
C        1/  Providing edges between nodes of V1 should not 
C            affect the final ordering, only the amount of edges 
C            of the halo should effectively affect the solution.
C            This code should work in the following cases:
C              1/ halo not provided
C              2/ halo partially provided
C              3/ complete halo
C              4/ complete halo+interconnection between nodes of V1.
C
C              1/ should run and provide identical results (w.r.t to current 
C               implementation of AMD in SCOTCH).
C             3/ and 4 should provide identical results.
C
C        2/ All modifications of the AMD initial code are indicated
C           with begin HALO .. end HALO
C
C            
C   Given a representation of the nonzero pattern of a symmetric matrix,
C       A, (excluding the diagonal) perform an approximate minimum
C       fill-in heuristic. Aggresive absorption is
C       used to tighten the bound on the degree.  This can result an
C       significant improvement in the quality of the ordering for
C       some matrices.
C-----------------------------------------------------------------------
C INPUT ARGUMENTS (unaltered):
C-----------------------------------------------------------------------
C n:    The matrix order.
C       Restriction:  n .ge. 1
C compute_perm : indicates if permutations should be computed 
C         on output in last/elen 
C iwlen:        The length of iw (1..iwlen).  On input, the matrix is
C       stored in iw (1..pfree-1).  However, iw (1..iwlen) should be
C       slightly larger than what is required to hold the matrix, at
C       least iwlen .ge. pfree + n is recommended.  Otherwise,
C       excessive compressions will take place.
C       *** We do not recommend running this algorithm with ***
C       ***      iwlen .lt. pfree + n.                      ***
C       *** Better performance will be obtained if          ***
C       ***      iwlen .ge. pfree + n                       ***
C       *** or better yet                                   ***
C       ***      iwlen .gt. 1.2 * pfree                     ***
C       *** (where pfree is its value on input).            ***
C       The algorithm will not run at all if iwlen .lt. pfree-1.
C
C       Restriction: iwlen .ge. pfree-1
C-----------------------------------------------------------------------
C INPUT/OUPUT ARGUMENTS:
C-----------------------------------------------------------------------
C pe:   On input, pe (i) is the index in iw of the start of row i, or
C       zero if row i has no off-diagonal non-zeros.
C
C       During execution, it is used for both supervariables and
C       elements:
C
C       * Principal supervariable i:  index into iw of the
C               description of supervariable i.  A supervariable
C               represents one or more rows of the matrix
C               with identical nonzero pattern.
C       * Non-principal supervariable i:  if i has been absorbed
C               into another supervariable j, then pe (i) = -j.
C               That is, j has the same pattern as i.
C               Note that j might later be absorbed into another
C               supervariable j2, in which case pe (i) is still -j,
C               and pe (j) = -j2.
C       * Unabsorbed element e:  the index into iw of the description
C               of element e, if e has not yet been absorbed by a
C               subsequent element.  Element e is created when
C               the supervariable of the same name is selected as
C               the pivot.
C       * Absorbed element e:  if element e is absorbed into element
C               e2, then pe (e) = -e2.  This occurs when the pattern of
C               e (that is, Le) is found to be a subset of the pattern
C               of e2 (that is, Le2).  If element e is "null" (it has
C               no nonzeros outside its pivot block), then pe (e) = 0.
C
C       On output, pe holds the assembly tree/forest, which implicitly
C       represents a pivot order with identical fill-in as the actual
C       order (via a depth-first search of the tree).
C
C       On output:
C       If nv (i) .gt. 0, then i represents a node in the assembly tree,
C       and the parent of i is -pe (i), or zero if i is a root.
C       If nv (i) = 0, then (i,-pe (i)) represents an edge in a
C       subtree, the root of which is a node in the assembly tree.
C       On output:  (PE is copied on output into PARENT array)
C
C pfree:        On input, the matrix is stored in iw (1..pfree-1) and
C       the rest of the array iw is free.
C       During execution, additional data is placed in iw, and pfree
C       is modified so that components  of iw from pfree are free.
C       On output, pfree is set equal to the size of iw that
C       would have been needed for no compressions to occur.  If
C       ncmpa is zero, then pfree (on output) is less than or equal to
C       iwlen, and the space iw (pfree+1 ... iwlen) was not used.
C       Otherwise, pfree (on output) is greater than iwlen, and all the
C       memory in iw was used.
C
C nv:   On input, encoding of compressed graph:
C        if NV(1) = -1 then graph is not compressed otherwise
C        NV(I) holds the weight of node I. 
C       During execution, abs (nv (i)) is equal to the number of rows
C       that are represented by the principal supervariable i.  If i is
C       a nonprincipal variable, then nv (i) = 0.  Initially,
C       nv (i) = 1 for all i.  nv (i) .lt. 0 signifies that i is a
C       principal variable in the pattern Lme of the current pivot
C       element me.  On output, nv (e) holds the true degree of element
C       e at the time it was created (including the diagonal part).
C begin HALO
C       On output, nv(I) can be used to find node in set V1.
C       Not true anymore : ( nv(I) = N+1 characterizes nodes in V1
C                 instead nodes in V1 are considered as a dense root node )
C end HALO
C-----------------------------------------------------------------------
C INPUT/MODIFIED (undefined on output):
C-----------------------------------------------------------------------
C len:  On input, len (i) 
C           positive or null (>=0) : i \in V0 and 
C                     len(i) holds the number of entries in row i of the
C                     matrix, excluding the diagonal.  
C           negative (<0) : i \in V1, and 
C                     -len(i) hold the number of entries in row i of the
C                     matrix, excluding the diagonal.
C       The contents of len (1..n)
C       are undefined on output.
C iw:   On input, iw (1..pfree-1) holds the description of each row i
C       in the matrix.  The matrix must be symmetric, and both upper
C       and lower triangular parts must be present.  The diagonal must
C       not be present.  Row i is held as follows:
C
C               len (i):  the length of the row i data structure
C               iw (pe (i) ... pe (i) + len (i) - 1):
C                       the list of column indices for nonzeros
C                       in row i (simple supervariables), excluding
C                       the diagonal.  All supervariables start with
C                       one row/column each (supervariable i is just
C                       row i).
C               if len (i) is zero on input, then pe (i) is ignored
C               on input.
C
C               Note that the rows need not be in any particular order,
C               and there may be empty space between the rows.
C
C       During execution, the supervariable i experiences fill-in.
C       This is represented by placing in i a list of the elements
C       that cause fill-in in supervariable i:
C
C               len (i):  the length of supervariable i
C               iw (pe (i) ... pe (i) + elen (i) - 1):
C                       the list of elements that contain i.  This list
C                       is kept short by removing absorbed elements.
C               iw (pe (i) + elen (i) ... pe (i) + len (i) - 1):
C                       the list of supervariables in i.  This list
C                       is kept short by removing nonprincipal
C                       variables, and any entry j that is also
C                       contained in at least one of the elements
C                       (j in Le) in the list for i (e in row i).
C
C       When supervariable i is selected as pivot, we create an
C       element e of the same name (e=i):
C
C               len (e):  the length of element e
C               iw (pe (e) ... pe (e) + len (e) - 1):
C                       the list of supervariables in element e.
C
C       An element represents the fill-in that occurs when supervariable
C       i is selected as pivot (which represents the selection of row i
C       and all non-principal variables whose principal variable is i).
C       We use the term Le to denote the set of all supervariables
C       in element e.  Absorbed supervariables and elements are pruned
C       from these lists when computationally convenient.
C
C       CAUTION:  THE INPUT MATRIX IS OVERWRITTEN DURING COMPUTATION.
C       The contents of iw are undefined on output.
C
C-----------------------------------------------------------------------
C OUTPUT (need not be set on input):
C-----------------------------------------------------------------------
C elen: See the description of iw above.  At the start of execution,
C       elen (i) is set to zero.  During execution, elen (i) is the
C       number of elements in the list for supervariable i.  When e
C       becomes an element, elen (e) = -nel is set, where nel is the
C       current step of factorization.  elen (i) = 0 is done when i
C       becomes nonprincipal.
C
C       For variables, elen (i) .ge. 0 holds 
C       until just before the permutation vectors are computed.  
C       For elements, elen (e) .lt. 0 holds.
C
C       On output elen (1..n) holds the inverse permutation (the same
C       as the 'INVP' argument in Sparspak).  That is, if k = elen (i),
C       then row i is the kth pivot row.  Row i of A appears as the
C       (elen(i))-th row in the permuted matrix, PAP^T.
C last: In a degree list, last (i) is the supervariable preceding i,
C       or zero if i is the head of the list.  In a hash bucket,
C       last (i) is the hash key for i.  last (head (hash)) is also
C       used as the head of a hash bucket if head (hash) contains a
C       degree list (see head, below).
C
C       On output, last (1..n) holds the permutation (the same as the
C       'PERM' argument in Sparspak).  That is, if i = last (k), then
C       row i is the kth pivot row.  Row last (k) of A is the k-th row
C       in the permuted matrix, PAP^T.
C ncmpa:        The number of times iw was compressed.  If this is
C       excessive, then the execution took longer than what could have
C       been.  To reduce ncmpa, try increasing iwlen to be 10% or 20%
C       larger than the value of pfree on input (or at least
C       iwlen .ge. pfree + n).  The fastest performance will be
C       obtained when ncmpa is returned as zero.  If iwlen is set to
C       the value returned by pfree on *output*, then no compressions
C       will occur.
C begin HALO
C        on output ncmpa <0 --> error detected during HALO_AMD:
C           error 1: ncmpa = -N , ordering was stopped.
C end HALO
C
C-----------------------------------------------------------------------
C LOCAL (not input or output - used only during execution):
C-----------------------------------------------------------------------
C degree:       If i is a supervariable, then degree (i) holds the
C       current approximation of the external degree of row i (an upper
C       bound).  The external degree is the number of nonzeros in row i,
C       minus abs (nv (i)) (the diagonal part).  The bound is equal to
C       the external degree if elen (i) is less than or equal to two.
C       We also use the term "external degree" for elements e to refer
C       to |Le \ Lme|.  If e is an element, then degree (e) holds |Le|,
C       which is the degree of the off-diagonal part of the element e
C       (not including the diagonal part).
C begin HALO
C       while processing variables degree(I) =   -NBBUCK-1 (=N2) 
C                                  indicates that i belongs to V1
C end HALO
C
C head: head is used for degree lists.  head (deg) is the first
C       supervariable in a degree list (all supervariables i in a
C       degree list deg have the same approximate degree, namely,
C       deg = degree (i)).  If the list deg is empty then
C       head (deg) = 0.
C
C       During supervariable detection head (hash) also serves as a
C       pointer to a hash bucket.
C       If head (hash) .gt. 0, there is a degree list of degree hash.
C               The hash bucket head pointer is last (head (hash)).
C       If head (hash) = 0, then the degree list and hash bucket are
C               both empty.
C       If head (hash) .lt. 0, then the degree list is empty, and
C               -head (hash) is the head of the hash bucket.
C       After supervariable detection is complete, all hash buckets
C       are empty, and the (last (head (hash)) = 0) condition is
C       restored for the non-empty degree lists.
C next: next (i) is the supervariable following i in a link list, or
C       zero if i is the last in the list.  Used for two kinds of
C       lists:  degree lists and hash buckets (a supervariable can be
C       in only one kind of list at a time).
C w:    The flag array w determines the status of elements and
C       variables, and the external degree of elements.
C
C       for elements:
C          if w (e) = 0, then the element e is absorbed
C          if w (e) .ge. wflg, then w (e) - wflg is the size of
C               the set |Le \ Lme|, in terms of nonzeros (the
C               sum of abs (nv (i)) for each principal variable i that
C               is both in the pattern of element e and NOT in the
C               pattern of the current pivot element, me).
C          if wflg .gt. w (e) .gt. 0, then e is not absorbed and has
C               not yet been seen in the scan of the element lists in
C               the computation of |Le\Lme| in loop 150 below.
C
C       for variables:
C          during supervariable detection, if w (j) .ne. wflg then j is
C          not in the pattern of variable i
C
C       The w array is initialized by setting w (i) = 1 for all i,
C       and by setting wflg = 2.  It is reinitialized if wflg becomes
C       too large (to ensure that wflg+n does not cause integer
C       overflow).
C
C wf : integer array  used to store the already filled area of 
C      the variables adajcent to current pivot. 
C      wf is then used to update the score of variable i.
C
C-----------------------------------------------------------------------
C LOCAL INTEGERS:
C-----------------------------------------------------------------------
      INTEGER :: DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I,
     &        ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3,
     &        LENJ, LN, ME, MINDEG, NEL,
     &        NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X,
     &        NBFLAG, LASTD, NELME, WF3, WF4, N2, PAS
      INTEGER :: NLEFT_V1
       INTEGER KNT1_UPDATED, KNT2_UPDATED
       INTEGER(8) :: MAXMEM, MEM, NEWMEM
       INTEGER    :: MAXINT_N
       INTEGER(8) :: HASH, HMOD
       DOUBLE PRECISION RMF, RMF1 
       DOUBLE PRECISION dummy
       INTEGER idummy
C deg:        the degree of a variable or element
C degme:      size, |Lme|, of the current element, me (= degree (me))
C dext:       external degree, |Le \ Lme|, of some element e
C dmax:       largest |Le| seen so far
C e:          an element
C elenme:     the length, elen (me), of element list of pivotal var.
C eln:        the length, elen (...), of an element list
C hash:       the computed value of the hash function
C hmod:       the hash function is computed modulo hmod = max (1,n-1)
C i:          a supervariable
C ilast:      the entry in a link list preceding i
C inext:      the entry in a link list following i
C j:          a supervariable
C jlast:      the entry in a link list preceding j
C jnext:      the entry in a link list, or path, following j
C k:          the pivot order of an element or variable
C knt1:       loop counter used during element construction
C knt2:       loop counter used during element construction
C knt3:       loop counter used during compression
C lenj:       len (j)
C ln:         length of a supervariable list
C maxint_n:   large integer to test risk of overflow on wflg
C maxmem:     amount of memory needed for no compressions
C me:         current supervariable being eliminated, and the
C                     current element created by eliminating that
C                     supervariable
C mem:        memory in use assuming no compressions have occurred
C mindeg:     current minimum degree
C nel:        number of pivots selected so far
C newmem:     amount of new memory needed for current pivot element
C nleft:      n - nel, the number of nonpivotal rows/columns remaining
C nvi:        the number of variables in a supervariable i (= nv (i))
C nvj:        the number of variables in a supervariable j (= nv (j))
C nvpiv:      number of pivots in current element
C slenme:     number of variables in variable list of pivotal variable
C we:         w (e)
C wflg:       used for flagging the w array.  See description of iw.
C wnvi:       wflg - nv (i)
C x:          either a supervariable or an element
C wf3:  off diagoanl block area
C wf4:  diagonal block area
C mf : Minimum fill
C begin HALO
C nbflag:     number of flagged entries in the initial gragh.
C nreal :     number of entries on which ordering must be perfomed
C             (nreel = N- nbflag)
C nelme number of pivots selected when reaching the root
C lastd index of the last row in the list of dense rows
C end HALO
C-----------------------------------------------------------------------
C LOCAL POINTERS:
C-----------------------------------------------------------------------
      INTEGER(8) :: P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, 
     &              PN, PSRC
C             Any parameter (pe (...) or pfree) or local variable
C             starting with "p" (for Pointer) is an index into iw,
C             and all indices into iw use variables starting with
C             "p."  The only exception to this rule is the iwlen
C             input argument.
C p:          pointer into lots of things
C p1:         pe (i) for some variable i (start of element list)
C p2:         pe (i) + elen (i) -  1 for some var. i (end of el. list)
C p3:         index of first supervariable in clean list
C pdst:       destination pointer, for compression
C pend:       end of memory to compress
C pj:         pointer into an element or variable
C pme:        pointer into the current element (pme1...pme2)
C pme1:       the current element, me, is stored in iw (pme1...pme2)
C pme2:       the end of the current element
C pn:         pointer into a "clean" variable, also used to compress
C psrc:       source pointer, for compression
C-----------------------------------------------------------------------
C  FUNCTIONS CALLED:
C-----------------------------------------------------------------------
      INTRINSIC max, min, mod, huge
      INTEGER TOTEL
      LOGICAL COMPRESS
C=======================================================================
C  INITIALIZATIONS
C=======================================================================
C     HEAD (0:NBBUCK+1)
C
C idummy holds the largest integer - 1
C dummy  = dble (idummy)
      idummy = huge(idummy) - 1
      dummy = dble(idummy)
C     variable with degree equal to N2 are in halo
C     bucket NBBUCK+1 used for HALO variables
      n2 = -nbbuck-1
C Distance betweeen elements of the N, ..., NBBUCK entries of HEAD
C
      pas = max((n/8), 1)
      wflg = 2
      maxint_n=huge(wflg)-n
      ncmpa = 0
      nel = 0
      hmod = int(max(1, nbbuck-1),kind=8)
      dmax = 0
      mem = pfree - 1
      maxmem = mem
      mindeg = 0
      nleft_v1 = 0
C
      nbflag = 0
      lastd  = 0
      head(0:nbbuck+1) = 0
      DO 10 i = 1, n
        last(i) = 0
C        NV(I) = 1
        w(i) = 1
        elen(i) = 0
   10 CONTINUE
      IF(nv(1) .LT. 0) THEN
         compress = .false.
      ELSE
         compress = .true.
      ENDIF
      IF(compress) THEN
         totel = 0
         DO i=1,n
            IF (len(i).LT.0) THEN 
               degree(i) = n2
               nbflag     = nbflag +1
               nleft_v1   = nleft_v1 + nv(i)
               IF (len(i).EQ.-norig-1) THEN
C     variable in V1 with empty adj list 
                  len(i)    = 0
C     Because of compress, we force skipping this
C     entry which is anyway empty
                  pe(i)     = 0_8
               ELSE
                  len(i)    = - len(i)
               ENDIF
C       end HALO V3
            ELSE
               totel = totel + nv(i)
               degree(i) = 0
               DO p= pe(i) , pe(i)+int(len(i)-1,8)
                  degree(i) = degree(i) + nv(iw(p))
               ENDDO
C     DEGREE (I) = LEN (I)
            ENDIF
         ENDDO
      ELSE
         DO i=1,n
            nv(i) = 1
            IF (len(i).LT.0) THEN 
               degree(i) = n2
               nbflag     = nbflag +1
               nleft_v1   = nleft_v1 + nv(i)
               IF (len(i).EQ.-n-1) THEN
                  len(i)    = 0
C     Because of compress, we force skipping this
C     entry which is anyway empty
                  pe(i)     = 0_8
               ELSE
                  len(i)    = - len(i)
               ENDIF
C     end HALO V3
            ELSE
               degree(i) = len(i)
            ENDIF
         ENDDO
         totel = n - nbflag
      ENDIF
C
C
C     ----------------------------------------------------------------
C     initialize degree lists and eliminate rows with no off-diag. nz.
C     ----------------------------------------------------------------
      DO 20 i = 1, n
        deg = degree(i)
        IF (deg.EQ.n2) THEN
C            DEG = N2 (flagged variables are stored 
C                  in the degree list of NBBUCK + 1
C                  (safe: because max 
C                         max value of degree is NBBUCK)
C
             deg = nbbuck + 1
             IF (lastd.EQ.0) THEN
C              degree list is empty
               lastd     = i
               head(deg) = i
               next(i)   = 0
               last(i)   = 0
             ELSE
               next(lastd) = i
               last(i)     = lastd
               lastd       = i
               next(i)     = 0
             ENDIF
         GOTO 20
        ENDIF
C
C
        IF (deg .GT. 0) THEN
          wf(i) = deg
C   version 1
           IF (deg.GT.norig) THEN
            deg = min(((deg-norig)/pas) + norig, nbbuck)
           ENDIF
C           Note that if deg=0 then 
C           No fill-in will occur, 
C           but one variable is adjacent to I
C          ----------------------------------------------------------
C          place i in the degree list corresponding to its degree
C          ----------------------------------------------------------
           inext = head(deg)
           IF (inext .NE. 0) last(inext) = i
           next(i) = inext
           head(deg) = i
        ELSE
C         ----------------------------------------------------------
C         we have a variable that can be eliminated at once because
C         there is no off-diagonal non-zero in its row.
C         ----------------------------------------------------------
          nel = nel + nv(i)
          elen(i) = -nel
          pe(i) = 0_8
          w(i) = 0
        ENDIF
C=======================================================================
C
   20 CONTINUE
C=======================================================================
C  WHILE (selecting pivots) DO
C=======================================================================
      nleft = totel-nel + nleft_v1
C=======================================================================
C =====================================================================
   30 IF (nel .LT. totel) THEN
C =====================================================================
C  GET PIVOT OF MINIMUM DEGREE
C=======================================================================
C       -------------------------------------------------------------
C       find next supervariable for elimination
C       -------------------------------------------------------------
        DO 40 deg = mindeg, nbbuck
          me = head(deg)
          IF (me .GT. 0) GO TO 50
   40   CONTINUE
   50   mindeg = deg
        IF (me.LE.0) THEN
          ncmpa = -n
          CALL mumps_abort()
        ENDIF
       IF (deg.GT.norig) THEN
C        -------------------------------
C        Linear search to find variable 
C        with best score in the list
C        -------------------------------
C        While end of list list not reached
C         NEXT(J) = 0
         j = next(me)
         k = wf(me)
   55    CONTINUE
         IF (j.GT.0) THEN
          IF (wf(j).LT.k) THEN
           me = j
           k  = wf(me)
          ENDIF
          j= next(j)
          GOTO 55
         ENDIF
         ilast = last(me)
         inext = next(me)
         IF (inext .NE. 0) last(inext) = ilast
         IF (ilast .NE. 0) THEN
           next(ilast) = inext
         ELSE
C          me is at the head of the degree list
           head(deg) = inext
         ENDIF
C
        ELSE
C         -------------------------------------------------------------
C         remove chosen variable from link list
C         -------------------------------------------------------------
          inext = next(me)
          IF (inext .NE. 0) last(inext) = 0
          head(deg) = inext
        ENDIF
C       -------------------------------------------------------------
C       me represents the elimination of pivots nel+1 to nel+nv(me).
C       place me itself as the first in this set.  It will be moved
C       to the nel+nv(me) position when the permutation vectors are
C       computed.
C       -------------------------------------------------------------
        elenme = elen(me)
        elen(me) = - (nel + 1)
        nvpiv = nv(me)
        nel = nel + nvpiv
C=======================================================================
C  CONSTRUCT NEW ELEMENT
C=======================================================================
C       -------------------------------------------------------------
C       At this point, me is the pivotal supervariable.  It will be
C       converted into the current element.  Scan list of the
C       pivotal supervariable, me, setting tree pointers and
C       constructing new list of supervariables for the new element,
C       me.  p is a pointer to the current position in the old list.
C       -------------------------------------------------------------
C       flag the variable "me" as being in Lme by negating nv (me)
        nv(me) = -nvpiv
        degme = 0
        IF (elenme .EQ. 0) THEN
C         ----------------------------------------------------------
C         construct the new element in place
C         ----------------------------------------------------------
          pme1 = pe(me)
          pme2 = pme1 - 1
          DO 60 p = pme1, pme1 + len (me) - 1
            i = iw(p)
            nvi = nv(i)
            IF (nvi .GT. 0) THEN
C             ----------------------------------------------------
C             i is a principal variable not yet placed in Lme.
C             store i in new list
C             ----------------------------------------------------
              degme = degme + nvi
C             flag i as being in Lme by negating nv (i)
              nv(i) = -nvi
              pme2 = pme2 + 1
              iw(pme2) = i
              IF (degree(i).NE.n2) THEN
C             ----------------------------------------------------
C             remove variable i from degree list. (only if i \in V0)
C             ----------------------------------------------------
              ilast = last(i)
              inext = next(i)
              IF (inext .NE. 0) last(inext) = ilast
              IF (ilast .NE. 0) THEN
                next(ilast) = inext
              ELSE
C               i is at the head of the degree list
                IF (wf(i).GT.norig) THEN
                 deg = min(((wf(i)-norig)/pas) + norig, nbbuck)
                ELSE
                 deg = wf(i)
                ENDIF
                head(deg) = inext
              ENDIF
              ENDIF
            ENDIF
   60     CONTINUE
C         this element takes no new memory in iw:
          newmem = 0
        ELSE
C         ----------------------------------------------------------
C         construct the new element in empty space, iw (pfree ...)
C         ----------------------------------------------------------
          p = pe(me)
          pme1 = pfree
          slenme = len(me) - elenme
          knt1_updated = 0
          DO 120 knt1 = 1, elenme + 1
            knt1_updated = knt1_updated +1
            IF (knt1 .GT. elenme) THEN
C             search the supervariables in me.
              e = me
              pj = p
              ln = slenme
            ELSE
C             search the elements in me.
              e = iw(p)
              p = p + 1
              pj = pe(e)
              ln = len(e)
            ENDIF
C           -------------------------------------------------------
C           search for different supervariables and add them to the
C           new list, compressing when necessary. this loop is
C           executed once for each element in the list and once for
C           all the supervariables in the list.
C           -------------------------------------------------------
            knt2_updated = 0
            DO 110 knt2 = 1, ln
              knt2_updated = knt2_updated+1
              i = iw(pj)
              pj = pj + 1
              nvi = nv(i)
              IF (nvi .GT. 0) THEN
C               -------------------------------------------------
C               compress iw, if necessary
C               -------------------------------------------------
                IF (pfree .GT. iwlen) THEN
C                 prepare for compressing iw by adjusting
C                 pointers and lengths so that the lists being
C                 searched in the inner and outer loops contain
C                 only the remaining entries.
                  pe(me) = p
                  len(me) = len(me) - knt1_updated
C                 Reset KNT1_UPDATED in case of recompress 
C                 at same iteration of the loop 120
                  knt1_updated = 0
C                 Check if anything left in supervariable ME
                  IF (len(me) .EQ. 0) pe(me) = 0_8
                  pe(e) = pj
                  len(e) = ln - knt2_updated
C                 Reset KNT2_UPDATED in case of recompress 
C                 at same iteration of the loop 110
                  knt2_updated = 0
C                 Check if anything left in element E
                  IF (len(e) .EQ. 0) pe(e) = 0_8
                  ncmpa = ncmpa + 1
C                 store first item in pe
C                 set first entry to -item
                  DO 70 j = 1, n
                    pn = pe(j)
                    IF (pn .GT. 0) THEN
                      pe(j) = int(iw(pn),8)
                      iw(pn) = -j
                    ENDIF
   70             CONTINUE
C                 psrc/pdst point to source/destination
                  pdst = 1
                  psrc = 1
                  pend = pme1 - 1
C                 while loop:
   80             CONTINUE
                  IF (psrc .LE. pend) THEN
C                   search for next negative entry
                    j = -iw(psrc)
                    psrc = psrc + 1
                    IF (j .GT. 0) THEN
                      iw(pdst) = int(pe(j))
                      pe(j) = pdst
                      pdst = pdst + 1_8
C                     copy from source to destination
                      lenj = len(j)
                      DO 90 knt3 = 0, lenj - 2
                        iw(pdst + knt3) = iw(psrc + knt3)
   90                 CONTINUE
                      pdst = pdst + lenj - 1
                      psrc = psrc + lenj - 1
                    ENDIF
                    GO TO 80
                  ENDIF
C                 move the new partially-constructed element
                  p1 = pdst
                  DO 100 psrc = pme1, pfree - 1
                    iw(pdst) = iw(psrc)
                    pdst = pdst + 1
  100             CONTINUE
                  pme1 = p1
                  pfree = pdst
                  pj = pe(e)
                  p = pe(me)
                ENDIF
C               -------------------------------------------------
C               i is a principal variable not yet placed in Lme
C               store i in new list
C               -------------------------------------------------
                degme = degme + nvi
C               flag i as being in Lme by negating nv (i)
                nv(i) = -nvi
                iw(pfree) = i
                pfree = pfree + 1
              IF (degree(i).NE.n2) THEN
C               -------------------------------------------------
C               remove variable i from degree link list 
C                            (only if i in V0)
C               -------------------------------------------------
                ilast = last(i)
                inext = next(i)
                IF (inext .NE. 0) last(inext) = ilast
                IF (ilast .NE. 0) THEN
                  next(ilast) = inext
                ELSE
                  IF (wf(i).GT.norig) THEN
                   deg = min(((wf(i)-norig)/pas) + norig , nbbuck)
                  ELSE
                   deg = wf(i)
                  ENDIF
C                 i is at the head of the degree list
                  head(deg) = inext
                ENDIF
              ENDIF
              ENDIF
  110       CONTINUE
            IF (e .NE. me) THEN
C             set tree pointer and flag to indicate element e is
C             absorbed into new element me (the parent of e is me)
              pe(e) = int(-me,8)
              w(e) = 0
            ENDIF
  120     CONTINUE
          pme2 = pfree - 1
C         this element takes newmem new memory in iw (possibly zero)
          newmem = pfree - pme1
          mem = mem + newmem
          maxmem = max(maxmem, mem)
        ENDIF
C       -------------------------------------------------------------
C       me has now been converted into an element in iw (pme1..pme2)
C       -------------------------------------------------------------
C       degme holds the external degree of new element
        degree(me) = degme
        pe(me) = pme1
        len(me) = int(pme2 - pme1 + 1_8)
C       -------------------------------------------------------------
C       make sure that wflg is not too large.  With the current
C       value of wflg, wflg+n must not cause integer overflow
C       -------------------------------------------------------------
        IF (wflg .GT. maxint_n) THEN
          DO 130 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  130     CONTINUE
          wflg = 2
        ENDIF
C=======================================================================
C  COMPUTE (w (e) - wflg) = |Le\Lme| FOR ALL ELEMENTS
C=======================================================================
C       -------------------------------------------------------------
C       Scan 1:  compute the external degrees of previous elements
C       with respect to the current element.  That is:
C            (w (e) - wflg) = |Le \ Lme|
C       for each element e that appears in any supervariable in Lme.
C       The notation Le refers to the pattern (list of
C       supervariables) of a previous element e, where e is not yet
C       absorbed, stored in iw (pe (e) + 1 ... pe (e) + iw (pe (e))).
C       The notation Lme refers to the pattern of the current element
C       (stored in iw (pme1..pme2)).   If (w (e) - wflg) becomes
C       zero, then the element e will be absorbed in scan 2.
C       -------------------------------------------------------------
        DO 150 pme = pme1, pme2
          i = iw(pme)
          eln = elen(i)
          IF (eln .GT. 0) THEN
C           note that nv (i) has been negated to denote i in Lme:
            nvi = -nv(i)
            wnvi = wflg - nvi
            DO 140 p = pe(i), pe(i) + int(eln - 1,8)
              e = iw(p)
              we = w(e)
              IF (we .GE. wflg) THEN
C               unabsorbed element e has been seen in this loop
                we = we - nvi
              ELSE IF (we .NE. 0) THEN
C               e is an unabsorbed element
C               this is the first we have seen e in all of Scan 1
                we = degree(e) + wnvi
                wf(e) = 0
              ENDIF
              w(e) = we
  140       CONTINUE
          ENDIF
  150   CONTINUE
C=======================================================================
C  DEGREE UPDATE AND ELEMENT ABSORPTION
C=======================================================================
C       -------------------------------------------------------------
C       Scan 2:  for each i in Lme, sum up the degree of Lme (which
C       is degme), plus the sum of the external degrees of each Le
C       for the elements e appearing within i, plus the
C       supervariables in i.  Place i in hash list.
C       -------------------------------------------------------------
        DO 180 pme = pme1, pme2
          i = iw(pme)
          p1 = pe(i)
          p2 = p1 + elen(i) - 1
          pn = p1
          hash = 0_8
          deg  = 0
          wf3  = 0
          wf4  = 0
          nvi  = -nv(i)
C         ----------------------------------------------------------
C         scan the element list associated with supervariable i
C         ----------------------------------------------------------
          DO 160 p = p1, p2
            e = iw(p)
C           dext = | Le \ Lme |
            dext = w(e) - wflg
            IF (dext .GT. 0) THEN
              IF ( wf(e) .EQ. 0 ) THEN
C              First time we meet e : compute wf(e) 
C              which holds the surface associated to element e 
C              it will later be deducted from fill-in 
C              area of all variables adjacent to e
               wf(e) = dext * ( (2 * degree(e))  -  dext - 1)
              ENDIF
              wf4 = wf4 + wf(e)
              deg = deg + dext
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e, kind=8)
            ELSE IF (dext .EQ. 0) THEN
#if defined (NOAGG4)
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e,kind=8)
#else
C             aggressive absorption: e is not adjacent to me, but
C             the |Le \ Lme| is 0, so absorb it into me
              pe(e) = int(-me,8)
              w(e) = 0
#endif
            ENDIF
  160     CONTINUE
C         count the number of elements in i (including me):
          elen(i) = int(pn - p1 + 1_8)
C         ----------------------------------------------------------
C         scan the supervariables in the list associated with i
C         ----------------------------------------------------------
          p3 = pn
          DO 170 p = p2 + 1_8, p1 + int(len(i) - 1,8)
            j = iw(p)
            nvj = nv(j)
            IF (nvj .GT. 0) THEN
C             j is unabsorbed, and not in Lme.
C             add to degree and add to new list
              deg = deg + nvj
              wf3 = wf3 + nvj
              iw(pn) = j
              pn = pn + 1
              hash = hash + int(j,kind=8)
            ENDIF
  170     CONTINUE
C
          IF (degree(i).EQ.n2) deg = n2
C         ----------------------------------------------------------
C         update the degree and check for mass elimination
C         ----------------------------------------------------------
#if defined (NOAGG4)
          IF (elen(i).EQ.1 .AND. p3.EQ.pn) THEN
#else
          IF (deg .EQ. 0) THEN
#endif
C           -------------------------------------------------------
C           mass elimination
C           -------------------------------------------------------
C           There is nothing left of this node except for an
C           edge to the current pivot element.  elen (i) is 1,
C           and there are no variables adjacent to node i.
C           Absorb i into the current pivot element, me.
            pe(i) = int(-me,8)
            nvi = -nv(i)
            degme = degme - nvi
            nvpiv = nvpiv + nvi
            nel = nel + nvi
            nv(i) = 0
            elen(i) = 0
          ELSE
C           -------------------------------------------------------
C           update the upper-bound degree of i
C           -------------------------------------------------------
C           the following degree does not yet include the size
C           of the current element, which is added later:
            IF (degree(i).NE.n2) THEN
C                I does not belong to halo
                 IF ( degree(i).LT.deg ) THEN
C                  Our appox degree is loose.
C                  we keep old value. Note that in 
C                  this case we cannot substract WF(I)
C                  for min-fill score.
                   wf4 = 0
                   wf3 = 0
                 ELSE
                   degree(i)  = deg
                 ENDIF
            ENDIF
C
C           compute WF(I) taking into account size of block 3.0
            wf(i)      = wf4 + 2*nvi*wf3
C           -------------------------------------------------------
C           add me to the list for i
C           -------------------------------------------------------
C           move first supervariable to end of list
            iw(pn) = iw(p3)
C           move first element to end of element part of list
            iw(p3) = iw(p1)
C           add new element to front of list.
            iw(p1) = me
C           store the new length of the list in len (i)
            len(i) = int(pn - p1 + 1)
            IF (deg.NE.n2) THEN
C           -------------------------------------------------------
C           place in hash bucket.  Save hash key of i in last (i).
C           -------------------------------------------------------
            hash = mod(hash, hmod) + 1_8
            j = head(hash)
            IF (j .LE. 0) THEN
C             the degree list is empty, hash head is -j
              next(i) = -j
              head(hash) = -i
            ELSE
C             degree list is not empty
C             use last (head (hash)) as hash head
              next(i) = last(j)
              last(j) = i
            ENDIF
            last(i) = int(hash,kind=kind(last))
            ENDIF
          ENDIF
  180   CONTINUE
        degree(me) = degme
C       -------------------------------------------------------------
C       Clear the counter array, w (...), by incrementing wflg.
C       -------------------------------------------------------------
        dmax = max(dmax, degme)
        wflg = wflg + dmax
C       make sure that wflg+n does not cause integer overflow
        IF (wflg .GT. maxint_n) THEN
          DO 190 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  190     CONTINUE
          wflg = 2
        ENDIF
C       at this point, w (1..n) .lt. wflg holds
C=======================================================================
C  SUPERVARIABLE DETECTION
C=======================================================================
        DO 250 pme = pme1, pme2
          i = iw(pme)
          IF ( (nv(i) .LT. 0) .AND. (degree(i).NE.n2) ) THEN
C           i is a principal variable in Lme
C           -------------------------------------------------------
C           examine all hash buckets with 2 or more variables.  We
C           do this by examing all unique hash keys for super-
C           variables in the pattern Lme of the current element, me
C           -------------------------------------------------------
            hash = int(last(i),kind=8)
C           let i = head of hash bucket, and empty the hash bucket
            j = head(hash)
            IF (j .EQ. 0) GO TO 250
            IF (j .LT. 0) THEN
C             degree list is empty
              i = -j
              head(hash) = 0
            ELSE
C             degree list is not empty, restore last () of head
              i = last(j)
              last(j) = 0
            ENDIF
            IF (i .EQ. 0) GO TO 250
C           while loop:
  200       CONTINUE
            IF (next(i) .NE. 0) THEN
C             ----------------------------------------------------
C             this bucket has one or more variables following i.
C             scan all of them to see if i can absorb any entries
C             that follow i in hash bucket.  Scatter i into w.
C             ----------------------------------------------------
              ln = len(i)
              eln = elen(i)
C             do not flag the first element in the list (me)
              DO 210 p = pe (i) + 1_8, pe(i) + int(ln - 1,8)
                w(iw(p)) = wflg
  210         CONTINUE
C             ----------------------------------------------------
C             scan every other entry j following i in bucket
C             ----------------------------------------------------
              jlast = i
              j = next(i)
C             while loop:
  220         CONTINUE
              IF (j .NE. 0) THEN
C               -------------------------------------------------
C               check if j and i have identical nonzero pattern
C               -------------------------------------------------
C               jump if i and j do not have same size data structure
                IF (len(j) .NE. ln) GO TO 240
C               jump if i and j do not have same number adj elts
                IF (elen(j) .NE. eln) GO TO 240
C               do not flag the first element in the list (me)
                DO 230 p = pe(j) + 1_8, pe(j) + int(ln - 1,8)
C                 jump if an entry (iw(p)) is in j but not in i
                  IF (w(iw(p)) .NE. wflg) GO TO 240
  230           CONTINUE
C               -------------------------------------------------
C               found it!  j can be absorbed into i
C               -------------------------------------------------
                pe(j) = int(-i,8)
                wf(i)  = max(wf(i),wf(j))
C               both nv (i) and nv (j) are negated since they
C               are in Lme, and the absolute values of each
C               are the number of variables in i and j:
                nv(i) = nv(i) + nv(j)
                nv(j) = 0
                elen(j) = 0
C               delete j from hash bucket
                j = next(j)
                next(jlast) = j
                GO TO 220
C               -------------------------------------------------
  240           CONTINUE
C               j cannot be absorbed into i
C               -------------------------------------------------
                jlast = j
                j = next(j)
              GO TO 220
              ENDIF
C             ----------------------------------------------------
C             no more variables can be absorbed into i
C             go to next i in bucket and clear flag array
C             ----------------------------------------------------
              wflg = wflg + 1
              i = next(i)
              IF (i .NE. 0) GO TO 200
            ENDIF
          ENDIF
  250   CONTINUE
C=======================================================================
C  RESTORE DEGREE LISTS AND REMOVE NONPRINCIPAL SUPERVAR. FROM ELEMENT
C=======================================================================
        p = pme1
        nleft = totel - nel + nleft_v1
        DO 260 pme = pme1, pme2
          i = iw(pme)
          nvi = -nv(i)
          IF (nvi .GT. 0) THEN
C           i is a principal variable in Lme
C           restore nv (i) to signify that i is principal
            nv(i) = nvi
            IF (degree(i).NE.n2) THEN
C           -------------------------------------------------------
C           compute the external degree (add size of current elem)
C           -------------------------------------------------------
C--------------------------
C--------------------------
            IF (degree(i) + degme .GT. nleft ) THEN
C
              deg = degree(i)
              rmf1  = dble(deg)*dble( (deg-1) + 2*degme )
     &              - dble(wf(i))
              degree(i) = nleft - nvi
              deg       = degree(i) 
              rmf = dble(deg)*dble(deg-1) 
     &         -  dble(degme-nvi)*dble(degme-nvi-1)
              rmf = min(rmf, rmf1)
            ELSE 
              deg = degree(i)
              degree(i) = degree(i) + degme - nvi
C             All previous cliques taken into account (AMF4)
              rmf  = dble(deg)*dble( (deg-1) + 2*degme ) 
     &              - dble(wf(i))
            ENDIF
C
            rmf =  rmf / dble(nvi+1)
C
            IF (rmf.LT.dummy) THEN
             wf(i) = int( anint( rmf ))
            ELSEIF (rmf / dble(n) .LT. dummy) THEN 
             wf(i) = int( anint( rmf/dble(n) ))
            ELSE
             wf(i) = idummy
            ENDIF
            wf(i) = max(1,wf(i))
            deg = wf(i)
            IF (deg.GT.norig) THEN
              deg = min(((deg-norig)/pas) + norig, nbbuck)
            ENDIF
            inext = head(deg)
            IF (inext .NE. 0) last(inext) = i
            next(i) = inext
            last(i) = 0
            head(deg) = i
C           -------------------------------------------------------
C           save the new degree, and find the minimum degree
C           -------------------------------------------------------
            mindeg = min(mindeg, deg)
C begin HALO
              ENDIF
C end HALO
C           -------------------------------------------------------
C           place the supervariable in the element pattern
C           -------------------------------------------------------
            iw(p) = i
            p = p + 1
          ENDIF
  260   CONTINUE
C=======================================================================
C  FINALIZE THE NEW ELEMENT
C=======================================================================
        nv(me) = nvpiv + degme
C       fill_est = fill_est + nvpiv * (nvpiv + 2 * degme)
C       nv (me) is now the degree of pivot (including diagonal part)
C       save the length of the list for the new element me
        len(me) = int(p - pme1)
        IF (len(me) .EQ. 0) THEN
C         there is nothing left of the current pivot element
          pe(me) = 0_8
          w(me) = 0
        ENDIF
        IF (newmem .NE. 0) THEN
C         element was not constructed in place: deallocate part
C         of it (final size is less than or equal to newmem,
C         since newly nonprincipal variables have been removed).
          pfree = p
          mem = mem - newmem + int(len(me),8)
        ENDIF
C=======================================================================
C       END WHILE (selecting pivots)
      GO TO 30
      ENDIF
C=======================================================================
C begin HALO V2
      IF (nel.LT.norig) THEN 
C
C     All possible pivots (not flagged have been eliminated).
C     We amalgamate all flagged variables at the root and 
C     we finish the elimination tree.
C          1/ Go through all
C          non absorbed elements (root of the subgraph)
C          and absorb in ME
C          2/ perform mass elimination of all dense rows
           DO deg = mindeg, nbbuck+1
             me = head(deg)
             IF (me .GT. 0) GO TO 51
           ENDDO
   51      mindeg = deg
           nelme    = -(nel+1)
           DO x=1,n
            IF ((pe(x).GT.0) .AND. (elen(x).LT.0)) THEN
C            X is an unabsorbed element
             pe(x) = int(-me,8)
C            W(X) = 0 could be suppressed ?? check it
            ELSEIF (degree(x).EQ.n2) THEN
C            X is a dense row, absorb it in ME (mass elimination)
             nel   = nel + nv(x)
             pe(x) = int(-me,8)
             elen(x) = 0
C            Correct value of NV is (secondary variable)
             nv(x) = 0
            ENDIF
           ENDDO
C          ME is the root node
           elen(me) = nelme
C          Correct value of NV is (principal variable)
           nv(me)   = nbflag
           pe(me)   = 0_8
        IF (nel.NE.norig) THEN
         ncmpa = -norig - 1
         GOTO 500
        ENDIF
      ENDIF
C end HALO
C=======================================================================
C  COMPUTE THE PERMUTATION VECTORS and update TREE
C=======================================================================
C     ----------------------------------------------------------------
C     The time taken by the following code is O(n).  At this
C     point, elen (e) = -k has been done for all elements e,
C     and elen (i) = 0 has been done for all nonprincipal
C     variables i.  At this point, there are no principal
C     supervariables left, and all elements are absorbed.
C     ----------------------------------------------------------------
C     ----------------------------------------------------------------
C     compute the ordering of unordered nonprincipal variables
C     ----------------------------------------------------------------
      DO 290 i = 1, n
        IF (elen(i) .EQ. 0) THEN
C         ----------------------------------------------------------
C         i is an un-ordered row.  Traverse the tree from i until
C         reaching an element, e.  The element, e, was the
C         principal supervariable of i and all nodes in the path
C         from i to when e was selected as pivot.
C         ----------------------------------------------------------
          j = int(-pe(i))
C         while (j is a variable) do:
  270     CONTINUE
            IF (elen(j) .GE. 0) THEN
              j = int(-pe(j))
              GO TO 270
            ENDIF
            e = j
C           ----------------------------------------------------------
C           get the current pivot ordering of e
C           ----------------------------------------------------------
            k = -elen(e)
C           ----------------------------------------------------------
C           traverse the path again from i to e, and compress the
C           path (all nodes point to e).  Path compression allows
C           this code to compute in O(n) time.  Order the unordered
C           nodes in the path, and place the element e at the end.
C           ----------------------------------------------------------
            j = i
C           while (j is a variable) do:
  280       CONTINUE
            IF (elen(j) .GE. 0) THEN
              jnext = int(-pe(j))
              pe(j) = int(-e,8)
              IF (elen(j) .EQ. 0) THEN
C               j is an unordered row
                elen(j) = k
                k = k + 1
              ENDIF
              j = jnext
            GO TO 280
            ENDIF
C         leave elen (e) negative, so we know it is an element
          elen(e) = -k
        ENDIF
  290 CONTINUE
      IF (compute_perm) THEN
C     ----------------------------------------------------------------
C     reset the inverse permutation (elen (1..n)) to be positive,
C     and compute the pivot order (last (1..n)).
C     ----------------------------------------------------------------
C begin COMPRESS
      IF(compress) THEN
C       N is the size of the compressed graph.
C       If the graph was compressed on input then
C       indices in ELEN are in [1,TOTEL]
C       We build the inverse of ELEN in LAST (similar to
C       the pivot order but has zeros in it) and then compress
C       it. Since LAST is assumed to be of size N at the
C       interface level, we need another array to store
C       the inverse of ELEN for entries greater than N
C       We use DEGREE.
        last(1:n) = 0
        head(1:totel-n)=0
        DO i = 1, n
          k = abs(elen(i))
          IF ( k <= n ) THEN
            last(k) = i
          ELSE
            head(k-n)=i
          ENDIF
        ENDDO
        i = 1
        DO k = 1, n
          IF(last(k) .NE. 0) THEN
            last(i) = last(k)
            elen(last(k)) = i
            i = i + 1
          ENDIF
        ENDDO
        DO k = n+1, totel
          IF (head(k-n) .NE. 0) THEN
            last(i)=head(k-n)
            elen(head(k-n)) = i
            i = i + 1
          ENDIF
        END DO
      ELSE
        DO 300 i = 1, n
           k = abs(elen(i))
           last(k) = i
           elen(i) = k
300     CONTINUE
      ENDIF
C end COMPRESS
      ENDIF
C=======================================================================
C  RETURN THE MEMORY USAGE IN IW
C=======================================================================
C     If maxmem is less than or equal to iwlen, then no compressions
C     occurred, and iw (maxmem+1 ... iwlen) was unused.  Otherwise
C     compressions did occur, and iwlen would have had to have been
C     greater than or equal to maxmem for no compressions to occur.
C     Return the value of maxmem in the pfree argument.
 500  pfree = maxmem
C===============================
C     Save IPE in PARENT array
      DO i=1,n
       parent(i) = int(pe(i))
      ENDDO
C===============================
      RETURN

mumps_qamd()

subroutine mumps_qamd	(	integer, intent(in)	totel,
		logical, intent(in)	compute_perm,
		integer, intent(in)	iversion,
		integer, intent(in)	thresh,
		integer, dimension(n), intent(out)	ndense,
		integer, intent(in)	n,
		integer(8), intent(in)	iwlen,
		integer(8), dimension(n), intent(inout)	pe,
		integer(8), intent(inout)	pfree,
		integer, dimension(n), intent(inout)	len,
		integer, dimension(iwlen), intent(inout)	iw,
		integer, dimension(n), intent(inout)	nv,
		integer, dimension(n), intent(out)	elen,
		integer, dimension(n), intent(out)	last,
		integer, intent(out)	ncmpa,
		integer, dimension(n), intent(out)	degree,
		integer, dimension(totel), intent(out)	head,
		integer, dimension(n), intent(out)	next,
		integer, dimension(n), intent(out)	w,
		integer, dimension(n), intent(out)	parent )

Definition at line 5226 of file ana_orderings.F.

C    Input not modified
      INTEGER, INTENT(IN)    :: TOTEL, N
      LOGICAL, INTENT(IN)    :: COMPUTE_PERM
      INTEGER, INTENT(IN)    :: IVersion, THRESH
      INTEGER(8), INTENT(IN) :: IWLEN
      INTEGER, INTENT(INOUT)  :: LEN(N), IW(IWLEN)
      INTEGER, INTENT(OUT)   :: NCMPA
      INTEGER, INTENT(OUT)   :: ELEN(N), PARENT(N)
      INTEGER, INTENT(OUT)   :: LAST(N)
      INTEGER(8), INTENT(INOUT) :: PFREE
      INTEGER(8), INTENT(INOUT) :: PE(N)
C     NV also meaningful as input to encode compressed graphs
      INTEGER, INTENT(INOUT)  :: NV(N)
      INTEGER, INTENT(OUT) :: NEXT(N), DEGREE(N), HEAD(TOTEL), W(N)
      INTEGER, INTENT(OUT) :: NDENSE(N)
C The input integer parameter THRESH defines the quasi density:
C THRESH : input parameter (not modified) 
C  THRESH is used to compute THRESM 
C   <=0 or N Only exactly dense rows in the reduced matrix are selected.
C   >1 and <=N THRESH correspond to the munimum density requirement.
C
C       IVersion =
C                   1 : No dense row detection during elimination
C                       Suppressing dense row selection after 1st
C                       and final restrart (Using initial degree of 
C                         quasi dense
C                         rows when restarting and suppress
C                         dense row selection)
C                   else  : All functionalities enabled
C Additionnal parameters/variables due to dense row manipulation:
C PARAMETERS:
C ----------
C          
C Local variables:
C ---------------
      INTEGER THRESM, MINDEN, MAXDEN, NDME
      INTEGER NBD,NBED, NBDM, LASTD, NELME
C      INTEGER DEG1
      LOGICAL IDENSE
      DOUBLE PRECISION RELDEN
C 
C THRESM : Local Integer holding a 
C          potentially modified value of THRESH.
C          When quasi dense rows are reintegrated in the 
C          graph to be processed then THRESM is modified.
C   Note that if one sets THRESM to negative value then
C       <0 Classical AMD algorithm (no dense row detection)
C RELDEN : holds average density to set THRESM automatically
C MINDEN: min degree of quasi-dense rows when restarting
C MAXDEN: max degree of quasi-dense rows when restarting
C NDME  : number of dense row adjacent to me
C NELME number of pivots selected when reching the root
C LASTD index of the last row in the list of dense rows
C NBD is the total number of dense rows selected 
C NBED is the total number of exactly dense rows detected. 
C NBDM is the maximum number of dense rows selected 
C IDENSE is used to indicate that the supervariable I is a dense or
C        quasi-dense row.
C-----------------------------------------------------------------------
C   Given a representation of the nonzero pattern of a symmetric matrix,
C   A, (excluding the diagonal) perform an approximate minimum
C   degree ordering to compute a pivot order
C   such that fill-in in the Cholesky factors A = LL^T is kept low. 
C   Aggressive absorption might be used to
C   tighten the bound on the degree.  This can result a
C   significant improvement in the quality of the ordering for
C   some matrices.
C-----------------------------------------------------------------------
C INPUT ARGUMENTS (unaltered):
C-----------------------------------------------------------------------
C n     : The matrix order.
C         number of supervariables if compress/blocked format
C         Restriction:  n .ge. 1
C totel : Number of variables to eliminate
C         In case of blocked format:
C         each variable i is a supervariable of size nv(i)
C         totel is computed as the sum(nv(i)) for i \in [1:n]
C         the algorithm stops when totel variables are
C         eliminated.
C compute_perm : indicates if permutations should be computed 
C         on output in last/elen 
C iwlen:        The length of iw (1..iwlen).  On input, the matrix is
C       stored in iw (1..pfree-1).  However, iw (1..iwlen) should be
C       slightly larger than what is required to hold the matrix, at
C       least iwlen .ge. pfree + n is recommended.  Otherwise,
C       excessive compressions will take place.
C       *** We do not recommend running this algorithm with ***
C       ***      iwlen .lt. pfree + n.                      ***
C       *** Better performance will be obtained if          ***
C       ***      iwlen .ge. pfree + n                       ***
C       *** or better yet                                   ***
C       ***      iwlen .gt. 1.2 * pfree                     ***
C       *** (where pfree is its value on input).            ***
C       The algorithm will not run at all if iwlen .lt. pfree-1.
C
C       Restriction: iwlen .ge. pfree-1
C-----------------------------------------------------------------------
C INPUT/OUPUT ARGUMENTS:
C-----------------------------------------------------------------------
C pe:   On input, pe (i) is the index in iw of the start of row i, or
C       zero if row i has no off-diagonal non-zeros.
C
C       During execution, it is used for both supervariables and
C       elements:
C
C       * Principal supervariable i:  index into iw of the
C               description of supervariable i.  A supervariable
C               represents one or more rows of the matrix
C               with identical nonzero pattern.
C       * Non-principal supervariable i:  if i has been absorbed
C               into another supervariable j, then pe (i) = -j.
C               That is, j has the same pattern as i.
C               Note that j might later be absorbed into another
C               supervariable j2, in which case pe (i) is still -j,
C               and pe (j) = -j2.
C       * Unabsorbed element e:  the index into iw of the description
C               of element e, if e has not yet been absorbed by a
C               subsequent element.  Element e is created when
C               the supervariable of the same name is selected as
C               the pivot.
C       * Absorbed element e:  if element e is absorbed into element
C               e2, then pe (e) = -e2.  This occurs when the pattern of
C               e (that is, Le) is found to be a subset of the pattern
C               of e2 (that is, Le2).  If element e is "null" (it has
C               no nonzeros outside its pivot block), then pe (e) = 0.
C
C       On output, pe holds the assembly tree/forest, which implicitly
C       represents a pivot order with identical fill-in as the actual
C       order (via a depth-first search of the tree).
C
C       On output:
C       If nv (i) .gt. 0, then i represents a node in the assembly tree,
C       and the parent of i is -pe (i), or zero if i is a root.
C       If nv (i) = 0, then (i,-pe (i)) represents an edge in a
C       subtree, the root of which is a node in the assembly tree.
C
C       On output:  (PE is copied on output into PARENT array)
C
C pfree:        On input, the matrix is stored in iw (1..pfree-1) and
C       the rest of the array iw is free.
C       During execution, additional data is placed in iw, and pfree
C       is modified so that components  of iw from pfree are free.
C       On output, pfree is set equal to the size of iw that
C       would have been needed for no compressions to occur.  If
C       ncmpa is zero, then pfree (on output) is less than or equal to
C       iwlen, and the space iw (pfree+1 ... iwlen) was not used.
C       Otherwise, pfree (on output) is greater than iwlen, and all the
C       memory in iw was used.
C
C nv:   On input, encoding of compressed graph:
C       if nv(1) = -1 then graph is not compressed otherwise
C       nv(I) holds the weight of node I. 
C       During execution, abs (nv (i)) is equal to the number of rows
C       that are represented by the principal supervariable i.  If i is
C       a nonprincipal variable, then nv (i) = 0.  
C       nv (i) .lt. 0 signifies that i is a
C       principal variable in the pattern Lme of the current pivot
C       element me.  
C       On output, nv (e) holds the true degree of element
C       e at the time it was created (including the diagonal part).
C begin HALO
C       On output, nv(I) can be used to find node in set V1.
C       Not true anymore : ( nv(I) = N+1 characterizes nodes in V1. 
C                 instead nodes in V1 are considered as a dense root node )
C end HALO
C-----------------------------------------------------------------------
C INPUT/MODIFIED (undefined on output):
C-----------------------------------------------------------------------
C len:  On input, len (i) holds the number of entries in row i of the
C       matrix, excluding the diagonal.  The contents of len (1..n)
C       are undefined on output.
C iw:   On input, iw (1..pfree-1) holds the description of each row i
C       in the matrix.  The matrix must be symmetric, and both upper
C       and lower triangular parts must be present.  The diagonal must
C       not be present.  Row i is held as follows:
C
C               len (i):  the length of the row i data structure
C               iw (pe (i) ... pe (i) + len (i) - 1):
C                       the list of column indices for nonzeros
C                       in row i (simple supervariables), excluding
C                       the diagonal.  All supervariables start with
C                       one row/column each (supervariable i is just
C                       row i).
C               if len (i) is zero on input, then pe (i) is ignored
C               on input.
C
C               Note that the rows need not be in any particular order,
C               and there may be empty space between the rows.
C
C       During execution, the supervariable i experiences fill-in.
C       This is represented by placing in i a list of the elements
C       that cause fill-in in supervariable i:
C
C               len (i):  the length of supervariable i
C               iw (pe (i) ... pe (i) + elen (i) - 1):
C                       the list of elements that contain i.  This list
C                       is kept short by removing absorbed elements.
C               iw (pe (i) + elen (i) ... pe (i) + len (i) - 1):
C                       the list of supervariables in i.  This list
C                       is kept short by removing nonprincipal
C                       variables, and any entry j that is also
C                       contained in at least one of the elements
C                       (j in Le) in the list for i (e in row i).
C
C       When supervariable i is selected as pivot, we create an
C       element e of the same name (e=i):
C
C               len (e):  the length of element e
C               iw (pe (e) ... pe (e) + len (e) - 1):
C                       the list of supervariables in element e.
C
C       An element represents the fill-in that occurs when supervariable
C       i is selected as pivot (which represents the selection of row i
C       and all non-principal variables whose principal variable is i).
C       We use the term Le to denote the set of all supervariables
C       in element e.  Absorbed supervariables and elements are pruned
C       from these lists when computationally convenient.
C
C       CAUTION:  THE INPUT MATRIX IS OVERWRITTEN DURING COMPUTATION.
C       The contents of iw are undefined on output.
C-----------------------------------------------------------------------
C OUTPUT (need not be set on input):
C-----------------------------------------------------------------------
C elen: See the description of iw above.  At the start of execution,
C       elen (i) is set to zero.  During execution, elen (i) is the
C       number of elements in the list for supervariable i.  When e
C       becomes an element, elen (e) = -nel is set, where nel is the
C       current step of factorization.  elen (i) = 0 is done when i
C       becomes nonprincipal.
C
C       For variables, elen (i) .ge. 0 holds until just before the
C       permutation vectors are computed.  For elements,
C       elen (e) .lt. 0 holds.
C
C       On output elen (1..n) holds the inverse permutation (the same
C       as the 'INVP' argument in Sparspak).  That is, if k = elen (i),
C       then row i is the kth pivot row.  Row i of A appears as the
C       (elen(i))-th row in the permuted matrix, PAP^T.
C last: In a degree list, last (i) is the supervariable preceding i,
C       or zero if i is the head of the list.  In a hash bucket,
C       last (i) is the hash key for i.  last (head (hash)) is also
C       used as the head of a hash bucket if head (hash) contains a
C       degree list (see head, below).
C
C       On output, last (1..n) holds the permutation (the same as the
C       'PERM' argument in Sparspak).  That is, if i = last (k), then
C       row i is the kth pivot row.  Row last (k) of A is the k-th row
C       in the permuted matrix, PAP^T.
C ncmpa:        The number of times iw was compressed.  If this is
C       excessive, then the execution took longer than what could have
C       been.  To reduce ncmpa, try increasing iwlen to be 10% or 20%
C       larger than the value of pfree on input (or at least
C       iwlen .ge. pfree + n).  The fastest performance will be
C       obtained when ncmpa is returned as zero.  If iwlen is set to
C       the value returned by pfree on *output*, then no compressions
C       will occur.
C-----------------------------------------------------------------------
C LOCAL (not input or output - used only during execution):
C-----------------------------------------------------------------------
C degree:       If i is a supervariable, then degree (i) holds the
C       current approximation of the external degree of row i (an upper
C       bound).  The external degree is the number of nonzeros in row i,
C       minus abs (nv (i)) (the diagonal part).  The bound is equal to
C       the external degree if elen (i) is less than or equal to two.
C
C       We also use the term "external degree" for elements e to refer
C       to |Le \ Lme|.  If e is an element, then degree (e) holds |Le|,
C       which is the degree of the off-diagonal part of the element e
C       (not including the diagonal part).
Cdense
C degree (I) =N+1 if I is an exactly dense row in reduced matrix.
C            =N+1+LAST_approximate_external_deg of I   
C                      if I is a quasi dense row in reduced matrix.
C All dense or quasi dense rows are stored in the list pointed 
C       by head(n). Quasi-dense rows (degree(I)=n) are stored first, 
C       and are followed by exactly dense rows in the reduced matrix.
C       LASTD holds the last row in this list of dense rows or is zero
C       if the list is empty.
Cdense
C head: head is used for degree lists.  head (deg) is the first
C       supervariable in a degree list (all supervariables i in a
C       degree list deg have the same approximate degree, namely,
C       deg = degree (i)).  If the list deg is empty then
C       head (deg) = 0.
C
C       During supervariable detection head (hash) also serves as a
C       pointer to a hash bucket.
C       If head (hash) .gt. 0, there is a degree list of degree hash.
C               The hash bucket head pointer is last (head (hash)).
C       If head (hash) = 0, then the degree list and hash bucket are
C               both empty.
C       If head (hash) .lt. 0, then the degree list is empty, and
C               -head (hash) is the head of the hash bucket.
C       After supervariable detection is complete, all hash buckets
C       are empty, and the (last (head (hash)) = 0) condition is
C       restored for the non-empty degree lists.
C next: next (i) is the supervariable following i in a link list, or
C       zero if i is the last in the list.  Used for two kinds of
C       lists:  degree lists and hash buckets (a supervariable can be
C       in only one kind of list at a time).
C w:    The flag array w determines the status of elements and
C       variables, and the external degree of elements.
C
C       for elements:
C          if w (e) = 0, then the element e is absorbed
C          if w (e) .ge. wflg, then w (e) - wflg is the size of
C               the set |Le \ Lme|, in terms of nonzeros (the
C               sum of abs (nv (i)) for each principal variable i that
C               is both in the pattern of element e and NOT in the
C               pattern of the current pivot element, me).
C          if wflg .gt. w (e) .gt. 0, then e is not absorbed and has
C               not yet been seen in the scan of the element lists in
C               the computation of |Le\Lme| in loop 150 below.
C
C       for variables:
C          during supervariable detection, if w (j) .ne. wflg then j is
C          not in the pattern of variable i
C
C       The w array is initialized by setting w (i) = 1 for all i,
C       and by setting wflg = 2.  It is reinitialized if wflg becomes
C       too large (to ensure that wflg+n does not cause integer
C       overflow).
C-----------------------------------------------------------------------
C LOCAL INTEGERS:
C-----------------------------------------------------------------------
      INTEGER :: DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I,
     &        ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3,
     &        LENJ, LN, ME, MINDEG, NEL, 
     &        NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X
      INTEGER KNT1_UPDATED, KNT2_UPDATED
      INTEGER(8) MAXMEM, MEM, NEWMEM
      INTEGER   :: MAXINT_N
      INTEGER(8):: HASH, HMOD
C deg:        the degree of a variable or element
C degme:      size, |Lme|, of the current element, me (= degree (me))
C dext:       external degree, |Le \ Lme|, of some element e
C dmax:       largest |Le| seen so far
C e:          an element
C elenme:     the length, elen (me), of element list of pivotal var.
C eln:        the length, elen (...), of an element list
C hash:       the computed value of the hash function
C hmod:       the hash function is computed modulo hmod = max (1,n-1)
C i:          a supervariable
C ilast:      the entry in a link list preceding i
C inext:      the entry in a link list following i
C j:          a supervariable
C jlast:      the entry in a link list preceding j
C jnext:      the entry in a link list, or path, following j
C k:          the pivot order of an element or variable
C knt1:       loop counter used during element construction
C knt2:       loop counter used during element construction
C knt3:       loop counter used during compression
C lenj:       len (j)
C ln:         length of a supervariable list
C maxint_n:   large integer to test risk of overflow on wflg
C maxmem:     amount of memory needed for no compressions
C me:         current supervariable being eliminated, and the
C                     current element created by eliminating that
C                     supervariable
C mem:        memory in use assuming no compressions have occurred
C mindeg:     current minimum degree
C nel:        number of pivots selected so far
C newmem:     amount of new memory needed for current pivot element
C nleft:      n - nel, the number of nonpivotal rows/columns remaining
C nvi:        the number of variables in a supervariable i (= nv (i))
C nvj:        the number of variables in a supervariable j (= nv (j))
C nvpiv:      number of pivots in current element
C slenme:     number of variables in variable list of pivotal variable
C we:         w (e)
C wflg:       used for flagging the w array.  See description of iw.
C wnvi:       wflg - nv (i)
C x:          either a supervariable or an element
C-----------------------------------------------------------------------
C LOCAL POINTERS:
C-----------------------------------------------------------------------
      INTEGER(8) P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, 
     &           PN, PSRC, PLN, PELN
C             Any parameter (pe (...) or pfree) or local variable
C             starting with "p" (for Pointer) is an index into iw,
C             and all indices into iw use variables starting with
C             "p."  The only exception to this rule is the iwlen
C             input argument.
C p:          pointer into lots of things
C p1:         pe (i) for some variable i (start of element list)
C p2:         pe (i) + elen (i) -  1 for some var. i (end of el. list)
C p3:         index of first supervariable in clean list
C pdst:       destination pointer, for compression
C pend:       end of memory to compress
C pj:         pointer into an element or variable
C pme:        pointer into the current element (pme1...pme2)
C pme1:       the current element, me, is stored in iw (pme1...pme2)
C pme2:       the end of the current element
C pn:         pointer into a "clean" variable, also used to compress
C psrc:       source pointer, for compression
      LOGICAL COMPRESS
C-----------------------------------------------------------------------
C  FUNCTIONS CALLED:
C-----------------------------------------------------------------------
      INTRINSIC max, min, mod
C=======================================================================
C  INITIALIZATIONS
C=======================================================================
C     ------------------------------------------------------
C     Experiments with automatic setting of parameter THRESH.
C     ------------------------------------------------------
      IF (thresh.GT.0) THEN 
         thresm  = min(n,thresh)
         DO i=1,n
             thresm = max(thresm, len(i))
          ENDDO
           relden = dble(pfree-1)/dble(n)
C      RELDEN holds the average density, THRESM the maximum density
         thresm =  int(relden)*10 + (thresm-int(relden))/10 + 1
C     ------------------------------------------------------
C     end automatic setting of THRESM
C     ------------------------------------------------------
      ELSE
C        only exactly dense row will be selected
         thresm = totel
      ENDIF
      IF (thresm.GE.0) THEN
       IF ((thresm.GT.totel).OR.(thresm.LT.2)) THEN 
C      exactly dense rows only
          thresm = totel
       ENDIF
      ENDIF
      lastd = 0
      nbd   = 0
      nbed  = 0
      nbdm  = 0
      wflg = 2
      maxint_n=huge(wflg)-n
      mindeg = 1
      ncmpa = 0
      nel = 0
      hmod = int(max(1, n-1),kind=8)
      dmax = 0
      mem = pfree - 1
      maxmem = mem
      DO i = 1, n
        ndense(i)= 0
        w(i) = 1
        elen(i) = 0
        last(i) = 0
      ENDDO
      DO i = 1, totel
        head(i) = 0
      ENDDO
      IF(nv(1) .LT. 0) THEN
         compress = .false.
      ELSE
         compress = .true.
      ENDIF
      IF (compress) THEN
         DO i=1,n
            degree(i) = 0
            DO p= pe(i) , pe(i)+int(len(i)-1,8)
               degree(i) = degree(i) + nv(iw(p))
            ENDDO
         ENDDO
      ELSE
         DO i=1,n
            nv(i) = 1
            degree(i) = len(i)
         ENDDO
      ENDIF
C     ----------------------------------------------------------------
C     initialize degree lists and eliminate rows with no off-diag. nz.
C     ----------------------------------------------------------------
C         NEXT = 0
      DO 20 i = 1, n
         deg = degree (i)
         IF (deg .GT. 0) THEN
C         ----------------------------------------------------------
C         place i in the degree list corresponding to its degree
C         or in the dense row list if i is dense or quasi dense.
C         ----------------------------------------------------------
C         test for row density
            IF ( (thresm.GE.0) .AND.
     &           (deg+nv(i).GE.thresm) ) THEN
C           I will be inserted in the degree list of N
               nbd = nbd+nv(i)
               IF (deg+nv(i).NE.totel-nel) THEN
                  degree(i) = degree(i)+totel+1
C            insert I at the beginning of degree list of n
                  deg = totel
                  inext = head(deg)
                  IF (inext .NE. 0) last(inext) = i
                  next(i) = inext
                  head(deg) = i 
                  last(i)  = 0
                  IF (lastd.EQ.0) lastd=i
               ELSE
                  nbed = nbed+nv(i)
                  degree(i) = totel+1
C            insert I at the end of degree list of n
                  deg = totel
                  IF (lastd.EQ.0) THEN
C              degree list is empty
                     lastd     = i 
                     head(deg) = i
                     next(i)   = 0 
                     last(i)   = 0
                  ELSE
                     next(lastd) = i
                     last(i)     = lastd
                     lastd       = i
                     next(i)     = 0
                  ENDIF
               ENDIF
            ELSE
C           place i in the degree list corresponding to its degree
               inext = head(deg)
               IF (inext .NE. 0) last(inext) = i
               next(i) = inext
               head(deg) = i
            ENDIF
         ELSE
C         ----------------------------------------------------------
C         we have a variable that can be eliminated at once because
C         there is no off-diagonal non-zero in its row.
C         ----------------------------------------------------------
            nel = nel + nv(i)
C          NEL = NEL + 1
            elen(i) = -nel
            pe(i) = 0_8
            w(i) = 0
         ENDIF
 20   CONTINUE
C         We suppress dense row selection if none of them was found in A 
C         in the 1st pass
          IF (nbd.EQ.0) thresm = totel
C
C=======================================================================
C  WHILE (selecting pivots) DO
C=======================================================================
 30       IF (nel .LT. totel) THEN
C=======================================================================
C  GET PIVOT OF MINIMUM DEGREE
C=======================================================================
C       -------------------------------------------------------------
C       find next supervariable for elimination
C       -------------------------------------------------------------
        DO 40 deg = mindeg, totel
          me = head(deg)
          IF (me .GT. 0) GO TO 50
   40   CONTINUE
   50   mindeg = deg
        IF (deg.LT.totel)  THEN
C       -------------------------------------------------------------
C       remove chosen variable from link list
C       -------------------------------------------------------------
          inext = next(me)
          IF (inext .NE. 0) last(inext) = 0
          head(deg) = inext
        ELSE
          nbdm = max(nbdm,nbd)
          IF (degree(me).GT.totel+1) THEN
            minden = nbd
            maxden = 0
            IF (wflg .GT. maxint_n) THEN
             DO  52 x = 1, n
              IF (w(x) .NE. 0) w(x) = 1
  52         CONTINUE
             wflg = 2
            ENDIF
            wflg = wflg + 1
  51        CONTINUE
C           ---------------------------------------------------------
C           remove chosen variable from link list
C           ---------------------------------------------------------
            inext = next(me)
            IF (inext .NE. 0) THEN 
               last(inext) = 0
            ELSE
               lastd = 0
            ENDIF
C           ----------------------------------------------------------
c           build adjacency list of ME in quotient gragh
C           and calculate its external degree  in ndense(me)
C           ----------------------------------------------------------
            ndense(me) = 0
            w(me)      = wflg
            p1 = pe(me)
            p2 = p1 + int(len(me) -1,8)
C           PLN-1 holds the pointer in IW to the last elet/var in adj list
C              of ME.  LEN(ME) will then be set to PLN-P1
C           PELN-1 hold the pointer in IW to the last elet in adj list
C              of ME.  ELEN(ME) will then be set to PELN-P1
C           element adjacent to ME
            pln       = p1
            peln      = p1
            DO 55 p=p1,p2
              e= iw(p)
              IF (w(e).EQ.wflg) GOTO 55
              w(e) = wflg
              IF (pe(e).LT.0_8) THEN
C              E is a nonprincipal variable or absorbed element
                x = e
  53            x = int(-pe(x))
                IF (w(x) .EQ.wflg) GOTO 55
                w(x) = wflg
                IF ( pe(x) .LT. 0_8 ) GOTO 53
                e = x
              ENDIF
C             -------------------------------------------
C             E is an unabsorbed element or a "dense" row
C                 (NOT already flagged)
C             -------------------------------------------
              IF (elen(e).LT.0) then
C              E is a new element in adj(ME)
               ndense(e) = ndense(e) - nv(me)
               iw(pln) = iw(peln)
               iw(peln) = e
               pln  = pln+1_8
               peln = peln + 1_8
C              update ndense of ME with all unflagged dense
C              rows in E
               pme1 = pe(e)
               DO 54 pme = pme1, pme1+int(len(e)-1,8)
                x = iw(pme)
                IF ((elen(x).GE.0).AND.(w(x).NE.wflg)) THEN
C                X is a dense row 
                 ndense(me) = ndense(me) + nv(x)
                 w(x) = wflg
                ENDIF
 54            CONTINUE
              ELSE
C              E is a dense row 
               ndense(me) = ndense(me) + nv(e)
               iw(pln)=e
               pln = pln+1_8
              ENDIF
  55        CONTINUE
C           ----------------------------------------------
C           DEGREE(ME)-(N+1) holds last external degree computed
C           when Me was detected as dense
C           NDENSE(ME) is the exact external degree of ME
C           ----------------------------------------------
            wflg     = wflg + 1
            len(me)  = int(pln-p1)
            elen(me) = int(peln-p1)
            ndme = ndense(me)+nv(me)
            minden = min(minden, ndme)
            maxden = max(maxden, ndme)
C            If we want to select ME as exactly dense (NDME.EQ.NBD)
C            of quasi dense NDME.GE.THRESMupdated then 
C            ndense(of elements adjacent to ME) sould be updated
            IF (ndense(me).EQ.0) ndense(me) =1
            IF (iversion.EQ.1) THEN
C              ------------------------------------------------
C              place ME in the degree list of  DEGREE(ME)-(N+1)
C              NDENSE is not used in this case (simulate of 
C                      preprocessing )
C              ------------------------------------------------
              deg = max(degree(me)-(totel+1), 1)
            ELSE
C              -----------------------------------------
C              place ME in the degree list of NDENSE(ME)
C              -----------------------------------------
              deg = ndense(me)
            ENDIF
            degree(me) = deg
            mindeg = min(deg,mindeg)
            jnext = head(deg)
            IF (jnext.NE. 0) last(jnext) = me
            next(me) = jnext
            head(deg) = me
C           ------------------------------
C           process next quasi dense row
C           ------------------------------
            me    = inext
            IF (me.NE.0) THEN
              IF (degree(me).GT.(totel+1) ) GOTO 51
            ENDIF
            head(totel) = me
C           ---------------------------------------
C           update dense row selection strategy
C           -------------------------------------
C   
            IF (iversion .EQ.1 ) THEN
             thresm = totel
            ELSE
             thresm=max(thresm*2,minden+(maxden-minden)/2)
C            THRESM = max(THRESM*2, MINDEN*2)
             thresm = min(thresm,nbd)
             IF (thresm.GE.nbd) thresm=totel
            ENDIF
            nbd    = nbed
C
            GOTO 30
          ENDIF
C         -------------------------------------------------------------
C         -------------------------------------------------------------
          IF (degree(me).EQ.totel+1) THEN
C         we have only  exactly "dense" rows that we
C         amalgamate at the root node
             IF (nbd.NE.nbed) THEN
                write(6,*) ' Internal ERROR quasi dense rows remains'
                CALL mumps_abort()
             ENDIF
C          1/ Go through all
C          non absorbed elements (root of the subgraph) 
C          and absorb in ME
C          2/ perform mass elimination of all dense rows
C          RMK: we could compute sum(NVPIV(d)) to check if = NBD
           nelme    = -(nel+1)
           DO 59 x=1,n
            IF ((pe(x).GT.0_8) .AND. (elen(x).LT.0)) THEN
C            X is an unabsorbed element
             pe(x) = int(-me,8)
C            W(X) = 0 could be suppressed ?? check it
            ELSEIF (degree(x).EQ.totel+1) THEN
C            X is a dense row, absorb it in ME (mass elimination)
             nel   = nel + nv(x)
             pe(x) = int(-me,8)
             elen(x) = 0
             nv(x) = 0
            ENDIF
   59      CONTINUE
C          ME is the root node
           elen(me) = nelme
           nv(me)   = nbd
           pe(me)   = 0_8
           IF (nel.NE.totel) THEN
            write(6,*) 'Internal ERROR 2 detected in QAMD'
            write(6,*) ' NEL not equal to N: N, NEL =',n,nel
            CALL mumps_abort()
           ENDIF
           GOTO 265
          ENDIF
        ENDIF
C       -------------------------------------------------------------
C       me represents the elimination of pivots nel+1 to nel+nv(me).
C       place me itself as the first in this set.  It will be moved
C       to the nel+nv(me) position when the permutation vectors are
C       computed.
C       -------------------------------------------------------------
        elenme = elen(me)
        elen(me) = - (nel + 1)
        nvpiv = nv(me)
        nel = nel + nvpiv
        ndense(me) = 0
C=======================================================================
C  CONSTRUCT NEW ELEMENT
C=======================================================================
C       -------------------------------------------------------------
C       At this point, me is the pivotal supervariable.  It will be
C       converted into the current element.  Scan list of the
C       pivotal supervariable, me, setting tree pointers and
C       constructing new list of supervariables for the new element,
C       me.  p is a pointer to the current position in the old list.
C       -------------------------------------------------------------
C       flag the variable "me" as being in Lme by negating nv (me)
        nv(me) = -nvpiv
        degme = 0
        IF (elenme .EQ. 0) THEN
C         ----------------------------------------------------------
C         construct the new element in place
C         ----------------------------------------------------------
          pme1 = pe (me)
          pme2 = pme1 - 1
          DO 60 p = pme1, pme1 + int(len(me) - 1,8)
            i = iw(p)
            nvi = nv(i)
            IF (nvi .GT. 0) THEN
C             ----------------------------------------------------
C             i is a principal variable not yet placed in Lme.
C             store i in new list
C             ----------------------------------------------------
              degme = degme + nvi
C             flag i as being in Lme by negating nv (i)
              nv(i) = -nvi
              pme2 = pme2 + 1_8
              iw(pme2) = i
C             ----------------------------------------------------
C             remove variable i from degree list.
C             ----------------------------------------------------
C             only done for non "dense" rows
              IF (degree(i).LE.totel) THEN
              ilast = last (i)
              inext = next(i)
              IF (inext .NE. 0) last(inext) = ilast
              IF (ilast .NE. 0) THEN
                 next(ilast) = inext
              ELSE
C               i is at the head of the degree list
                 head(degree(i)) = inext
              ENDIF
              ELSE
               ndense(me) = ndense(me) + nvi
              ENDIF
            ENDIF
   60     CONTINUE
C         this element takes no new memory in iw:
          newmem = 0
        ELSE
C         ----------------------------------------------------------
C         construct the new element in empty space, iw (pfree ...)
C         ----------------------------------------------------------
          p = pe(me)
          pme1 = pfree
          slenme = len(me) - elenme
          knt1_updated = 0
          DO 120 knt1 = 1, elenme + 1
            knt1_updated = knt1_updated +1
            IF (knt1 .GT. elenme) THEN
C             search the supervariables in me.
              e = me
              pj = p
              ln = slenme
            ELSE
C             search the elements in me.
              e = iw(p)
              p = p + 1
              pj = pe(e)
              ln = len(e)
            ENDIF
C           -------------------------------------------------------
C           search for different supervariables and add them to the
C           new list, compressing when necessary. this loop is
C           executed once for each element in the list and once for
C           all the supervariables in the list.
C           -------------------------------------------------------
            knt2_updated = 0
            DO 110 knt2 = 1, ln
              knt2_updated = knt2_updated+1
              i = iw(pj)
              pj = pj + 1
              nvi = nv(i)
              IF (nvi .GT. 0) THEN
C               -------------------------------------------------
C               compress iw, if necessary
C               -------------------------------------------------
                IF (pfree .GT. iwlen) THEN
C                 prepare for compressing iw by adjusting
C                 pointers and lengths so that the lists being
C                 searched in the inner and outer loops contain
C                 only the remaining entries.
                  pe(me) = p
                  len(me) = len(me) - knt1_updated
C                 Reset KNT1_UPDATED in case of recompress 
C                 at same iteration of the loop 120
                  knt1_updated = 0
C                 Check if anything left in supervariable ME
                  IF (len(me) .EQ. 0) pe(me) = 0_8
                  pe(e) = pj
                  len(e) = ln - knt2_updated
C                 Reset KNT2_UPDATED in case of recompress 
C                 at same iteration of the loop 110
                  knt2_updated = 0
C                 Check if anything left in element E
                  IF (len(e) .EQ. 0) pe(e) = 0_8
                  ncmpa = ncmpa + 1
C                 store first item in pe
C                 set first entry to -item
                  DO 70 j = 1, n
                    pn = pe(j)
                    IF (pn .GT. 0) THEN
                      pe(j) = int(iw(pn),8)
                      iw(pn) = -j
                    ENDIF
   70             CONTINUE
C                 psrc/pdst point to source/destination
                  pdst = 1
                  psrc = 1
                  pend = pme1 - 1
C                 while loop:
   80             CONTINUE
                  IF (psrc .LE. pend) THEN
C                   search for next negative entry
                    j = -iw(psrc)
                    psrc = psrc + 1
                    IF (j .GT. 0) THEN
                      iw(pdst) = int(pe(j))
                      pe(j) = pdst
                      pdst = pdst + 1_8
C                     copy from source to destination
                      lenj = len(j)
                      DO 90 knt3 = 0, lenj - 2
                        iw(pdst + knt3) = iw(psrc + knt3)
   90                 CONTINUE
                      pdst = pdst + lenj - 1
                      psrc = psrc + lenj - 1
                    ENDIF
                    GO TO 80
                  ENDIF
C                 move the new partially-constructed element
                  p1 = pdst
                  DO 100 psrc = pme1, pfree - 1
                    iw(pdst) = iw(psrc)
                    pdst = pdst + 1
  100             CONTINUE
                  pme1 = p1
                  pfree = pdst
                  pj = pe(e)
                  p = pe(me)
                ENDIF
C               -------------------------------------------------
C               i is a principal variable not yet placed in Lme
C               store i in new list
C               -------------------------------------------------
                degme = degme + nvi
C               flag i as being in Lme by negating nv (i)
                nv(i) = -nvi
                iw(pfree) = i
                pfree = pfree + 1
C               -------------------------------------------------
C               remove variable i from degree link list
C               -------------------------------------------------
C             only done for non "dense" rows
                IF (degree(i).LE.totel) THEN
                ilast = last(i)
                inext = next(i)
                IF (inext .NE. 0) last(inext) = ilast
                IF (ilast .NE. 0) THEN
                   next(ilast) = inext
                ELSE
C                 i is at the head of the degree list
                   head(degree(i)) = inext
                ENDIF
                ELSE
                 ndense(me) = ndense(me) + nvi
                ENDIF
              ENDIF
  110       CONTINUE
            IF (e .NE. me) THEN
C             set tree pointer and flag to indicate element e is
C             absorbed into new element me (the parent of e is me)
              pe(e) = int(-me,8)
              w(e) = 0
            ENDIF
  120     CONTINUE
          pme2 = pfree - 1_8
C         this element takes newmem new memory in iw (possibly zero)
          newmem = pfree - pme1
          mem = mem + newmem
          maxmem = max(maxmem, mem)
        ENDIF
C       -------------------------------------------------------------
C       me has now been converted into an element in iw (pme1..pme2)
C       -------------------------------------------------------------
C       degme holds the external degree of new element
        degree(me) = degme
        pe(me) = pme1
        len(me) = int(pme2 - pme1 + 1_8)
C       -------------------------------------------------------------
C       make sure that wflg is not too large.  With the current
C       value of wflg, wflg+n must not cause integer overflow
C       -------------------------------------------------------------
        IF (wflg .GT. maxint_n) THEN
          DO 130 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  130     CONTINUE
          wflg = 2
        ENDIF
C=======================================================================
C  COMPUTE (w (e) - wflg) = |Le\Lme| FOR ALL ELEMENTS
C=======================================================================
C       -------------------------------------------------------------
C       Scan 1:  compute the external degrees of previous elements
C       with respect to the current element.  That is:
C            (w (e) - wflg) = |Le \ Lme|
C       for each element e that appears in any supervariable in Lme.
C       The notation Le refers to the pattern (list of
C       supervariables) of a previous element e, where e is not yet
C       absorbed, stored in iw (pe (e) + 1 ... pe (e) + iw (pe (e))).
C       The notation Lme refers to the pattern of the current element
C       (stored in iw (pme1..pme2)).   If (w (e) - wflg) becomes
C       zero, then the element e will be absorbed in scan 2.
C       -------------------------------------------------------------
        DO 150 pme = pme1, pme2
          i = iw(pme)
          IF (degree(i).GT.totel) GOTO 150
          eln = elen(i)
          IF (eln .GT. 0) THEN
C           note that nv (i) has been negated to denote i in Lme:
            nvi = -nv(i)
            wnvi = wflg - nvi
            DO 140 p = pe(i), pe(i) + int(eln - 1,8)
              e = iw(p)
              we = w(e)
              IF (we .GE. wflg) THEN
C               unabsorbed element e has been seen in this loop
                we = we - nvi
              ELSE IF (we .NE. 0) THEN
C               e is an unabsorbed element
C               this is the first we have seen e in all of Scan 1
                we = degree(e) + wnvi - ndense(e)
              ENDIF
              w(e) = we
  140       CONTINUE
          ENDIF
  150   CONTINUE
C=======================================================================
C  DEGREE UPDATE AND ELEMENT ABSORPTION
C=======================================================================
C       -------------------------------------------------------------
C       Scan 2:  for each i in Lme, sum up the degree of Lme (which
C       is degme), plus the sum of the external degrees of each Le
C       for the elements e appearing within i, plus the
C       supervariables in i.  Place i in hash list.
C       -------------------------------------------------------------
        DO 180 pme = pme1, pme2
          i = iw(pme)
          IF (degree(i).GT.totel) GOTO 180
          p1 = pe(i)
          p2 = p1 + int(elen(i) - 1,8)
          pn = p1
          hash = 0_8
          deg = 0
C         ----------------------------------------------------------
C         scan the element list associated with supervariable i
C         ----------------------------------------------------------
          DO 160 p = p1, p2
            e = iw(p)
C           dext = | Le \ Lme |
            dext = w(e) - wflg
            IF (dext .GT. 0) THEN
              deg = deg + dext
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e,kind=8)
#if defined (NOAGG5)
C        ------------------------------
C        suppress aggressive absorption
C        ------------------------------
            ELSE IF (dext .EQ. 0) THEN
              iw(pn) = e
              pn = pn + 1
              hash = hash + int(e,kind=8)
#else
C
C        ------------------------------
C        try aggressive absorption 
C         when possible
C
            ELSE IF ((dext .EQ. 0) .AND.
     &                (ndense(me).EQ.nbd)) THEN
C             aggressive absorption: e is not adjacent to me, but
C             |Le(G') \ Lme(G')| is 0 and all dense rows
C             are in me, so absorb it into me
                pe(e) = int(-me,8)
                w(e)  = 0
            ELSE IF (dext.EQ.0) THEN
                  iw(pn) = e
                  pn     = pn+1
                  hash   = hash + int(e,kind=8)
#endif
            ENDIF
  160     CONTINUE
C         count the number of elements in i (including me):
          elen(i) = int(pn - p1 + 1)
C         ----------------------------------------------------------
C         scan the supervariables in the list associated with i
C         ----------------------------------------------------------
          p3 = pn
          DO 170 p = p2 + 1, p1 + int(len(i) - 1,8)
            j = iw(p)
            nvj = nv(j)
            IF (nvj .GT. 0) THEN
C             j is unabsorbed, and not in Lme.
C             add to degree and add to new list
C             add degree only of non-dense rows.
              IF (degree(j).LE.totel) deg=deg+nvj
              iw(pn) = j
              pn = pn + 1
              hash = hash + int(j,kind=8)
            ENDIF
  170     CONTINUE
C         ----------------------------------------------------------
C         update the degree and check for mass elimination
C         ----------------------------------------------------------
#if defined (NOAGG5)
          IF (deg.EQ.0.AND.(ndense(me).EQ.nbd).AND.(elen(i).GT.1)) THEN
C         When mass elimination will be performed then
C         absorb in ME all element adjacent to I
                   p1 = pe(i)
C                  exclude ME --> -2
                   p2 = p1 + int(elen(i),8) - 2_8
                   DO p =p1,p2  
                     e      = iw(p)
                     pe(e) = int(-me,8)
                     w(e)  = 0
                   ENDDO
          ENDIF
C              .... Ready for mass elimination
#endif
          IF ((deg .EQ. 0).AND.(ndense(me).EQ.nbd)) THEN
C           -------------------------------------------------------
C           mass elimination
C           -------------------------------------------------------
C           There is nothing left of this node except for an
C           edge to the current pivot element.  elen (i) is 1,
C           and there are no variables adjacent to node i.
C           Absorb i into the current pivot element, me.
            pe(i) = int(-me,8)
            nvi = -nv(i)
            degme = degme - nvi
            nvpiv = nvpiv + nvi
            nel = nel + nvi
            nv(i) = 0
            elen(i) = 0
          ELSE
C           -------------------------------------------------------
C           update the upper-bound degree of i
C           -------------------------------------------------------
C           the following degree does not yet include the size
C           of the current element, which is added later:
            degree(i) = min(deg+nbd-ndense(me), 
     &                       degree(i))
C           -------------------------------------------------------
C           add me to the list for i
C           -------------------------------------------------------
C           move first supervariable to end of list
            iw(pn) = iw(p3)
C           move first element to end of element part of list
            iw(p3) = iw(p1)
C           add new element to front of list.
            iw(p1) = me
C           store the new length of the list in len (i)
            len(i) = int(pn - p1 + 1)
C           -------------------------------------------------------
C           place in hash bucket.  Save hash key of i in last (i).
C           -------------------------------------------------------
            hash = mod(hash, hmod) + 1_8
            j = head(hash)
            IF (j .LE. 0) THEN
C             the degree list is empty, hash head is -j
              next(i) = -j
              head(hash) = -i
            ELSE
C             degree list is not empty
C             use last (head (hash)) as hash head
              next(i) = last (j)
              last(j) = i
            ENDIF
            last(i) = int(hash,kind=kind(last))
          ENDIF
  180   CONTINUE
        degree(me) = degme
C       -------------------------------------------------------------
C       Clear the counter array, w (...), by incrementing wflg.
C       -------------------------------------------------------------
        dmax = max(dmax, degme)
        wflg = wflg + dmax
C       make sure that wflg+n does not cause integer overflow
        IF (wflg .GT. maxint_n) THEN
          DO 190 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  190     CONTINUE
          wflg = 2
        ENDIF
C       at this point, w (1..n) .lt. wflg holds
C=======================================================================
C  SUPERVARIABLE DETECTION
C=======================================================================
        DO 250 pme = pme1, pme2
          i = iw(pme)
          IF ( (nv(i).LT.0) .AND. (degree(i).LE.totel) ) THEN
C           only done for nondense rows
C           i is a principal variable in Lme
C           -------------------------------------------------------
C           examine all hash buckets with 2 or more variables.  We
C           do this by examing all unique hash keys for super-
C           variables in the pattern Lme of the current element, me
C           -------------------------------------------------------
            hash = int(last(i),kind=8)
C           let i = head of hash bucket, and empty the hash bucket
            j = head(hash)
            IF (j .EQ. 0) GO TO 250
            IF (j .LT. 0) THEN
C             degree list is empty
              i = -j
              head(hash) = 0
            ELSE
C             degree list is not empty, restore last () of head
              i = last(j)
              last(j) = 0
            ENDIF
            IF (i .EQ. 0) GO TO 250
C           while loop:
  200       CONTINUE
            IF (next(i) .NE. 0) THEN
C             ----------------------------------------------------
C             this bucket has one or more variables following i.
C             scan all of them to see if i can absorb any entries
C             that follow i in hash bucket.  Scatter i into w.
C             ----------------------------------------------------
              ln = len(i)
              eln = elen(i)
C             do not flag the first element in the list (me)
              DO 210 p = pe(i) + 1, pe(i) + int(ln - 1,8)
                w(iw(p)) = wflg
  210         CONTINUE
C             ----------------------------------------------------
C             scan every other entry j following i in bucket
C             ----------------------------------------------------
              jlast = i
              j = next(i)
C             while loop:
  220         CONTINUE
              IF (j .NE. 0) THEN
C               -------------------------------------------------
C               check if j and i have identical nonzero pattern
C               -------------------------------------------------
C               jump if i and j do not have same size data structure
                IF (len(j) .NE. ln) GO TO 240
C               jump if i and j do not have same number adj elts
                IF (elen(j) .NE. eln) GO TO 240
C               do not flag the first element in the list (me)
                DO 230 p = pe(j) + 1, pe(j) + int(ln - 1,8)
C                 jump if an entry (iw(p)) is in j but not in i
                  IF (w(iw(p)) .NE. wflg) GO TO 240
  230           CONTINUE
C               -------------------------------------------------
C               found it!  j can be absorbed into i
C               -------------------------------------------------
                pe(j) = int(-i,8)
C               both nv (i) and nv (j) are negated since they
C               are in Lme, and the absolute values of each
C               are the number of variables in i and j:
                nv(i) = nv(i) + nv(j)
                nv(j) = 0
                elen(j) = 0
C               delete j from hash bucket
                j = next(j)
                next(jlast) = j
                GO TO 220
C               -------------------------------------------------
  240           CONTINUE
C               j cannot be absorbed into i
C               -------------------------------------------------
                jlast = j
                j = next(j)
              GO TO 220
              ENDIF
C             ----------------------------------------------------
C             no more variables can be absorbed into i
C             go to next i in bucket and clear flag array
C             ----------------------------------------------------
              wflg = wflg + 1
              i = next(i)
              IF (i .NE. 0) GO TO 200
            ENDIF
          ENDIF
  250   CONTINUE
C=======================================================================
C  RESTORE DEGREE LISTS AND REMOVE NONPRINCIPAL SUPERVAR. FROM ELEMENT
C=======================================================================
        p = pme1
        nleft = totel - nel
        DO 260 pme = pme1, pme2
          i = iw(pme)
          nvi = -nv(i)
          IF (nvi .GT. 0) THEN
C           i is a principal variable in Lme
C           restore nv (i) to signify that i is principal
            nv(i) = nvi
            IF (degree(i).LE.totel) THEN
C           -------------------------------------------------------
C           compute the external degree (add size of current elem)
C           -------------------------------------------------------
            deg = min(degree(i)+ degme - nvi, nleft - nvi)
            degree(i) = deg
            idense = .false.
C           
       IF ( (iversion .NE. 1).AND. (thresm.GE.0)) THEN
C           -------------------
C           Dense row detection
C           -------------------
C           DEGME is exact external degree of pivot ME |Le\Ve|, 
C           DEG is is approx external degree of I
C           Relaxed dense row selection based on:
C            1/ We want to avoid selecting dense  rows that are
C               almost completely represented by adj(ME)
C            1/ its density in reduced matrix and 
          IF (deg+nvi .GE. thresm) THEN
             IF (thresm.EQ.totel) THEN
C             We must be sure that I is exactly dense in reduced matrix
                IF ((elen(i).LE.2) .AND. ((deg+nvi).EQ.nleft) ) THEN
C              DEG approximation is exact and I is dense 
                   degree(i) = totel+1
                   idense = .true.
                ENDIF
             ELSE
C             relaxed dense row detection
                idense = .true.
                IF ((elen(i).LE.2).AND.((deg+nvi).EQ.nleft) ) THEN
                   degree(i) = totel+1
                ELSE
                   degree(i) = totel+1+degree(i)
                ENDIF
             ENDIF
          ENDIF
          IF (idense) THEN
C            update NDENSE of all elements in the list of element
C            adjacent to I (including ME).
             p1 = pe(i)
             p2 = p1 + int(elen(i) - 1,8)
             IF (p2.GE.p1) THEN
                DO 264 pj=p1,p2
                   e= iw(pj)
                   ndense(e) = ndense(e) + nvi
 264            CONTINUE
             ENDIF
C            insert I in the list of dense rows
             nbd = nbd+nvi
             deg = totel
             IF (degree(i).EQ.totel+1) THEN
c              insert I at the end of the list
                nbed = nbed +nvi
                IF (lastd.EQ.0) THEN
C                degree list is empty
                   lastd     = i
                   head(deg) = i
                   next(i)   = 0
                   last(i)   = 0
                ELSE
                   next(lastd) = i
                   last(i)     = lastd
                   lastd       = i
                   next(i)     = 0
                ENDIF
             ELSE
C              insert I at the beginning of the list
                inext = head(deg)
                IF (inext .NE. 0) last(inext) = i
                next(i) = inext
                head(deg) = i
                last(i)    = 0
                IF (lastd.EQ.0) lastd=i
             ENDIF
C            end of IDENSE=true
          ENDIF
C           end of THRESM>0
       ENDIF
C             
       IF (.NOT.idense) THEN
C           -------------------------------------------------------
C           place the supervariable at the head of the degree list
C           -------------------------------------------------------
          inext = head(deg)
          IF (inext .NE. 0) last(inext) = i
          next(i) = inext
          last(i) = 0
          head(deg) = i
       ENDIF
C           -------------------------------------------------------
C           save the new degree, and find the minimum degree
C           -------------------------------------------------------
       mindeg = min(mindeg, deg)
            ENDIF
C           -------------------------------------------------------
C           place the supervariable in the element pattern
C           -------------------------------------------------------
            iw(p) = i
            p = p + 1
          ENDIF
  260   CONTINUE
C=======================================================================
C  FINALIZE THE NEW ELEMENT
C=======================================================================
        nv(me) = nvpiv + degme
C       nv (me) is now the degree of pivot (including diagonal part)
C       save the length of the list for the new element me
        len(me) = int(p - pme1)
        IF (len(me) .EQ. 0) THEN
C         there is nothing left of the current pivot element
          pe(me) = 0_8
          w(me) = 0
        ENDIF
        IF (newmem .NE. 0) THEN
C         element was not constructed in place: deallocate part
C         of it (final size is less than or equal to newmem,
C         since newly nonprincipal variables have been removed).
          pfree = p
          mem = mem - newmem + int(len(me),8)
        ENDIF
C=======================================================================
C       END WHILE (selecting pivots)
      GO TO 30
      ENDIF
C=======================================================================
  265 CONTINUE
C=======================================================================
C  COMPUTE THE PERMUTATION VECTORS and update TREE
C=======================================================================
C     ----------------------------------------------------------------
C     The time taken by the following code is O(n).  At this
C     point, elen (e) = -k has been done for all elements e,
C     and elen (i) = 0 has been done for all nonprincipal
C     variables i.  At this point, there are no principal
C     supervariables left, and all elements are absorbed.
C     ----------------------------------------------------------------
C     ----------------------------------------------------------------
C     compute the ordering of unordered nonprincipal variables
C     ----------------------------------------------------------------
      DO 290 i = 1, n
        IF (elen(i) .EQ. 0) THEN
C         ----------------------------------------------------------
C         i is an un-ordered row.  Traverse the tree from i until
C         reaching an element, e.  The element, e, was the
C         principal supervariable of i and all nodes in the path
C         from i to when e was selected as pivot.
C         ----------------------------------------------------------
          j = int(-pe(i))
C         while (j is a variable) do:
  270     CONTINUE
            IF (elen(j) .GE. 0) THEN
              j = int(-pe(j))
              GO TO 270
            ENDIF
            e = j
C           ----------------------------------------------------------
C           get the current pivot ordering of e
C           ----------------------------------------------------------
            k = -elen(e)
C           ----------------------------------------------------------
C           traverse the path again from i to e, and compress the
C           path (all nodes point to e).  Path compression allows
C           this code to compute in O(n) time.  Order the unordered
C           nodes in the path, and place the element e at the end.
C           ----------------------------------------------------------
            j = i
C           while (j is a variable) do:
  280       CONTINUE
            IF (elen(j) .GE. 0) THEN
              jnext = int(-pe(j))
              pe(j) = int(-e,8)
              IF (elen(j) .EQ. 0) THEN
C               j is an unordered row
                elen(j) = k
                k = k + 1
              ENDIF
              j = jnext
            GO TO 280
            ENDIF
C         leave elen (e) negative, so we know it is an element
          elen(e) = -k
        ENDIF
  290 CONTINUE
      IF (compute_perm) THEN
C     ----------------------------------------------------------------
C     reset the inverse permutation (elen (1..n)) to be positive,
C     and compute the permutation (last (1..n)).
C     ----------------------------------------------------------------
      IF(compress) THEN
        last(1:n) = 0
        head(1:totel-n)=0  
        DO i = 1, n
          k = abs(elen(i))
          IF ( k <= n ) THEN
            last(k) = i
          ELSE
            head(k-n)=i
          ENDIF
        ENDDO
        i = 1
        DO k = 1, n
          IF(last(k) .NE. 0) THEN
            last(i) = last(k)
            elen(last(k)) = i
            i = i + 1
          ENDIF
        ENDDO
        DO k = n+1, totel
          IF (head(k-n) .NE. 0) THEN
            last(i)=head(k-n)
            elen(head(k-n)) = i
            i = i + 1
          ENDIF
        END DO
      ELSE
         DO 300 i = 1, n
            k = abs(elen(i))
            last(k) = i
            elen(i) = k
 300     CONTINUE
      ENDIF
C=======================================================================
C      END OF COMPUTING PERMUTATIONS
C=======================================================================
       ENDIF
C=======================================================================
C  RETURN THE MEMORY USAGE IN IW
C=======================================================================
C     If maxmem is less than or equal to iwlen, then no compressions
C     occurred, and iw (maxmem+1 ... iwlen) was unused.  Otherwise
C     compressions did occur, and iwlen would have had to have been
C     greater than or equal to maxmem for no compressions to occur.
C     Return the value of maxmem in the pfree argument.
      pfree = maxmem
C===============================
C     Save PE in PARENT array
      DO i=1,n
       parent(i) = int(pe(i))
      ENDDO
C===============================
      RETURN

mumps_symqamd()

subroutine mumps_symqamd	(	integer, intent(in)	thresh,
		integer, dimension(n), intent(out)	ndense,
		integer, intent(in)	n,
		integer, intent(in)	totel,
		integer(8), intent(in)	iwlen,
		integer(8), dimension(n), intent(inout)	pe,
		integer(8), intent(inout)	pfree,
		integer, dimension(n), intent(inout)	len,
		integer, dimension(iwlen), intent(inout)	iw,
		integer, dimension(n), intent(inout)	nv,
		integer, dimension(n), intent(out)	elen,
		integer, dimension(totel), intent(out)	last,
		integer, intent(out)	ncmpa,
		integer, dimension(n), intent(out)	degree,
		integer, dimension(totel), intent(out)	head,
		integer, dimension(n), intent(out)	next,
		integer, dimension(n), intent(out)	w,
		integer, dimension(n), intent(inout)	perm,
		integer, dimension(max(1,size_schur)), intent(in)	listvar_schur,
		integer, intent(in)	size_schur,
		logical, intent(in)	agg6,
		integer, dimension(n), intent(out)	parent )

Definition at line 8297 of file ana_orderings.F.

      IMPLICIT NONE
C     Input not modified
      INTEGER, INTENT(IN)    :: N, TOTEL, SIZE_SCHUR
      LOGICAL, INTENT(IN)    :: AGG6
      INTEGER, INTENT(IN)    :: THRESH
      INTEGER(8), INTENT(IN) :: IWLEN
      INTEGER, INTENT(IN)    :: LISTVAR_SCHUR(max(1,SIZE_SCHUR))
C     Input undefined on output 
      INTEGER, INTENT(INOUT)  :: LEN(N), IW(IWLEN)
C 
C     Output only 
      INTEGER, INTENT(OUT)   :: NCMPA
      INTEGER, INTENT(OUT)   :: ELEN(N), LAST(TOTEL), PARENT(N)
C 
C     Input/output
      INTEGER, INTENT(INOUT)    :: NV(N)
      INTEGER(8), INTENT(INOUT) :: PFREE
      INTEGER(8), INTENT(INOUT) :: PE(N)
      INTEGER, INTENT(INOUT)    :: PERM(N)
C 
C     Internal Workspace only
      INTEGER, INTENT(OUT) :: NDENSE(N), DEGREE(N), 
     &                        HEAD(TOTEL), NEXT(N), W(N)
C
C  =======================
C  INTERFACE DOCUMENTATION
C  SPECIFIC TO SYMQAMD.
C  =======================
C  (more details are sometimes
C   available in the
C   PREVIOUS DOCUMENTATION
C   section)
C
C N (in): the size of the matrix 
C         number of supervariables if blocked format
C TOTEL (in) : Number of variables to eliminate
C
C IWLEN (in): the length of the workspace IW
C
C PFREE (inout): says that IW(1:PFREE-1) contains the graph on input, see
C             below. (on output see meaning bellow)
C IW (inout):
C    On input, IW(1:PFREE-1) contains the orginal graph
C    On output it has been corrupted because IW(1:IWLEN) has been
C    used as workspace.
C
C LEN(inout):  On input, 
C       LEN (i) holds the number of entries in row i of the
C       matrix, excluding the diagonal.  The contents of LEN(1..N)
C       are undefined on output.
C
C PE(inout): On input PE(i) contains the pointers in IW to (the column
C       indices of) row i of the matrix.
C       On output it contains the tree:
C       - if I is a principal variable (NV(I) >0) then -pe(I) is the principal
C         variable of the father, or 0 if I is a root node.
C       - if I is a secondary variable (NV(I)=0) then -pe(I) is the principal
C         variable of the node it belongs to.
C
C       On output:  (PE is copied on output into PARENT array)
C
C  
C NV(inout): 
C          On input:  encoding of a blocked matrix 
C            if NV(1).NE.-1 the NV(I) holds the weight of node I. 
C          During execution, 
C            abs (nv (i)) is equal to the number of rows
C            that are represented by the principal supervariable i.  
C            If i is a nonprincipal variable, then nv (i) = 0.  
C            nv (i) .lt. 0 signifies that i is a
C            principal variable in the pattern Lme of the current pivot
C            element me. 
C          On output: 
C          - if i is a principal variable, NV(i) is the size of the front
C          in the multifrontal terminology.
C          - if i is a secondary variable, NV(i)=0
C
C PERM  (inout) : MUST BE SET TO HOLD THE POSITION OF VARIABLE I IN THE
C     PERMUTED ORDER.
C     PERM(I) = J means that I is the Jth pivot.
C     PERM IS NOT ALTERED IF SIZE_SCHUR = 0.
C     IF SIZE_SCHUR > 0 and variable I is part of the Schur,
C     then PERM(I) must be greater than N - SIZE_SCHUR.
C     In that case, PERM(I) is altered: it is set to N+1 internally !
C
C SIZE_SCHUR (in) :   > 0 means that the last SIZE_SCHUR variable 
C                in the order (such that PERM(I) >  N-SIZE_SCHUR) 
C                are part of the schur decompositon
C                and should remain ordered last and amalgamated
C                at the root of the elimination tree.
C
C LISTVAR_SCHUR(1:SIZE_SCHUR) (in): should be set on entry to the list of
C                variables (original indices) in the Schur complement
C
C THRESH (in): is used to set the local variable THRESM, corresponding
C      to the internal restarting feature.
C      <= 0 Recommended value. Automatic setting will be done.
C          Note that this does not correspond to the historical
C          documentation further below.
C       =  N Only exactly dense rows in the reduced matrix are selected.
C       >  1 and <= N THRESH correspond to the minimum density requirement.
C
C      At the moment if SIZE_SCHUR > 0 restarting functionality is disabled,
C      which means that performance is not optimal. It should work again with
C      a small modification but this has to be tested when it is re-enabled.
C
C ELEN (out) needs not be set on entry.
C      It contains the inverse
C      permutation on output. Not sure what it contains for the Schur
C      variables.
C      (it should be ok for the Schur too).
C
C LAST  used internally as working space; 
C       On output, last (1..n) holds the permutation,  i = last (k), then
C       row i is the kth pivot row.
C       Not used on output and 
C       Computation has been suppressed 
C       since in the context of blocked matrix format
C       one cannot so easily compute last out of elen 
C       (see end of MUMPS_QAMD in case of COMRPESS, 
C       because elen(i) \in [1:TOTEL] and not \in [1:N])
C
C AGG6 (in): controls if aggressive absorption should be authorized.
C
C  -------------------------------------------
C  ARGUMENTS USED INTERNALLY AS WORKARRAYS
C  Maybe some things are significant on output
C  but not in the normal cases of usage.
C  -------------------------------------------
C
C  NDENSE, LAST, NEXT, HEAD, DEGREE, W
C
C  ------
C  OUTPUT
C  ------
C
C  NCMPA (out): number of compressions.
C
C
C  ======================
C  PREVIOUS DOCUMENTATION
C  ======================
C
C NDENSE of an element is the number of dense rows in the element.
C-----------------------------------------------------------------------
C It is a modified version of MUMPS_QAMD
C designed to automatically detect and exploit dense or quasi dense 
C rows in the reduced matrix at any step of the minimum degree. 
C The input integer parameter THRESH defines the quasi density:
C THRESH : input parameter (not modified) 
C  THRESH is used to compute THRESM 
C   <=0 or N Only exactly dense rows in the reduced matrix are selected.
C   >1 and <=N THRESH correspond to the munimum density requirement.
C      Version 0: All dense and quasi dense rows are amalgamated at the 
C                 root node.
C      Version 1: Restart AMD with all quasi dense rows, and 
C                 increase density requirement.
C-----------------------------------------------------------------------
C Additionnal parameters/variables due to dense row manipulation:
C          
C Local variables:
C ---------------
      INTEGER THRESM, NDME, PERMeqN
      INTEGER NBD,NBED, NBDM, LASTD, NELME
      LOGICAL IDENSE
C THRESM : Local Integer holding a 
C          potentially modified value of THRESH.
C          When quasi dense rows are reintegrated in the 
C          graph to be processed then THRESM is modified.
C   Note that if one sets THRESM to negative value then
C       <0 Classical AMD algorithm (no dense row detection)
C NDME  : number of dense row adjacent to me
C NELME number of pivots selected when reching the root
C LASTD index of the last row in the list of dense rows
C NBD is the total number of dense rows selected 
C NBED is the total number of exactly dense rows detected. 
C NBDM is the maximum number of dense rows selected 
C IDENSE is used to indicate that the supervariable I is a dense or
C        quasi-dense row.
C-----------------------------------------------------------------------
C INPUT ARGUMENTS (unaltered):
C-----------------------------------------------------------------------
C n:    The matrix order.
C
C       Restriction:  n .ge. 1
C iwlen:        The length of iw (1..iwlen).  On input, the matrix is
C       stored in iw (1..pfree-1).  However, iw (1..iwlen) should be
C       slightly larger than what is required to hold the matrix, at
C       least iwlen .ge. pfree + n is recommended.  Otherwise,
C       excessive compressions will take place.
C       *** We do not recommend running this algorithm with ***
C       ***      iwlen .lt. pfree + n.                      ***
C       *** Better performance will be obtained if          ***
C       ***      iwlen .ge. pfree + n                       ***
C       *** or better yet                                   ***
C       ***      iwlen .gt. 1.2 * pfree                     ***
C       *** (where pfree is its value on input).            ***
C       The algorithm will not run at all if iwlen .lt. pfree-1.
C
C       Restriction: iwlen .ge. pfree-1
C-----------------------------------------------------------------------
C INPUT/OUPUT ARGUMENTS:
C-----------------------------------------------------------------------
C pe:   On input, pe (i) is the index in iw of the start of row i, or
C       zero if row i has no off-diagonal non-zeros.
C
C       During execution, it is used for both supervariables and
C       elements:
C
C       * Principal supervariable i:  index into iw of the
C               description of supervariable i.  A supervariable
C               represents one or more rows of the matrix
C               with identical nonzero pattern.
C       * Non-principal supervariable i:  if i has been absorbed
C               into another supervariable j, then pe (i) = -j.
C               That is, j has the same pattern as i.
C               Note that j might later be absorbed into another
C               supervariable j2, in which case pe (i) is still -j,
C               and pe (j) = -j2.
C       * Unabsorbed element e:  the index into iw of the description
C               of element e, if e has not yet been absorbed by a
C               subsequent element.  Element e is created when
C               the supervariable of the same name is selected as
C               the pivot.
C       * Absorbed element e:  if element e is absorbed into element
C               e2, then pe (e) = -e2.  This occurs when the pattern of
C               e (that is, Le) is found to be a subset of the pattern
C               of e2 (that is, Le2).  If element e is "null" (it has
C               no nonzeros outside its pivot block), then pe (e) = 0.
C
C       On output, pe holds the assembly tree/forest, which implicitly
C       represents a pivot order with identical fill-in as the actual
C       order (via a depth-first search of the tree).
C
C       On output:
C       If nv (i) .gt. 0, then i represents a node in the assembly tree,
C       and the parent of i is -pe (i), or zero if i is a root.
C       If nv (i) = 0, then (i,-pe (i)) represents an edge in a
C       subtree, the root of which is a node in the assembly tree.
C pfree:        On input, the matrix is stored in iw (1..pfree-1) and
C       the rest of the array iw is free.
C       During execution, additional data is placed in iw, and pfree
C       is modified so that components  of iw from pfree are free.
C       On output, pfree is set equal to the size of iw that
C       would have been needed for no compressions to occur.  If
C       ncmpa is zero, then pfree (on output) is less than or equal to
C       iwlen, and the space iw (pfree+1 ... iwlen) was not used.
C       Otherwise, pfree (on output) is greater than iwlen, and all the
C       memory in iw was used.
C-----------------------------------------------------------------------
C INPUT/MODIFIED (undefined on output):
C-----------------------------------------------------------------------
C len:  On input, len (i) holds the number of entries in row i of the
C       matrix, excluding the diagonal.  The contents of len (1..n)
C       are undefined on output.
C iw:   On input, iw (1..pfree-1) holds the description of each row i
C       in the matrix.  The matrix must be symmetric, and both upper
C       and lower triangular parts must be present.  The diagonal must
C       not be present.  Row i is held as follows:
C
C               len (i):  the length of the row i data structure
C               iw (pe (i) ... pe (i) + len (i) - 1):
C                       the list of column indices for nonzeros
C                       in row i (simple supervariables), excluding
C                       the diagonal.  All supervariables start with
C                       one row/column each (supervariable i is just
C                       row i).
C               if len (i) is zero on input, then pe (i) is ignored
C               on input.
C
C               Note that the rows need not be in any particular order,
C               and there may be empty space between the rows.
C
C       During execution, the supervariable i experiences fill-in.
C       This is represented by placing in i a list of the elements
C       that cause fill-in in supervariable i:
C
C               len (i):  the length of supervariable i
C               iw (pe (i) ... pe (i) + elen (i) - 1):
C                       the list of elements that contain i.  This list
C                       is kept short by removing absorbed elements.
C               iw (pe (i) + elen (i) ... pe (i) + len (i) - 1):
C                       the list of supervariables in i.  This list
C                       is kept short by removing nonprincipal
C                       variables, and any entry j that is also
C                       contained in at least one of the elements
C                       (j in Le) in the list for i (e in row i).
C
C       When supervariable i is selected as pivot, we create an
C       element e of the same name (e=i):
C
C               len (e):  the length of element e
C               iw (pe (e) ... pe (e) + len (e) - 1):
C                       the list of supervariables in element e.
C
C       An element represents the fill-in that occurs when supervariable
C       i is selected as pivot (which represents the selection of row i
C       and all non-principal variables whose principal variable is i).
C       We use the term Le to denote the set of all supervariables
C       in element e.  Absorbed supervariables and elements are pruned
C       from these lists when computationally convenient.
C
C       CAUTION:  THE INPUT MATRIX IS OVERWRITTEN DURING COMPUTATION.
C       The contents of iw are undefined on output.
C-----------------------------------------------------------------------
C OUTPUT (need not be set on input):
C-----------------------------------------------------------------------
C nv:   During execution, abs (nv (i)) is equal to the number of rows
C       that are represented by the principal supervariable i.  If i is
C       a nonprincipal variable, then nv (i) = 0.  Initially,
C       nv (i) = 1 for all i.  nv (i) .lt. 0 signifies that i is a
C       principal variable in the pattern Lme of the current pivot
C       element me.  On output, nv (e) holds the true degree of element
C       e at the time it was created (including the diagonal part).
C elen: See the description of iw above.  At the start of execution,
C       elen (i) is set to zero.  During execution, elen (i) is the
C       number of elements in the list for supervariable i.  When e
C       becomes an element, elen (e) = -nel is set, where nel is the
C       current step of factorization.  elen (i) = 0 is done when i
C       becomes nonprincipal.
C
C       For variables, elen (i) .ge. 0 holds until just before the
C       permutation vectors are computed.  For elements,
C       elen (e) .lt. 0 holds.
C
C       On output elen (1..n) holds the inverse permutation (the same
C       as the 'INVP' argument in Sparspak).  That is, if k = elen (i),
C       then row i is the kth pivot row.  Row i of A appears as the
C       (elen(i))-th row in the permuted matrix, PAP^T.
C last: In a degree list, last (i) is the supervariable preceding i,
C       or zero if i is the head of the list.  In a hash bucket,
C       last (i) is the hash key for i.  last (head (hash)) is also
C       used as the head of a hash bucket if head (hash) contains a
C       degree list (see head, below).
C
C       On output, last (1..n) holds the permutation (the same as the
C       'PERM' argument in Sparspak).  That is, if i = last (k), then
C       row i is the kth pivot row.  Row last (k) of A is the k-th row
C       in the permuted matrix, PAP^T.
C ncmpa:        The number of times iw was compressed.  If this is
C       excessive, then the execution took longer than what could have
C       been.  To reduce ncmpa, try increasing iwlen to be 10% or 20%
C       larger than the value of pfree on input (or at least
C       iwlen .ge. pfree + n).  The fastest performance will be
C       obtained when ncmpa is returned as zero.  If iwlen is set to
C       the value returned by pfree on *output*, then no compressions
C       will occur.
C-----------------------------------------------------------------------
C LOCAL (not input or output - used only during execution):
C-----------------------------------------------------------------------
C degree:       If i is a supervariable, then degree (i) holds the
C       current approximation of the external degree of row i (an upper
C       bound).  The external degree is the number of nonzeros in row i,
C       minus abs (nv (i)) (the diagonal part).  The bound is equal to
C       the external degree if elen (i) is less than or equal to two.
C
C       We also use the term "external degree" for elements e to refer
C       to |Le \ Lme|.  If e is an element, then degree (e) holds |Le|,
C       which is the degree of the off-diagonal part of the element e
C       (not including the diagonal part).
C degree (I) =N+1 if I is an exactly dense row in reduced matrix.
C            =N+1+LAST_approximate_external_deg of I   
C                      if I is a quasi dense row in reduced matrix.
C All dense or quasi dense rows are stored in the list pointed 
C       by head(n). Quasi-dense rows (degree(I)=n) are stored first, 
C       and are followed by exactly dense rows in the reduced matrix.
C       LASTD holds the last row in this list of dense rows or is zero
C       if the list is empty.
C head: head is used for degree lists.  head (deg) is the first
C       supervariable in a degree list (all supervariables i in a
C       degree list deg have the same approximate degree, namely,
C       deg = degree (i)).  If the list deg is empty then
C       head (deg) = 0.
C
C       During supervariable detection head (hash) also serves as a
C       pointer to a hash bucket.
C       If head (hash) .gt. 0, there is a degree list of degree hash.
C               The hash bucket head pointer is last (head (hash)).
C       If head (hash) = 0, then the degree list and hash bucket are
C               both empty.
C       If head (hash) .lt. 0, then the degree list is empty, and
C               -head (hash) is the head of the hash bucket.
C       After supervariable detection is complete, all hash buckets
C       are empty, and the (last (head (hash)) = 0) condition is
C       restored for the non-empty degree lists.
C next: next (i) is the supervariable following i in a link list, or
C       zero if i is the last in the list.  Used for two kinds of
C       lists:  degree lists and hash buckets (a supervariable can be
C       in only one kind of list at a time).
C w:    The flag array w determines the status of elements and
C       variables, and the external degree of elements.
C
C       for elements:
C          if w (e) = 0, then the element e is absorbed
C          if w (e) .ge. wflg, then w (e) - wflg is the size of
C               the set |Le \ Lme|, in terms of nonzeros (the
C               sum of abs (nv (i)) for each principal variable i that
C               is both in the pattern of element e and NOT in the
C               pattern of the current pivot element, me).
C          if wflg .gt. w (e) .gt. 0, then e is not absorbed and has
C               not yet been seen in the scan of the element lists in
C               the computation of |Le\Lme| in loop 150 below.
C
C       for variables:
C          during supervariable detection, if w (j) .ne. wflg then j is
C          not in the pattern of variable i
C
C       The w array is initialized by setting w (i) = 1 for all i,
C       and by setting wflg = 2.  It is reinitialized if wflg becomes
C       too large (to ensure that wflg+n does not cause integer
C       overflow).
C-----------------------------------------------------------------------
C LOCAL INTEGERS:
C-----------------------------------------------------------------------
C     THRESM is used to
C        accelerate symolic factorization 
C         THRESM is dynamically updated to 
C                allow more quasi-dense row selection
C     ThresPrev holds last starting value 
C                   at the beginning of one iteration
C     ThresMin  holds minimum value of THRESH 
      INTEGER :: FDEG, ThresMin, ThresPrev, IBEGSchur, NbSchur, 
     &        ThresMinINIT
      INTEGER :: DEGMAX,THD, THDperm, THD_AGG
      DOUBLE PRECISION :: RELDEN
      LOGICAL :: AGG6_loc, DenseRows
      LOGICAL :: SchurON
      INTEGER :: DEG, DEGME, DEXT, DMAX, E, ELENME, ELN, I,
     &        ILAST, INEXT, J, JLAST, JNEXT, K, KNT1, KNT2, KNT3,
     &        LENJ, LN, ME, MINDEG, NEL, 
     &        NLEFT, NVI, NVJ, NVPIV, SLENME, WE, WFLG, WNVI, X
      INTEGER KNT1_UPDATED, KNT2_UPDATED
      INTEGER :: SIZE_SCHUR_LOC
      INTEGER(8) MAXMEM, MEM, NEWMEM
      INTEGER :: MAXINT_N
      INTEGER(8) :: HASH, HMOD 
      LOGICAL :: COMPRESS
C deg:        the degree of a variable or element
C degme:      size, |Lme|, of the current element, me (= degree (me))
C dext:       external degree, |Le \ Lme|, of some element e
C dmax:       largest |Le| seen so far
C e:          an element
C elenme:     the length, elen (me), of element list of pivotal var.
C eln:        the length, elen (...), of an element list
C hash:       the computed value of the hash function
C hmod:       the hash function is computed modulo hmod = max (1,n-1)
C i:          a supervariable
C ilast:      the entry in a link list preceding i
C inext:      the entry in a link list following i
C j:          a supervariable
C jlast:      the entry in a link list preceding j
C jnext:      the entry in a link list, or path, following j
C k:          the pivot order of an element or variable
C knt1:       loop counter used during element construction
C knt2:       loop counter used during element construction
C knt3:       loop counter used during compression
C lenj:       len (j)
C ln:         length of a supervariable list
C maxint_n:   large integer to test risk of overflow on wflg
C maxmem:     amount of memory needed for no compressions
C me:         current supervariable being eliminated, and the
C                     current element created by eliminating that
C                     supervariable
C mem:        memory in use assuming no compressions have occurred
C mindeg:     current minimum degree
C nel:        number of pivots selected so far
C newmem:     amount of new memory needed for current pivot element
C nleft:      n - nel, the number of nonpivotal rows/columns remaining
C nvi:        the number of variables in a supervariable i (= nv (i))
C nvj:        the number of variables in a supervariable j (= nv (j))
C nvpiv:      number of pivots in current element
C slenme:     number of variables in variable list of pivotal variable
C we:         w (e)
C wflg:       used for flagging the w array.  See description of iw.
C wnvi:       wflg - nv (i)
C x:          either a supervariable or an element
C-----------------------------------------------------------------------
C LOCAL POINTERS:
C-----------------------------------------------------------------------
      INTEGER(8) P, P1, P2, P3, PDST, PEND, PJ, PME, PME1, PME2, 
     &           PN, PSRC, PLN, PELN
C             Any parameter (pe (...) or pfree) or local variable
C             starting with "p" (for Pointer) is an index into iw,
C             and all indices into iw use variables starting with
C             "p."  The only exception to this rule is the iwlen
C             input argument.
C p:          pointer into lots of things
C p1:         pe (i) for some variable i (start of element list)
C p2:         pe (i) + elen (i) -  1 for some var. i (end of el. list)
C p3:         index of first supervariable in clean list
C pdst:       destination pointer, for compression
C pend:       end of memory to compress
C pj:         pointer into an element or variable
C pme:        pointer into the current element (pme1...pme2)
C pme1:       the current element, me, is stored in iw (pme1...pme2)
C pme2:       the end of the current element
C pn:         pointer into a "clean" variable, also used to compress
C psrc:       source pointer, for compression
C-----------------------------------------------------------------------
C  FUNCTIONS CALLED:
C-----------------------------------------------------------------------
      INTRINSIC max, min, mod, maxval
C=======================================================================
C  INITIALIZATIONS
C=======================================================================
      IF (n.EQ.1) THEN
           elen(1) = 1
           last(1) = 1
           pe(1) = 0_8
           IF (nv(1).LT.0) nv(1) = 1
           ncmpa = 0
           parent(1) = 0
           RETURN
      ENDIF
      agg6_loc = agg6
      denserows = .false.
C
C       We can now assume that N>1
C
CSymbolic  Intialize degrees with the order given by PERM
C
      size_schur_loc = size_schur
      size_schur_loc = min(n,size_schur_loc)
      size_schur_loc = max(0,size_schur_loc)
      schuron   = (size_schur_loc > 0)
      ibegschur = n-size_schur_loc+1
      thresm    = thresh  ! local value of THRESH
      IF (thresm.GT.n) thresm = n
      IF (thresm.LT.0) thresm = 0
C     Variables in the schur are considered as exactly dense
C     (Schur variables are ordered last, we check it here)
      IF ( schuron )  THEN 
           DO i= 1, n
             IF ( perm(i) .GE. ibegschur) THEN 
                 perm(i) = n + 1
C               Because of compress, we force skipping this
C               entry which is anyway empty
                IF (len(i) .EQ.0) THEN
                  pe(i) = 0_8
                ENDIF
             ENDIF
           ENDDO
      ENDIF
C          
      IF (schuron) THEN
C
C         Only restriction is n>= THRESM > 0 
C
C         only exactly dense row will be selected
C         It should also work ok combined to 
C         quasi dense row selection. 
C           (To be Tested it seperately)
             thresm    = n
             thresmin  = n
             thresprev = n
      ELSE
             thresm    = max(int(31*n/32),thresm)
             thresm    = max(thresm,1)
C
             degmax= maxval(len)
             relden=dble(pfree-1)/dble(n)
             thd = int(relden)*10 + (degmax-int(relden))/10 + 1
             IF (thd.LT.degmax) THEN
              denserows = .true.
              thdperm = n  
              DO i = 1,n
               IF (len(i) .GT. thd) THEN
                thdperm =  min(thdperm,perm(i))
               ENDIF
              ENDDO
              thresm  = min(thresm, thdperm)
             ENDIF
C   Compute ThresMin and initialise  ThresPrev
             thresmin  = max( 3*thresm / 4, 1)
             thresprev = thresm
C
      ENDIF  ! test on SchurON
C
      thresmininit = thresmin/4
      thd_agg = max(128, min(totel/2048, 1024))
      IF (thresm.GT.0) THEN
       IF ((thresm.GT.n).OR.(thresm.LT.2)) THEN 
C      exactly dense rows only
          thresm = n
       ENDIF
      ENDIF
      lastd = 0
      nbd   = 0
      nbed  = 0
      nbdm  = 0
      wflg = 2
      maxint_n=huge(wflg)-totel
      mindeg = 1
      ncmpa = 0
      nel = 0
      hmod = int(max(1, n-1),kind=8)
      dmax = 0
      mem = pfree - 1
      maxmem = mem
      DO i = 1, n
        ndense(i)= 0
        w(i) = 1
        elen(i) = 0
C        NV (I) = 1
C        DEGREE (I) = LEN (I)
      ENDDO
      DO i=1, n
        last(i) = 0
        head(i) = 0
      ENDDO
C     initialize degree
      IF(nv(1) .LT. 0) THEN
         compress = .false.
      ELSE
         compress = .true.
      ENDIF
      IF (compress) THEN
         DO i=1,n
            degree(i) = 0
            DO p= pe(i) , pe(i)+int(len(i)-1,8)
               degree(i) = degree(i) + nv(iw(p))
            ENDDO
         ENDDO
      ELSE
         DO i=1,n
            nv(i) = 1
            degree(i) = len(i)
         ENDDO
      ENDIF
C     ----------------------------------------------------------------
C     initialize degree lists and eliminate rows with no off-diag. nz.
C     ----------------------------------------------------------------
      DO 20 i = 1, n
        deg = degree(i)
        IF (perm(i).EQ.n) THEN
C          save that I is last in the order
           permeqn = i
           perm(i) = n-1
        ENDIF
        fdeg = perm(i)
        IF ( (deg .GT. 0).OR.(perm(i).EQ.n+1) ) THEN
C         ----------------------------------------------------------
C         place i in the degree list corresponding to its degree
C         or in the dense row list if i is dense or quasi dense.
C         ----------------------------------------------------------
C         test for row density
          IF ( (thresm.GT.0) .AND.
     &         (fdeg .GT.thresm) ) THEN
C           I will be inserted in the degree list of N
            nbd = nbd+nv(i)
            IF (fdeg.NE.n+1) THEN
C
             degree(i) = degree(i)+totel+2
C            insert I at the beginning of degree list of n
             deg = n
             inext = head(deg)
             IF (inext .NE. 0) last(inext) = i
             next(i) = inext
             head(deg) = i 
             last(i)  = 0
             IF (lastd.EQ.0) lastd=i
            ELSE
C            Only Schur variables are concerned here
C            Property: LISTVAR_SCHUR (1) will 
C            be first in the list of schur variables
             nbed = nbed+nv(i)
             degree(i) = totel+1
C            insert I at the end of degree list of n
             deg = n
             IF (lastd.EQ.0) THEN
C              degree list is empty
               lastd     = i 
               head(deg) = i
               next(i)   = 0 
               last(i)   = 0
             ELSE
               next(lastd) = i
               last(i)     = lastd
               lastd       = i
               next(i)     = 0
             ENDIF
            ENDIF
          ELSE
C           place i in the degree list corresponding to its degree
            inext = head(fdeg)
            IF (inext .NE. 0) last(inext) = i
            next(i) = inext
            head(fdeg) = i
          ENDIF
        ELSE
C         ----------------------------------------------------------
C         we have a variable that can be eliminated at once because
C         there is no off-diagonal non-zero in its row.
C         ----------------------------------------------------------
          nel = nel + nv(i)
          elen(i) = -nel
          pe (i) = 0_8
          w(i) = 0
        ENDIF
   20 CONTINUE
C         We suppress dense row selection if none of them was found in A 
C         in the 1st pass
          IF ((nbd.EQ.0).AND.(thresm.GT.0)) thresm = n
C
C=======================================================================
C  WHILE (selecting pivots) DO
C=======================================================================
   30 IF (nel .LT. totel) THEN
C=======================================================================
C  GET PIVOT OF MINIMUM DEGREE
C=======================================================================
C       -------------------------------------------------------------
C       find next supervariable for elimination
C       -------------------------------------------------------------
        DO 40 deg = mindeg, n
          me = head(deg)
          IF (me .GT. 0) GO TO 50
   40   CONTINUE
   50   mindeg = deg
C       -------------------------------------------------------------
C       We want to respect the ordering provided by the user
C       Therefefore if (DEG > THRESM .and. NBD.ge.0) then 
C       A quasi-dense variable might have a perm value 
C       smaller than ME. 
C       We thus in this case force restarting.
C       -------------------------------------------------------------
        IF ( (deg.NE.n) .AND.
     &    (deg.GT.thresm+1) .AND. (nbd.GT.0) ) THEN
           mindeg = n
           GOTO 30
        ENDIF
        IF (degree(me).LE.totel)  THEN
C       -------------------------------------------------------------
C       remove chosen variable from link list
C       -------------------------------------------------------------
          inext = next(me)
          IF (inext .NE. 0) last(inext) = 0
          head(deg) = inext
        ELSE
C
C         Because of restarting forced even if 
C         variable (not yet quasi dense) but of 
C         value of perm larger than thresm still
C         to be eliminated we have to reset MINDEB to 1
          mindeg = 1
          nbdm = max(nbdm,nbd)
          IF (degree(me).GT.totel+1) THEN
            IF (wflg .GT. maxint_n) THEN
             DO  52 x = 1, n
              IF (w(x) .NE. 0) w(x) = 1
  52         CONTINUE
             wflg = 2
            ENDIF
            wflg = wflg + 1
  51        CONTINUE
C           ---------------------------------------------------------
C           remove chosen variable from link list
C           ---------------------------------------------------------
            inext = next(me)
            IF (inext .NE. 0) THEN 
               last(inext) = 0
            ELSE
               lastd = 0
            ENDIF
C           ----------------------------------------------------------
c           build adjacency list of ME in quotient gragh
C           and calculate its external degree  in ndense(me)
C           ----------------------------------------------------------
            ndense(me) = 0
            w(me)      = wflg
            p1 = pe(me)
            p2 = p1 + int(len(me) -1,8)
C           PLN-1 holds the pointer in IW to the last elet/var in adj list
C              of ME.  LEN(ME) will then be set to PLN-P1
C           PELN-1 hold the pointer in IW to the last elet in in adj list
C              of ME.  ELEN(ME) will then be set to PELN-P1
C           element adjacent to ME
            pln       = p1
            peln      = p1
            DO 55 p=p1,p2
              e= iw(p)
              IF (w(e).EQ.wflg) GOTO 55
              w(e) = wflg
              IF (pe(e).LT.0_8) THEN
C              E is a nonprincipal variable or absorbed element
                x = e
  53            x = int(-pe(x))
                IF (w(x) .EQ.wflg) GOTO 55
                w(x) = wflg
                IF ( pe(x) .LT. 0_8 ) GOTO 53
                e = x
              ENDIF
C             -------------------------------------------
C             E is an unabsorbed element or a "dense" row
C                 (NOT already flagged)
C             -------------------------------------------
              IF (elen(e).LT.0) THEN
C              E is a new element in adj(ME)
               ndense(e) = ndense(e) - nv(me)
               iw(pln) = iw(peln)  
               iw(peln) = e
               pln  = pln+1_8
               peln = peln + 1_8
C              update ndense of ME with all unflagged dense
C              rows in E
               pme1 = pe(e)
               DO 54 pme = pme1, pme1+int(len(e)-1,8)
                x = iw(pme)
                IF ((elen(x).GE.0).AND.(w(x).NE.wflg)) THEN
C                X is a dense row 
                 ndense(me) = ndense(me) + nv(x)
                 w(x) = wflg
                ENDIF
 54            CONTINUE
              ELSE
C              E is a dense row 
               ndense(me) = ndense(me) + nv(e)
               iw(pln)=e
               pln = pln+1_8
              ENDIF
  55        CONTINUE
C           ----------------------------------------------
C           DEGREE(ME)-(TOTEL+2) holds last external degree computed
C           when Me was detected as dense
C           NDENSE(ME) is the exact external degree of ME
C           ----------------------------------------------
            wflg     = wflg + 1
            len(me)  = int(pln-p1)
            elen(me) = int(peln-p1)
            ndme = ndense(me)+nv(me)
            IF (ndense(me).EQ.0) ndense(me) =1
C           ---------------------------------------------------------
C           place ME in the degree list of NDENSE(ME), update DEGREE
C           ---------------------------------------------------------
            degree(me) = ndense(me)
            deg = perm(me)
            mindeg = min(deg,mindeg)
            jnext = head(deg)
            IF (jnext.NE. 0) last(jnext) = me
            next(me) = jnext
            head(deg) = me
C           ------------------------------
C           process next quasi dense row
C           ------------------------------
            me    = inext
            IF (me.NE.0) THEN
              IF (degree(me).GT.(totel+1) ) GOTO 51
            ENDIF
            head(n) = me
C           ---------------------------------------
C           update dense row selection strategy
C           -------------------------------------
            IF (thresm.LT.n) THEN
             thresmin  = max(thresm+thresmin,thresprev+thresmin/2+1)
             thresmin  = min(thresmin, n)
             thresprev = thresprev+(n-thresprev)/2+thresmininit
             thresm    = max(
     &         thresm + int(sqrt(dble(thresmin)))+ thresmininit ,
     &         thresprev)
             thresm    = min(thresm,n) 
             thresmin  = min(thresm, thresmin)
             thresprev = thresm
            ENDIF
            nbd    = nbed
C           get back to Min degree elimination loop
C
            GOTO 30
          ENDIF
C         -------------------------------------------------------------
C         -------------------------------------------------------------
          IF (degree(me).EQ.totel+1) THEN
C         we have only  exactly "dense" rows that we
C         amalgamate at the root node
             IF (nbd.NE.nbed) THEN
          write(6,*) ' ERROR in MUMPS_SYMQAMD quasi dense rows remains'
          CALL mumps_abort()
           ENDIF
           nbschur = 0   ! Only for checking
           nelme    = -(nel+1)
           DO 59 x=1,n
            IF ((pe(x).GT.0) .AND. (elen(x).LT.0)) THEN
              pe(x) = int(-listvar_schur(1),8)
            ELSE IF ((pe(x).GT.0) .AND. (elen(x).LT.0)) THEN
C            X is an unabsorbed element
C            -- Force sons to be linked to first node in Schur
             pe(x) = int(-listvar_schur(1),8)
C            W(X) = 0 could be suppressed ?? check it
            ELSEIF (degree(x).EQ.totel+1) THEN
C            X is a dense row, absorb it in ME (mass elimination)
             nel   = nel + nv(x)
             pe(x) = int(-me,8)
             elen(x) = 0
             nv(x) = 0
             nbschur = nbschur+ 1
            ENDIF
   59      CONTINUE
           IF (nbschur.NE.size_schur_loc) then
             write(6,*) ' Internal error 2 in QAMD :',
     &         ' Schur size expected:',size_schur_loc, 'Real:', nbschur
             CALL mumps_abort()
           ENDIF
C          ME is the root node
           elen(me) = nelme
           nv(me)   = nbd
           pe(me)   = 0_8
           IF (nel.NE.n) THEN
            write(6,*) 'Internal ERROR 2 detected in QAMD'
            write(6,*) ' NEL not equal to N: N, NEL =',n,nel
            CALL mumps_abort()
           ENDIF
           IF (me.NE. listvar_schur(1)) THEN
C          -- Set all node in Schur list to point to LISTVAR_SCHUR(1)
             DO i=1, size_schur_loc
               pe(listvar_schur(i)) = int(-listvar_schur(1),8)
             ENDDO
             pe(listvar_schur(1)) = 0_8
             nv( listvar_schur(1))= nv(me)
             nv(me)               = 0
             elen( listvar_schur(1)) = elen(me)
             elen(me)             = 0
           ENDIF
           GOTO 265
          ENDIF
        ENDIF
C       -------------------------------------------------------------
C       me represents the elimination of pivots nel+1 to nel+nv(me).
C       place me itself as the first in this set.  It will be moved
C       to the nel+nv(me) position when the permutation vectors are
C       computed.
C       -------------------------------------------------------------
        elenme = elen(me)
        elen(me) = - (nel + 1)
        nvpiv = nv(me)
        nel = nel + nvpiv
        ndense(me) = 0
C=======================================================================
C  CONSTRUCT NEW ELEMENT
C=======================================================================
C       -------------------------------------------------------------
C       At this point, me is the pivotal supervariable.  It will be
C       converted into the current element.  Scan list of the
C       pivotal supervariable, me, setting tree pointers and
C       constructing new list of supervariables for the new element,
C       me.  p is a pointer to the current position in the old list.
C       -------------------------------------------------------------
C       flag the variable "me" as being in Lme by negating nv (me)
        nv(me) = -nvpiv
        degme = 0
        IF (elenme .EQ. 0) THEN
C         ----------------------------------------------------------
C         construct the new element in place
C         ----------------------------------------------------------
          pme1 = pe(me)
          pme2 = pme1 - 1
          DO 60 p = pme1, pme1 + int(len(me) - 1,8)
            i = iw(p)
            nvi = nv(i)
            IF (nvi .GT. 0) THEN
C             ----------------------------------------------------
C             i is a principal variable not yet placed in Lme.
C             store i in new list
C             ----------------------------------------------------
              degme = degme + nvi
C             flag i as being in Lme by negating nv (i)
              nv(i) = -nvi
              pme2 = pme2 + 1
              iw(pme2) = i
C             ----------------------------------------------------
C             remove variable i from degree list.
C             ----------------------------------------------------
C             only done for non "dense" rows
              IF (degree(i).LE.totel) THEN
              ilast = last(i)
              inext = next(i)
              IF (inext .NE. 0) last(inext) = ilast
              IF (ilast .NE. 0) THEN
                next(ilast) = inext
              ELSE
C               i is at the head of the degree list
                head(perm(i)) = inext
              ENDIF
              ELSE
               ndense(me) = ndense(me) + nvi
              ENDIF
            ENDIF
   60     CONTINUE
C         this element takes no new memory in iw:
          newmem = 0
        ELSE
C         ----------------------------------------------------------
C         construct the new element in empty space, iw (pfree ...)
C         ----------------------------------------------------------
          p = pe(me)
          pme1 = pfree
          slenme = len(me) - elenme
          knt1_updated = 0
          DO 120 knt1 = 1, elenme + 1
            knt1_updated = knt1_updated +1
            IF (knt1 .GT. elenme) THEN
C             search the supervariables in me.
              e = me
              pj = p
              ln = slenme
            ELSE
C             search the elements in me.
              e = iw(p)
              p = p + 1
              pj = pe(e)
              ln = len(e)
            ENDIF
C           -------------------------------------------------------
C           search for different supervariables and add them to the
C           new list, compressing when necessary. this loop is
C           executed once for each element in the list and once for
C           all the supervariables in the list.
C           -------------------------------------------------------
            knt2_updated = 0
            DO 110 knt2 = 1, ln
              knt2_updated = knt2_updated+1
              i = iw(pj)
              pj = pj + 1
              nvi = nv(i)
              IF (nvi .GT. 0) THEN
C               -------------------------------------------------
C               compress iw, if necessary
C               -------------------------------------------------
                IF (pfree .GT. iwlen) THEN
C                 prepare for compressing iw by adjusting
C                 pointers and lengths so that the lists being
C                 searched in the inner and outer loops contain
C                 only the remaining entries.
                  pe(me) = p
                  len(me) = len(me) - knt1_updated
C                 Reset KNT1_UPDATED in case of recompress 
C                 at same iteration of the loop 120
                  knt1_updated = 0
C                 Check if anything left in supervariable ME
                  IF (len(me) .EQ. 0) pe(me) = 0
                  pe(e) = pj
                  len(e) = ln - knt2_updated
C                 Reset KNT2_UPDATED in case of recompress 
C                 at same iteration of the loop 110
                  knt2_updated = 0
C                 Check if anything left in element E
                  IF (len(e) .EQ. 0) pe(e) = 0
                  ncmpa = ncmpa + 1
C                 store first item in pe
C                 set first entry to -item
                  DO 70 j = 1, n
                    pn = pe(j)
                    IF (pn .GT. 0) THEN
                      pe(j) = int(iw(pn),8)
                      iw(pn) = -j
                    ENDIF
   70             CONTINUE
C                 psrc/pdst point to source/destination
                  pdst = 1
                  psrc = 1
                  pend = pme1 - 1
C                 while loop:
   80             CONTINUE
                  IF (psrc .LE. pend) THEN
C                   search for next negative entry
                    j = -iw(psrc)
                    psrc = psrc + 1
                    IF (j .GT. 0) THEN
                      iw(pdst) = int(pe(j))
                      pe(j) = pdst
                      pdst = pdst + 1
C                     copy from source to destination
                      lenj = len(j)
                      DO 90 knt3 = 0, lenj - 2
                        iw(pdst + knt3) = iw(psrc + knt3)
   90                 CONTINUE
                      pdst = pdst + lenj - 1
                      psrc = psrc + lenj - 1
                    ENDIF
                    GO TO 80
                  ENDIF
C                 move the new partially-constructed element
                  p1 = pdst
                  DO 100 psrc = pme1, pfree - 1
                    iw(pdst) = iw(psrc)
                    pdst = pdst + 1
  100             CONTINUE
                  pme1 = p1
                  pfree = pdst
                  pj = pe(e)
                  p = pe(me)
                ENDIF
C               -------------------------------------------------
C               i is a principal variable not yet placed in Lme
C               store i in new list
C               -------------------------------------------------
                degme = degme + nvi
C               flag i as being in Lme by negating nv (i)
                nv(i) = -nvi
                iw(pfree) = i
                pfree = pfree + 1
C               -------------------------------------------------
C               remove variable i from degree link list
C               -------------------------------------------------
C             only done for non "dense" rows
                IF (degree(i).LE.totel) THEN
                ilast = last(i)
                inext = next(i)
                IF (inext .NE. 0) last(inext) = ilast
                IF (ilast .NE. 0) THEN
                  next(ilast) = inext
                ELSE
C                 i is at the head of the degree list
                  head(perm(i)) = inext
                ENDIF
                ELSE
                 ndense(me) = ndense(me) + nvi
                ENDIF
              ENDIF
  110       CONTINUE
            IF (e .NE. me) THEN
C             set tree pointer and flag to indicate element e is
C             absorbed into new element me (the parent of e is me)
              pe(e) = int(-me,8)
              w(e) = 0
            ENDIF
  120     CONTINUE
          pme2 = pfree - 1
C         this element takes newmem new memory in iw (possibly zero)
          newmem = pfree - pme1
          mem = mem + newmem
          maxmem = max(maxmem, mem)
        ENDIF
C       -------------------------------------------------------------
C       me has now been converted into an element in iw (pme1..pme2)
C       -------------------------------------------------------------
C       degme holds the external degree of new element
        degree(me) = degme
        pe(me) = pme1
        len(me) = int(pme2 - pme1 + 1_8)
C       -------------------------------------------------------------
C       make sure that wflg is not too large.  With the current
C       value of wflg, wflg+n must not cause integer overflow
C       -------------------------------------------------------------
        IF (wflg .GT. maxint_n) THEN
          DO 130 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  130     CONTINUE
          wflg = 2
        ENDIF
C=======================================================================
C  COMPUTE (w (e) - wflg) = |Le\Lme| FOR ALL ELEMENTS
Cdense
C   COMPUTE (w(e) - wflg) = |Le(G')\Lme(G')| FOR ALL ELEMENTS
C   where G' is the subgraph of G excluding ''dense" rows)
Cdense
C=======================================================================
C       -------------------------------------------------------------
C       Scan 1:  compute the external degrees of previous elements
C       with respect to the current element.  That is:
C            (w (e) - wflg) = |Le \ Lme|
C       for each element e that appears in any supervariable in Lme.
C       The notation Le refers to the pattern (list of
C       supervariables) of a previous element e, where e is not yet
C       absorbed, stored in iw (pe (e) + 1 ... pe (e) + iw (pe (e))).
C       The notation Lme refers to the pattern of the current element
C       (stored in iw (pme1..pme2)).   If (w (e) - wflg) becomes
C       zero, then the element e will be absorbed in scan 2.
C       aggressive absorption is possible only if NDENSE(ME) = NBD
C       which is true when only exactly dense rows have been selected.
C       -------------------------------------------------------------
        DO 150 pme = pme1, pme2
          i = iw(pme)
          IF (degree(i).GT.totel) GOTO 150
          eln = elen(i)
          IF (eln .GT. 0) THEN
C           note that nv (i) has been negated to denote i in Lme:
            nvi = -nv(i)
            wnvi = wflg - nvi
            DO 140 p = pe(i), pe(i) + int(eln - 1,8)
              e = iw(p)
              we = w(e)
              IF (we .GE. wflg) THEN
C               unabsorbed element e has been seen in this loop
                we = we - nvi
              ELSE IF (we .NE. 0) THEN
C               e is an unabsorbed element
C               this is the first we have seen e in all of Scan 1
                we = degree(e) + wnvi - ndense(e)
Cn dense
              ENDIF
              w(e) = we
  140       CONTINUE
          ENDIF
  150   CONTINUE
C=======================================================================
C  DEGREE UPDATE AND ELEMENT ABSORPTION
C=======================================================================
C       -------------------------------------------------------------
C       Scan 2:  for each i in Lme, sum up the degree of Lme (which
C       is degme), plus the sum of the external degrees of each Le
C       for the elements e appearing within i, plus the
C       supervariables in i.  Place i in hash list.
C       -------------------------------------------------------------
        agg6_loc = (agg6 .OR. (degree(me) .LT. thd_agg))
        DO 180 pme = pme1, pme2
          i = iw(pme)
          IF (degree(i).GT.totel) GOTO 180
          p1 = pe(i)
          p2 = p1 + int(elen(i) - 1,8)
          pn = p1
          hash = 0_8
          deg = 0
C         ----------------------------------------------------------
C         scan the element list associated with supervariable i
C         ----------------------------------------------------------
          DO 160 p = p1, p2
            e = iw(p)
C           dext = | Le \ Lme |
            dext = w(e) - wflg
            IF (dext .GT. 0) THEN
              deg = deg + dext
              iw(pn) = e
              pn = pn + 1_8
              hash = hash + int(e,kind=8)
C        ------------------------------
C        suppress aggressive absorption
C        ------------------------------
            ELSE IF (.NOT. agg6_loc .AND. dext .EQ. 0) THEN
              iw(pn) = e
              pn = pn + 1_8
              hash = hash + int(e,kind=8)
C
C        ------------------------------
C        try aggressive absorption
C         when possible
            ELSE IF (agg6_loc .AND. (dext .EQ. 0) .AND.
     &            ((ndense(me).EQ.nbd).OR.(ndense(e).EQ.0))) THEN
C             aggressive absorption: e is not adjacent to me, but
C             |Le(G') \ Lme(G')| is 0 and all dense rows
C             are in me, so absorb it into me
                pe(e) = int(-me,8)
                w(e)  = 0
             ELSE IF (agg6_loc .AND. dext.EQ.0) THEN
                  iw(pn) = e
                  pn     = pn+1
                  hash   = hash + int(e,kind=8)
            ENDIF
  160     CONTINUE
C         count the number of elements in i (including me):
          elen(i) = int(pn - p1 + 1)
C         ----------------------------------------------------------
C         scan the supervariables in the list associated with i
C         ----------------------------------------------------------
          p3 = pn
          DO 170 p = p2 + 1, p1 + int(len(i) - 1,8)
            j = iw(p)
            nvj = nv(j)
            IF (nvj .GT. 0) THEN
C             j is unabsorbed, and not in Lme.
C             add to degree and add to new list
C             add degree only of non-dense rows.
              IF (degree(j).LE.totel) deg=deg+nvj
              iw(pn) = j
              pn = pn + 1
              hash = hash + int(j,kind=8)
            ENDIF
  170     CONTINUE
C         ----------------------------------------------------------
C         update the degree and check for mass elimination
C         ----------------------------------------------------------
          IF (((elen(i).EQ.1).AND.(p3.EQ.pn))
     &     .OR.
     &         (agg6_loc.AND.(deg .EQ. 0).AND.(ndense(me).EQ.nbd))
     &       )
     &    THEN
C           -------------------------------------------------------
C           mass elimination
C           -------------------------------------------------------
C           There is nothing left of this node except for an
C           edge to the current pivot element.  elen (i) is 1,
C           and there are no variables adjacent to node i.
C           Absorb i into the current pivot element, me.
            pe(i) = int(-me,8)
            nvi = -nv(i)
            degme = degme - nvi
            nvpiv = nvpiv + nvi
            nel = nel + nvi
            nv(i) = 0
            elen(i) = 0
          ELSE
C           -------------------------------------------------------
C           update the upper-bound degree of i
C           -------------------------------------------------------
C           the following degree does not yet include the size
C           of the current element, which is added later:
            degree(i) = min(deg+nbd-ndense(me), 
     &                       degree(i))
C           -------------------------------------------------------
C           add me to the list for i
C           -------------------------------------------------------
C           move first supervariable to end of list
            iw(pn) = iw(p3)
C           move first element to end of element part of list
            iw(p3) = iw(p1)
C           add new element to front of list.
            iw(p1) = me
C           store the new length of the list in len (i)
            len(i) = int(pn - p1 + 1)
C           -------------------------------------------------------
C           place in hash bucket.  Save hash key of i in last (i).
C           -------------------------------------------------------
            hash = mod(hash, hmod) + 1_8
            j = head(hash)
            IF (j .LE. 0) THEN
C             the degree list is empty, hash head is -j
              next(i) = -j
              head(hash) = -i
            ELSE
C             degree list is not empty
C             use last (head (hash)) as hash head
              next(i) = last(j)
              last(j) = i
            ENDIF
            last(i) = int(hash,kind=kind(last))
          ENDIF
  180   CONTINUE
        degree(me) = degme
C       -------------------------------------------------------------
C       Clear the counter array, w (...), by incrementing wflg.
C       -------------------------------------------------------------
        dmax = max(dmax, degme)
        wflg = wflg + dmax
C       make sure that wflg+n does not cause integer overflow
        IF (wflg .GT. maxint_n) THEN
          DO 190 x = 1, n
            IF (w(x) .NE. 0) w(x) = 1
  190     CONTINUE
          wflg = 2
        ENDIF
C       at this point, w (1..n) .lt. wflg holds
C=======================================================================
C  SUPERVARIABLE DETECTION
C=======================================================================
        DO 250 pme = pme1, pme2
          i = iw(pme)
          IF ( (nv(i).LT.0) .AND. (degree(i).LE.totel) ) THEN
C           only done for nondense rows
C           i is a principal variable in Lme
C           -------------------------------------------------------
C           examine all hash buckets with 2 or more variables.  We
C           do this by examing all unique hash keys for super-
C           variables in the pattern Lme of the current element, me
C           -------------------------------------------------------
            hash = int(last(i),kind=8)
C           let i = head of hash bucket, and empty the hash bucket
            j = head(hash)
            IF (j .EQ. 0) GO TO 250
            IF (j .LT. 0) THEN
C             degree list is empty
              i = -j
              head(hash) = 0
            ELSE
C             degree list is not empty, restore last () of head
              i = last(j)
              last(j) = 0
            ENDIF
            IF (i .EQ. 0) GO TO 250
C           while loop:
  200       CONTINUE
            IF (next(i) .NE. 0) THEN
             x = i 
C             ----------------------------------------------------
C             this bucket has one or more variables following i.
C             scan all of them to see if i can absorb any entries
C             that follow i in hash bucket.  Scatter i into w.
C             ----------------------------------------------------
              ln = len(i)
              eln = elen(i)
C             do not flag the first element in the list (me)
              DO 210 p = pe(i) + 1, pe(i) + int(ln - 1,8)
                w(iw(p)) = wflg
  210         CONTINUE
C             ----------------------------------------------------
C             scan every other entry j following i in bucket
C             ----------------------------------------------------
              jlast = i
              j = next(i)
C             while loop:
  220         CONTINUE
              IF (j .NE. 0) THEN
C               -------------------------------------------------
C               check if j and i have identical nonzero pattern
C               -------------------------------------------------
C               jump if i and j do not have same size data structure
                IF (len(j) .NE. ln) GO TO 240
C               jump if i and j do not have same number adj elts
                IF (elen(j) .NE. eln) GO TO 240
C               do not flag the first element in the list (me)
                DO 230 p = pe(j) + 1, pe(j) + int(ln - 1,8)
C                 jump if an entry (iw(p)) is in j but not in i
                  IF (w(iw(p)) .NE. wflg) GO TO 240
  230           CONTINUE
C               -------------------------------------------------
C               found it!  j can be absorbed into i
C               -------------------------------------------------
                IF (perm(j).GT.perm(x)) THEN
                ! J is absorbed by X
                  pe(j) = int(-x,8)
                  nv(x) = nv(x) + nv(j)
                  nv(j) = 0
                  elen(j) = 0
                ELSE
                ! X is absorbed by J
                  pe(x) = int(-j,8)
                  nv (j) = nv(x) + nv(j)
                  nv(x) = 0
                  elen(x) = 0
                  x = j
                ENDIF
C               both nv (i) and nv (j) are negated since they
C               are in Lme, and the absolute values of each
C               are the number of variables in i and j:
C               delete j from hash bucket
                j = next(j)
                next(jlast) = j
                GO TO 220
C               -------------------------------------------------
  240           CONTINUE
C               j cannot be absorbed into i
C               -------------------------------------------------
                jlast = j
                j = next(j)
              GO TO 220
              ENDIF
C             ----------------------------------------------------
C             no more variables can be absorbed into i
C             go to next i in bucket and clear flag array
C             ----------------------------------------------------
              wflg = wflg + 1
              i = next(i)
              IF (i .NE. 0) GO TO 200
            ENDIF
          ENDIF
  250   CONTINUE
C=======================================================================
C  RESTORE DEGREE LISTS AND REMOVE NONPRINCIPAL SUPERVAR. FROM ELEMENT
C=======================================================================
C       ------------------------------
C       Update thresm for having more
C       quasi dense rows to select
C       ------------------------------
        IF ( .NOT.denserows.AND.(thresm .GT. 0).AND.(thresm.LT.n) ) 
     &       THEN 
          thresm = max(thresmin, thresm-nvpiv)
        ENDIF
        p = pme1
        nleft = totel - nel
        DO 260 pme = pme1, pme2
          i = iw(pme)
          nvi = -nv(i)
          IF (nvi .GT. 0) THEN
C           i is a principal variable in Lme
C           restore nv (i) to signify that i is principal
            nv(i) = nvi
            IF (degree(i).LE.totel) THEN
C           -------------------------------------------------------
C           compute the external degree (add size of current elem)
C           -------------------------------------------------------
            deg = min(degree(i)+ degme - nvi, nleft - nvi)
            degree(i) = deg
            idense = .false.
C           
C           -------------------
C           Dense row detection
C           -------------------
            IF (thresm.GT.0) THEN
             IF (perm(i) .GT. thresm) THEN
C             relaxed dense row detection
               idense = .true.
C
               degree(i) = degree(i)+totel+2
             ENDIF
             IF (idense) THEN
C            update NDENSE of all elements in the list of element
C            adjacent to I (including ME).
               p1 = pe(i)
               p2 = p1 + int(elen(i) - 1,8)
               IF (p2.GE.p1) THEN
               DO 264 pj=p1,p2
                 e= iw(pj)
                 ndense(e) = ndense(e) + nvi
 264           CONTINUE
               ENDIF
C            insert I in the list of dense rows
               nbd = nbd+nvi
               fdeg = n
               deg = n
C              insert I at the beginning of the list
               inext = head(deg)
               IF (inext .NE. 0) last(inext) = i
               next(i) = inext
               head(deg) = i
               last(i)    = 0
               IF (lastd.EQ.0) lastd=i
C            end of IDENSE=true
             ENDIF
C           end of THRESM>0
            ENDIF
C             
            IF (.NOT.idense) THEN
            fdeg = perm(i)
C           -------------------------------------------------------
C           place the supervariable at the head of the degree list
C           -------------------------------------------------------
            inext = head(fdeg)
            IF (inext .NE. 0) last(inext) = i
            next(i) = inext
            last(i) = 0
            head(fdeg) = i
            ENDIF
C           -------------------------------------------------------
C           save the new degree, and find the minimum degree
C           -------------------------------------------------------
            mindeg = min(mindeg, fdeg)
            ENDIF
C           -------------------------------------------------------
C           place the supervariable in the element pattern
C           -------------------------------------------------------
            iw(p) = i
            p = p + 1
          ENDIF
  260   CONTINUE
C=======================================================================
C  FINALIZE THE NEW ELEMENT
C=======================================================================
        nv(me) = nvpiv + degme
C       nv (me) is now the degree of pivot (including diagonal part)
C       save the length of the list for the new element me
        len(me) = int(p - pme1)
        IF (len(me) .EQ. 0) THEN
C         there is nothing left of the current pivot element
          pe(me) = 0_8
          w(me) = 0
        ENDIF
        IF (newmem .NE. 0) THEN
C         element was not constructed in place: deallocate part
C         of it (final size is less than or equal to newmem,
C         since newly nonprincipal variables have been removed).
          pfree = p
          mem = mem - newmem + int(len(me),8)
        ENDIF
C=======================================================================
C       END WHILE (selecting pivots)
      GO TO 30
      ENDIF
C=======================================================================
  265 CONTINUE
C=======================================================================
C  COMPUTE THE PERMUTATION VECTORS
C=======================================================================
C     ----------------------------------------------------------------
C     The time taken by the following code is O(n).  At this
C     point, elen (e) = -k has been done for all elements e,
C     and elen (i) = 0 has been done for all nonprincipal
C     variables i.  At this point, there are no principal
C     supervariables left, and all elements are absorbed.
C     ----------------------------------------------------------------
C     ----------------------------------------------------------------
C     compute the ordering of unordered nonprincipal variables
C     ----------------------------------------------------------------
      DO 290 i = 1, n
        IF (elen(i) .EQ. 0) THEN
C         ----------------------------------------------------------
C         i is an un-ordered row.  Traverse the tree from i until
C         reaching an element, e.  The element, e, was the
C         principal supervariable of i and all nodes in the path
C         from i to when e was selected as pivot.
C         ----------------------------------------------------------
          j = int(-pe(i))
C         while (j is a variable) do:
  270     CONTINUE
            IF (elen(j) .GE. 0) THEN
              j = int(-pe(j))
              GO TO 270
            ENDIF
            e = j
C           ----------------------------------------------------------
C           get the current pivot ordering of e
C           ----------------------------------------------------------
            k = -elen(e)
C           ----------------------------------------------------------
C           traverse the path again from i to e, and compress the
C           path (all nodes point to e).  Path compression allows
C           this code to compute in O(n) time.  Order the unordered
C           nodes in the path, and place the element e at the end.
C           ----------------------------------------------------------
            j = i
C           while (j is a variable) do:
  280       CONTINUE
            IF (elen(j) .GE. 0) THEN
              jnext = int(-pe(j))
              pe(j) = int(-e,8)
              IF (elen(j) .EQ. 0) THEN
C               j is an unordered row
                elen(j) = k
                k = k + 1
              ENDIF
              j = jnext
            GO TO 280
            ENDIF
C         leave elen (e) negative, so we know it is an element
          elen(e) = -k
        ENDIF
  290 CONTINUE
C     ----------------------------------------------------------------
C     reset the inverse permutation (elen (1..n)) to be positive,
C     and compute the permutation (last (1..n)).
C     ----------------------------------------------------------------
      DO 300 i = 1, n
        k = abs(elen(i))
C        LAST (K) = I
C        LAST (K) = I
        elen(i) = k
  300 CONTINUE
      IF (.NOT.schuron) THEN
C       -----------------------------
C       restore PERM(I)=N  for PERMeqN
C       -----------------------------
        perm(permeqn) = n
      ENDIF
C=======================================================================
C  RETURN THE MEMORY USAGE IN IW
C=======================================================================
C     If maxmem is less than or equal to iwlen, then no compressions
C     occurred, and iw (maxmem+1 ... iwlen) was unused.  Otherwise
C     compressions did occur, and iwlen would have had to have been
C     greater than or equal to maxmem for no compressions to occur.
C     Return the value of maxmem in the pfree argument.
      pfree = maxmem
C===============================
C     Save PE in PARENT array
      DO i=1,n
       parent(i) = int(pe(i))
      ENDDO
C===============================
      RETURN