ana__orderings_8F_source.html

C =========================================================

C

C  This file includes various modifications of an original

C  routine MUMPS_ANA_H. The main reference for the approach

C  used in this routine is

C   Patrick Amestoy, Timothy A. Davis, and Iain S. Duff,

C    "An approximate minimum degree ordering algorithm,"

C    SIAM J. Matrix Analysis  vol 17, pages=886--905 (1996)

C    MUMPS_ANA_H is based on the original AMD code:

C

C    AMD, Copyright (c), 1996-2016, Timothy A. Davis,

C    Patrick R. Amestoy, and Iain S. Duff.  All Rights Reserved.

C    Used in MUMPS under the BSD 3-clause license.

C

C All other routines are modifications of this original routine

C done by MUMPS developers over the years (1996-2020) and are

C used in MUMPS under the BSD 3-clause license.

C

C BSD 3-clause licence:

C Redistribution and use in source and binary forms, with or without

C modification, are permitted provided that the following conditions

C are met:

C  * Redistributions of source code must retain the above copyright

C    notice, this list of conditions and the following disclaimer.

C  * Redistributions in binary form must reproduce the above

C    copyright notice, this list of conditions and the following

C    disclaimer in the documentation and/or other materials provided

C    with the distribution.

C  * Neither the name of the University of California, Berkeley nor

C    the names of its contributors may be used to endorse or promote

C    products derived from this software without specific prior

C    written permission.

C    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND

C    CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,

C    INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

C    MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

C    DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR

C    CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

C    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT

C    NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;

C    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)

C    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN

C    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

C    OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,

C    EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

C

C   MUMPS_AMD_ELT is a modification

C   designed to handle amalgamated and compressed

C   graphs and was developed in 1999 by Patrick Amestoy

C   in the context of the PARASOL project (1997-1999).

C

C   MUMPS_HAMD is a modification

C   designed to take into account a halo in the graph.

C   The graph is composed is partitioned in two types of nodes

C   the so called internal nodes and the so called halo nodes.

C   Halo nodes cannot be selected the both the initial degrees

C   and updated degrees of internal node should be taken

C   into account.

C   This routine also referred to as HALOAMD in MUMPS comments

C   is used for both Schur functionality and in the coupling with

C   partitioners such as SCOTCH.

C   This code was developed for MUMPS platform

C   by Patrick Amestoy between 1997 and 1999.

C

C   MUMPS_HAMF4 is a major modification of MUMPS_HAMD

C   since metric used to select pivots in not anymore the

C   degree but an approximation of the fill-in.

C   In this approximation

C   all cliques of elements adjacent to the variable are deducted.

C   Written by Patrick Amestoy between 1999 and 2000.

C   It is also used by F. Pellegrini in SCOTCH since 2000.

C

C   MUMPS_QAMD: modified version of reference AMD routine MUMPS_ANA_H

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   Written in 1997 by Patrick Amestoy.

C   References:

C    P.R. AMESTOY, Recent progress in parallel multifrontal solvers

C      for unsymmetric sparse matrices,

C      Proceedings of the 15th World Congress on Scientific Computation,

C      Modelling and Applied Mathematics, IMACS, Berlin (1997).

C    P.R. AMESTOY (1999), Methodes directes paralleles de

C      resolution des systemes creux de grande taille.

C      Rapport de these d'habilitation de l'INPT.

C

C   MUMPS_CST_AMF: modified version of MUMPS_HAMF4 routine

C   implementing constraint minimum fill-in based ordering.

C   Written by Stephane Pralet for MUMPS platform

C   during his post-doctorate at INPT-IRIT (Oct. 2004- Oct. 2005)

C

C  ----------------------------------------

C  To suppress aggressive absorption in ...

C      MUMPS_ANA_H   : Historical AMD

C        define NOAGG1

C      MUMPS_AMD_ELT  : (work on compressed graphs)

C        define NOAGG2

C      MUMPS_HAMD     : AMD with Halo and used for Schur

C        define NOAGG3

C      MUMPS_HAMF4 : Halo AMF version

C        define NOAGG4

C      MUMPS_QAMD     : Quasi dense

C        define NOAGG5

C      MUMPS_SYMQAMD  : Symbolic facto based on quasi dense

C        In the case of MUMPS_SYMQAMD, the aggressive absorption

C        is controlled by a parameter, AGG6.

C

C-----------------------------------------------------------------------

C-----------------------------------------------------------------------

C MUMPS_ANA_H:  Approximate Minimum Degree AMD approach.

C

C Description of MUMPS_ANA_H

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     References and definitions:

C     [1] Timothy A. Davis and Iain Duff, "An unsymmetric-pattern

C              multifrontal method for sparse LU factorization",

C              SIAM J. Matrix Analysis and Applications,

C              volume=18, pages=140-158 (1997)

C     [2] Patrick R. Amestoy, Timothy A. Davis, and Iain S. Duff,

C              "An approximate minimum degree ordering algorithm,"

C              SIAM J. Matrix Analysis  vol 17, pages=886--905 (1996)

C     [3] Alan George and Joseph Liu, "The evolution of the

C              minimum degree ordering algorithm," SIAM Review, vol.

C              31, no. 1, pp. 1-19, March 1989.  We list below the

C              features mentioned in that paper that this code

C              includes:

C       mass elimination:

C               Yes.  supervariable detection for mass elimination.

C       indistinguishable nodes:

C               Yes (we call these "supervariables").

C               We modified the approach used by Duff and Reid to

C               detect them (the previous hash was the true degree,

C               which we no longer keep track of).  A supervariable is

C               a set of rows with identical nonzero pattern.  All

C               variables in a supervariable are eliminated together.

C               Each supervariable has as its numerical name that of

C               one of its variables (its principal variable).

C       quotient graph representation:

C               Yes.  We use the term "element" for the cliques formed

C               during elimination.

C               The algorithm can operate in place, but it will work

C               more efficiently if given some "elbow room."

C       element absorption:

C               Yes. Similar to Duff,Reid and  George,Liu approaches

C       external degree:

C               Yes. Similar to Duff, Reid and  George, Liu approaches

C       incomplete degree update and multiple elimination:

C               No implemented.  Our method of

C               degree update within MUMPS_ANA_H is element-based, not

C               variable-based.  It is thus not well-suited for use

C               with incomplete degree update or multiple elimination.

C

C-----------------------------------------------------------------------


      SUBROUTINE mumps_ana_h(TOTEL, COMPUTE_PERM,

     &                   N, IWLEN, PE, PFREE, LEN, IW, NV, ELEN,

     &                   LAST, NCMPA, DEGREE, HEAD, NEXT, W, PARENT)

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


      END SUBROUTINE mumps_ana_h

C-----------------------------------------------------------------------

C MUMPS_AMD_ELT: modified version of reference AMD routine MUMPS_ANA_H

C capable of processing already amalgamated or compressed graph.

C Used within MUMPS process for the elemental input format of matrices

C Input data is in this context modified to be a graph of supervariables.

C

C Modifications of the interface :

C ------------------------------

C  INPUT:

C  -----

C     1/ LEN(I) < 0   <=> i is a secondary variable whose principal

C                         variable is -LEN(I)

C     2/ For all secondary variables the adj list MUST not be provided.

C        THAT is:

C        -------

C           if pe(isecondary) = 0 then

C                 adjacency list of isecondary is not provided

C           else

C             pe(isecondary) >0

C             len(isecondary) must be equal to len(iprincipal_associated)

C             then the corresponding space wil not be used and

C             will be freed by amd if necessary.

C           endif

C REMARK:

C ------

C 1/ N must be still set to the order of the matrix

C    (not of the amalgamated gragh)

C 2/ For each supervariable S only supervariables adjacent to S are provided

C    len(S) is then the number of such supervariables

C    NV(S) is however updated during the initialisation phase to represent

C    the size of the supervariable

C    ( increment nv(s) for each i / len(i) =-s )

C 3/ If (len(i) >=0  for all i ) then we get the classical AMD code

C ------------------


      SUBROUTINE mumps_amd_elt(N,IWLEN, PE, PFREE, LEN, IW, NV, ELEN,

     &                   LAST, NCMPA, DEGREE, HEAD, NEXT, W, PARENT)

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


      END SUBROUTINE mumps_amd_elt

C ----------------------------------------------------------------------

C Description of MUMPS_HAMD:

C   MUMPS_HAMD is a modification of AMD reference code (MUMPS_ANA_H)

C   designed to take into account a halo in the graph.

C   The graph is composed is partitioned in two types of nodes

C   the so called internal nodes and the so called halo nodes.

C   Halo nodes cannot be selected the both the inital degrees

C   and updated degrees of internal node should be taken

C   into account.

C   This routine also referred to as HALOAMD in MUMPS comments

C   is used for both Schur functionality and in the coupling with

C   partitioners such as SCOTCH.

C

C   Restrictive integer 64 bit variant :

C   it is assumed that IW array size can exceed 32-bit integer

C

C


      SUBROUTINE mumps_hamd(N, IWLEN, PE, PFREE, LEN, IW, NV, ELEN,

     &                   LAST, NCMPA, DEGREE, HEAD, NEXT, W, PARENT,

     &                   LISTVAR_SCHUR, SIZE_SCHUR)

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


      END SUBROUTINE mumps_hamd

C-----------------------------------------------------------------------

C-----------------------------------------------------------------------

C Description of MUMPS_HAMF4:

C MUMPS_HAMF4 is a modified version of halo AMD routine MUMPS_HAMD

C implementing an approximate minimum fill-in heuritic.

C Version provided to F. Pellegrini on Nov 2000 to be used in SCOTCH.

C Approximation of level4 of the minimum fill heuristic

C

C   Restrictive integer 64 bit variant :

C   it is assumed that IW array size can exceed 32-bit integer

C


      SUBROUTINE mumps_hamf4

     &           (norig, n, compute_perm, nbbuck,

     &                   iwlen, pe, pfree, len, iw, nv, elen,

     &                   last, ncmpa, degree, wf, next, w, head

     &                   , parent

     &                   )

      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


      END SUBROUTINE mumps_hamf4

C

C-----------------------------------------------------------------------

C MUMPS_QAMD: modified version of reference AMD routine MUMPS_ANA_H

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

C References:

C    P.R. AMESTOY, Recent progress in parallel multifrontal solvers

C      for unsymmetric sparse matrices,

C      Proceedings of the 15th World Congress on Scientific Computation,

C      Modelling and Applied Mathematics, IMACS, Berlin (1997).

C    P.R. AMESTOY (1999), Methodes directes paralleles de

C      resolution des systemes creux de grande taille.

C      Rapport de these d'habilitation de l'INPT.

C

C Date 1997

C ---------

C


      SUBROUTINE mumps_qamd

     &                (totel, compute_perm, iversion, thresh, ndense,

     &                 n, iwlen, pe, pfree, len, iw, nv,

     &                 elen, last, ncmpa, degree, head, next, w,

     &                 parent)

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


      END SUBROUTINE mumps_qamd

C-----------------------------------------------------------------------

C MUMPS_CST_AMF: modified version of MUMPS_HAMF4 routine

C implementing constraint minimum fill-in based

C ordering.

C Written by Stephane Pralet iduring his post-doctorate at INPT-IRIT

C (Oct. 2004- Oct. 2005)

C

C   Restrictive integer 64 bit variant :

C   it is assumed that IW array size can exceed 32-bit integer

C


      SUBROUTINE mumps_cst_amf (N, NBBUCK,

     &     IWLEN, PE, PFREE, LEN, IW, NV, ELEN,

     &     LAST, NCMPA, DEGREE, WF, NEXT, W, HEAD,

     &     CONSTRAINT,THESON, PARENT)

      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


      END SUBROUTINE mumps_cst_amf

C-----------------------------------------------------------------------

C MUMPS_SYMQAMD: modified version of MUMPS_QAMD code to

C designed to compute a symbolic factorization given

C an input ordering (provided in PERM array) and possibly

C a schur area.

C ---------


      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 )

      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


      END SUBROUTINE mumps_symqamd

mumps_abort
#define mumps_abort
Definition VE_Metis.h:25

mumps_qamd
subroutine mumps_qamd(totel, compute_perm, iversion, thresh, ndense, n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent)
Definition ana_orderings.F:5231

mumps_ana_h
subroutine mumps_ana_h(totel, compute_perm, n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent)
Definition ana_orderings.F:164

mumps_symqamd
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)
Definition ana_orderings.F:8303

mumps_cst_amf
subroutine mumps_cst_amf(n, nbbuck, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, wf, next, w, head, constraint, theson, parent)
Definition ana_orderings.F:6746

mumps_hamd
subroutine mumps_hamd(n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent, listvar_schur, size_schur)
Definition ana_orderings.F:2372

mumps_amd_elt
subroutine mumps_amd_elt(n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent)
Definition ana_orderings.F:1287

mumps_hamf4
subroutine mumps_hamf4(norig, n, compute_perm, nbbuck, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, wf, next, w, head, parent)
Definition ana_orderings.F:3728

min
#define min(a, b)
Definition macros.h:20

max
#define max(a, b)
Definition macros.h:21