C
C  This file is part of MUMPS 5.9.0, released
C  on Tue Apr 28 13:05:59 UTC 2026
C
C
C  Copyright 1991-2026 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  Mumps Technologies, University of Bordeaux.
C
C  This version of MUMPS is provided to you free of charge. It is
C  released under the CeCILL-C license 
C  (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
C  https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
C
      MODULE ZMUMPS_PARALLEL_ANALYSIS
      USE ZMUMPS_STRUC_DEF
      USE MUMPS_MEMORY_MOD
      USE MUMPS_ANA_ORD_WRAPPERS
      USE MUMPS_ANA_BLK_M, ONLY : LMATRIX_T, COMPACT_GRAPH_T
      INCLUDE 'mpif.h'
      PUBLIC ZMUMPS_ANA_F_PAR
      INTERFACE ZMUMPS_ANA_F_PAR
      MODULE PROCEDURE ZMUMPS_ANA_F_PAR
      END INTERFACE
      PRIVATE
      TYPE ORD_TYPE
      INTEGER           :: CBLKNBR, N
      INTEGER, POINTER  :: PERMTAB(:) => null()
      INTEGER, POINTER  :: PERITAB(:) => null()
      INTEGER, POINTER  :: RANGTAB(:) => null()
      INTEGER, POINTER  :: TREETAB(:) => null()
      INTEGER, POINTER  :: BROTHER(:) => null()
      INTEGER, POINTER  :: SON(:) => null()
      INTEGER, POINTER  :: NW(:) => null()
      INTEGER, POINTER  :: FIRST(:) => null()
      INTEGER, POINTER  :: LAST(:) => null()
      INTEGER, POINTER  :: TOPNODES(:) => null()
      INTEGER           :: COMM, NPROCS, MYID, 
     &                     COMM_PARAORD, NPROCS_PARAORD, MYID_PARAORD,
     &                     RKinSYMB_PROC0ORD
      INTEGER           :: TOPSTRAT, SUBSTRAT, ORDTOOL, TOPVARS
      LOGICAL           :: IDO
      END TYPE ORD_TYPE
      TYPE GRAPH_TYPE
      INTEGER(8)        :: NZ_LOC
      INTEGER, POINTER  :: IRN_LOC(:) => null()
      INTEGER, POINTER  :: JCN_LOC(:) => null()
      END TYPE GRAPH_TYPE
      TYPE ARRPNT
      INTEGER, POINTER :: BUF(:) => null()
      END TYPE ARRPNT
      INTEGER    :: MP, MPG, LP, NRL, TOPROWS
      INTEGER(8) :: MEMCNT, MAXMEM
      LOGICAL    :: PROK, PROKG, LPOK
      INTEGER N, NORIG
      CONTAINS
      SUBROUTINE ZMUMPS_ANA_F_PAR(id, WORK1, WORK2, LWORK1, LWORK2,
     &     NFSIZ, FILS,
     &     FRERE, COMM_PARASYMB, LUMAT, SIZEOFBLOCKS, 
     &     COMM_PARAORD, NPROCS_PARAORD, 
     &     RKinSYMB_PROC0ORD)
      USE ZMUMPS_STRUC_DEF
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)   :: id
      INTEGER, TARGET        :: WORK1(:), WORK2(:)
      INTEGER(8), INTENT(IN) :: LWORK1, LWORK2
#if defined(MUMPS_NOF2003)
      INTEGER, POINTER       :: FILS(:)
#else
      INTEGER, ALLOCATABLE   :: FILS(:)
#endif
      INTEGER, POINTER       :: NFSIZ(:), FRERE(:)
      INTEGER, INTENT(IN)    :: COMM_PARASYMB
      TYPE(LMATRIX_T), OPTIONAL       :: LUMAT
      INTEGER, INTENT(IN), TARGET, OPTIONAL   :: SIZEOFBLOCKS(id%NBLK)
      INTEGER, INTENT(IN), OPTIONAL   :: COMM_PARAORD, 
     &                                   NPROCS_PARAORD, 
     &                                   RKinSYMB_PROC0ORD
      TYPE(ORD_TYPE)       :: ord
      INTEGER, POINTER     :: IPE(:), NV(:),
     &     NE(:), NA(:), NODE(:),
     &     ND(:), SUBORD(:), NAMALG(:),
     &     IPS(:), CUMUL(:),
     &     SAVEIRN(:), SAVEJCN(:)
      INTEGER              :: MYID, NPROCS, IERR, NEMIN, LDIAG
      LOGICAL              :: SPLITROOT
      INTEGER(8), PARAMETER :: K79REF=12000000_8
      DOUBLE PRECISION      :: TIMEB
      INTEGER HOW_TO_SPLIT_ROOT, INODE_Scalapack_CAND, 
     &        NBSONS_Scalapack_CAND
      INTEGER, POINTER, DIMENSION(:) :: SIZEOFBLOCKS_PTR
      INTEGER, TARGET    :: IDUMMY_ARRAY(1)
      INTEGER            :: LSIZEOFBLOCKS_PTR
      LOGICAL            :: SIZEOFBLOCKS_AVAIL
      nullify(IPE, NV, NE, NA, NODE, ND, SUBORD, NAMALG, IPS,
     &     CUMUL, SAVEIRN, SAVEJCN)
      CALL MPI_COMM_RANK (COMM_PARASYMB, MYID, IERR)
      CALL MPI_COMM_SIZE (COMM_PARASYMB, NPROCS, IERR)
      NORIG = id%N
      IF (id%KEEP(339).NE.0) THEN
        N     = id%NBLK
      ELSE
        N     = NORIG
      ENDIF
      ord%N   = N
      LP    = id%ICNTL(1)
      MP    = id%ICNTL(2)
      MPG   = id%ICNTL(3)
      PROK  = (MP.GT.0)
      PROKG = (MPG.GT.0) .AND. (MYID .EQ. 0)
      LPOK  = (LP.GT.0) .AND. (id%ICNTL(4).GE.1)
      LDIAG = id%ICNTL(4)
      IF (present(SIZEOFBLOCKS)) THEN
       SIZEOFBLOCKS_PTR => SIZEOFBLOCKS(1:N)
       LSIZEOFBLOCKS_PTR = N
       SIZEOFBLOCKS_AVAIL = .TRUE.
      ELSE
       SIZEOFBLOCKS_PTR => IDUMMY_ARRAY
       SIZEOFBLOCKS_AVAIL = .FALSE.
       LSIZEOFBLOCKS_PTR = 1
       IDUMMY_ARRAY(1) = -1
      ENDIF
      IF (PROKG) THEN
         WRITE(MPG,'(A,I10)') 
     &   " Parallel analysis, processing a graph of size:", N
      ENDIF
      IF (id%KEEP(339).GT.0) THEN
       IF (.NOT.present(LUMAT) .OR. .NOT. present(SIZEOFBLOCKS)) THEN
         IF (PROK) THEN
          WRITE(MP,*) MYID, " Internal error in ZMUMPS_ANA_F_PAR"
         ENDIF
         id%INFO(1) = -9991
       ENDIF
       CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     COMM_PARASYMB, MYID )
       IF ( id%INFO(1) .LT. 0 ) RETURN
      ENDIF
      IF (id%KEEP(339).GT.0) THEN
       MEMCNT = MEMCNT +  LUMAT%NZL + LUMAT%NBCOL_LOC + 3 
       IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      ENDIF
      CALL ZMUMPS_SET_PAR_ORD(id, COMM_PARASYMB, MYID, NPROCS, 
     &     ord, COMM_PARAORD, NPROCS_PARAORD,
     &     RKinSYMB_PROC0ORD)
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     COMM_PARASYMB, MYID )
       IF ( id%INFO(1) .LT. 0 ) RETURN
      IF ( LWORK1 .LT. 3_8 *int(N,8) ) THEN
         WRITE(LP,*)
     &      'Insufficient workspace in ZMUMPS_ANA_F_PAR' 
         CALL MUMPS_ABORT()
      ENDIF
      IF ( ord%COMM .NE. MPI_COMM_NULL ) THEN
        ord%PERMTAB => WORK1(         1       : N)
        ord%PERITAB => WORK1(    int(N,8)+1_8 : 2_8*int(N,8))
        ord%TREETAB => WORK1(2_8*int(N,8)+1_8 : 3_8*int(N,8))
      ENDIF
      IF ( id%KEEP(54) .NE. 3 ) THEN
         IF(MYID.EQ.0) THEN
            SAVEIRN    => id%IRN_loc
            SAVEJCN    => id%JCN_loc
            id%IRN_loc => id%IRN
            id%JCN_loc => id%JCN
            id%KEEP8(29) = id%KEEP8(28)
         ELSE
            id%KEEP8(29)=0_8
         END IF
      END IF
      MAXMEM=0
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      id%INFOG(7) = id%KEEP(245)
      IF (PROKG) CALL MUMPS_SECDEB( TIMEB )
      IF (id%KEEP(339).GT.0) THEN
        CALL ZMUMPS_DO_PAR_ORD(id, MYID, NPROCS, 
     &       ord, WORK2, LWORK2, LUMAT, SIZEOFBLOCKS)
      ELSE
        CALL ZMUMPS_DO_PAR_ORD(id, MYID, NPROCS, 
     &       ord, WORK2, LWORK2)
      ENDIF
      IF (PROKG) THEN
       CALL MUMPS_SECFIN( TIMEB )
       WRITE(MPG,
     &   '(" ELAPSED time in parallel ordering       =",F12.4)')
     &   TIMEB
      ENDIF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) THEN
         IF(id%KEEP(54) .NE. 3) THEN
            IF(ord%MYID.EQ.0) THEN
               id%IRN_loc => SAVEIRN
               id%JCN_loc => SAVEJCN
            END IF
         END IF
         RETURN
      ENDIF
      IF(ord%MYID .EQ. 0) THEN
         CALL MUMPS_REALLOC(IPE, N, id%INFO, LP, FORCE=.FALSE.,
     &        COPY=.FALSE., STRING='', 
     &        MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(NV, N, id%INFO, LP,
     &        MEMCNT=MEMCNT, ERRCODE=-7)
         IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      END IF
      ord%SUBSTRAT = 0
      ord%TOPSTRAT = 0
      IF (id%KEEP(339).NE.0) THEN
        CALL ZMUMPS_PARSYMFACT_LUMAT(id, ord, IPE, NV,
     &                               WORK2, LWORK2, LUMAT,
     &                               SIZEOFBLOCKS)
      ELSE
        CALL ZMUMPS_PARSYMFACT(id, ord, IPE, NV, WORK2, LWORK2)
      ENDIF
      IF(id%KEEP(54) .NE. 3) THEN
         IF(ord%MYID.EQ.0) THEN
            id%IRN_loc => SAVEIRN
            id%JCN_loc => SAVEJCN
         END IF
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, MYID )
      IF ( id%INFO(1) .LT. 0 ) RETURN
      NULLIFY(ord%PERMTAB)
      NULLIFY(ord%PERITAB)
      NULLIFY(ord%TREETAB)
      CALL MUMPS_IDEALLOC(ord%FIRST, ord%LAST, MEMCNT=MEMCNT)
      IF (MYID .EQ. 0) THEN
         IPS => WORK1(1:N)
         NE     => WORK1(    int(N,8)+1_8 : 2_8*int(N,8))
         NA     => WORK1(2_8*int(N,8)+1_8 : 3_8*int(N,8))
         NODE   => WORK2(             1   : N  )
         ND     => WORK2(    int(N,8)+1_8 : 2_8*int(N,8))
         SUBORD => WORK2(2_8*int(N,8)+1_8 : 3_8*int(N,8))
         NAMALG => WORK2(3_8*int(N,8)+1_8 : 4_8*int(N,8))
         CALL MUMPS_REALLOC(CUMUL, N, id%INFO, LP,
     &        STRING='CUMUL', MEMCNT=MEMCNT, ERRCODE=-7)
         IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
         NEMIN  = id%KEEP(1)
         CALL ZMUMPS_ANA_LNEW(N, IPE(1), NV(1), IPS(1), NE(1),
     &       NA(1), NFSIZ(1), NODE(1), id%INFOG(6), FILS(1), FRERE(1),
     &       ND(1), NEMIN, SUBORD(1), id%KEEP(60), id%KEEP(20),
     &       id%KEEP(38), NAMALG(1), id%KEEP(104), CUMUL(1),
     &       id%KEEP(50), id%ICNTL(13), id%KEEP(37), id%KEEP(197),
     &       id%NSLAVES, id%KEEP(250).EQ.1, SIZEOFBLOCKS_AVAIL, 
     &       SIZEOFBLOCKS_PTR(1), LSIZEOFBLOCKS_PTR,
     &       INODE_Scalapack_CAND, NBSONS_Scalapack_CAND, 
     &       id%KEEP(11), id%KEEP(191), id%KEEP(192), id%KEEP(193))
         CALL MUMPS_DEALLOC(CUMUL, NV, IPE, MEMCNT=MEMCNT)
         CALL ZMUMPS_ANA_M(NE(1), ND(1), id%INFOG(6), id%INFOG(5),
     &        id%KEEP(2), id%KEEP(50), id%KEEP8(101), id%KEEP(108),
     &        id%KEEP(5), id%KEEP(6), id%KEEP(226), id%KEEP(253))
         IF ( id%KEEP(53) .NE. 0 ) THEN
            CALL MUMPS_MAKE1ROOT(N, FRERE(1), FILS(1), NFSIZ(1),
     &           id%KEEP(20))
            INODE_Scalapack_CAND  = id%KEEP(20)
            NBSONS_Scalapack_CAND = 1
         END IF
         IF (  (id%KEEP(48) == 4 .AND. id%KEEP8(21).GT.0_8)
     &        .OR.
     &        (id%KEEP (48)==5 .AND. id%KEEP8(21) .GT. 0_8 )
     &        .OR.
     &        (id%KEEP(24).NE.0.AND.id%KEEP8(21).GT.0_8) ) THEN 
            CALL ZMUMPS_SET_K821_SURFACE(id%KEEP8(21), id%KEEP(2),
     &           id%KEEP(48), id%KEEP(50), id%NSLAVES)
         END IF
         IF (id%KEEP(210).LT.1.OR.id%KEEP(210).GT.2) id%KEEP(210)=2
         IF (id%KEEP(210).EQ.2) id%KEEP8(79)=huge(id%KEEP8(79))
         IF (id%KEEP(210).EQ.1.AND.id%KEEP8(79).LE.0_8) THEN
          id%KEEP8(79)=K79REF * int(id%NSLAVES,8)
         ENDIF
         IF (id%KEEP(11).EQ.0) THEN
          IF ( (id%KEEP(79).EQ.0).OR.(id%KEEP(79).EQ.2).OR.
     &         (id%KEEP(79).EQ.3).OR.(id%KEEP(79).EQ.5).OR.
     &         (id%KEEP(79).EQ.6)
     &    )  THEN
           IF (id%KEEP(210).EQ.1) THEN
            SPLITROOT = .FALSE. 
            IF ( id%KEEP(62).GE.1) THEN
               CALL ZMUMPS_CUTNODES(N, FRERE(1), FILS(1),
     &           NFSIZ(1), 
     &           SIZEOFBLOCKS_PTR(1), LSIZEOFBLOCKS_PTR, id%INFOG(6), 
     &           id%NSLAVES, id%KEEP(1), id%KEEP8(1), SPLITROOT,
     &           MP, LDIAG, id%INFOG(1), id%INFOG(2))
               IF (id%INFOG(1).LT.0) RETURN
            ENDIF
           ENDIF
          ENDIF
         ENDIF
         HOW_TO_SPLIT_ROOT = 0 
         SPLITROOT = id%ICNTL(13) .EQ. -1
#if defined(NOSCALAPACK)
         SPLITROOT = SPLITROOT .OR. id%NSLAVES.GT.0
#else
         SPLITROOT = SPLITROOT .OR.
     &            (id%ICNTL(13).GT.0 .AND. id%NSLAVES.GT.id%ICNTL(13))
#endif
         IF (SPLITROOT.AND.id%KEEP(11).GT.0) HOW_TO_SPLIT_ROOT =1 
         IF (id%KEEP(53) .NE. 0) THEN
           SPLITROOT = .TRUE.
           IF (id%KEEP(11).GT.0) HOW_TO_SPLIT_ROOT = 2
         ENDIF
#if defined(NOSCALAPACK)
#else
         IF ( id%KEEP(11).GT.0 .AND. (id%KEEP(339).NE.0) ) THEN 
           IF (.NOT.SPLITROOT .AND. 
     &       (id%KEEP(60).EQ.0).AND.   
     &       ( (NFSIZ(INODE_Scalapack_CAND).GT.id%KEEP(37))
     &        .AND.(id%ICNTL(13).LE.0) )
     &       .AND.
     &       (NBSONS_Scalapack_CAND.GT.id%KEEP(11)) 
     &       ) THEN
             HOW_TO_SPLIT_ROOT = 3
             SPLITROOT=.TRUE.
           ENDIF
         ENDIF
#endif
         SPLITROOT = (SPLITROOT.AND.( (id%KEEP(60).EQ.0) ))
         IF (SPLITROOT) THEN
           IF (id%KEEP(339).EQ.0) THEN
            CALL ZMUMPS_CUTNODES(N, FRERE(1), FILS(1), NFSIZ(1),
     &           SIZEOFBLOCKS_PTR(1), LSIZEOFBLOCKS_PTR, id%INFOG(6), 
     &           id%NSLAVES, id%KEEP(1), id%KEEP8(1),
     &           SPLITROOT, MP, LDIAG, id%INFOG(1), id%INFOG(2))
           ELSE
            IF (id%KEEP(11).EQ.0) THEN
              CALL ZMUMPS_CUTNODES(N, FRERE(1), FILS(1), NFSIZ(1),
     &           SIZEOFBLOCKS_PTR(1), LSIZEOFBLOCKS_PTR, id%INFOG(6), 
     &           id%NSLAVES, id%KEEP(1), id%KEEP8(1),
     &           SPLITROOT, MP, LDIAG, id%INFOG(1), id%INFOG(2))
              IF (id%INFOG(1).LT.0) RETURN
              IF ( id%KEEP(53) .NE. 0 ) THEN
                CALL MUMPS_MAKE1ROOT(N, FRERE(1), FILS(1), NFSIZ(1),
     &             id%KEEP(20))
              END IF
            ELSE
              CALL ZMUMPS_SPLIT_ROOT( id%NSLAVES,
     &                    HOW_TO_SPLIT_ROOT, INODE_Scalapack_CAND,
     &                    N, FRERE(1), FILS(1), NFSIZ(1), 
     &                    id%KEEP(1), id%KEEP8(1),
     &                    SIZEOFBLOCKS_PTR(1), LSIZEOFBLOCKS_PTR,
     &                    id%INFOG(6))
            END IF
           END IF
         ENDIF
      END IF
      RETURN
      END SUBROUTINE ZMUMPS_ANA_F_PAR
      SUBROUTINE ZMUMPS_SET_PAR_ORD(id, COMM_PARASYMB, MYID, NPROCS, 
     &           ord, 
     &           COMM_PARAORD, NPROCS_PARAORD, RKinSYMB_PROC0ORD)
      TYPE(ZMUMPS_STRUC)  :: id
      TYPE(ORD_TYPE)      :: ord
      INTEGER, INTENT(IN) :: COMM_PARASYMB, MYID, NPROCS
      INTEGER, INTENT(IN), OPTIONAL   :: COMM_PARAORD, NPROCS_PARAORD,
     &                                   RKinSYMB_PROC0ORD
      INTEGER  :: IERR
#if defined(parmetis) || defined(parmetis3)
      INTEGER  :: I
      INTEGER  :: COLOR, BASE, WORKERS
      LOGICAL  :: IDO
#endif
      IF (id%KEEP(339).GT.0) THEN
       ord%TOPSTRAT     = 0
       ord%SUBSTRAT     = 0
       ord%COMM         = COMM_PARASYMB
       ord%MYID         = MYID
       ord%NPROCS       = NPROCS
       ord%COMM_PARAORD      = COMM_PARAORD
       ord%RKinSYMB_PROC0ORD = RKinSYMB_PROC0ORD
       ord%NPROCS_PARAORD    = NPROCS_PARAORD
       ord%IDO          = (COMM_PARAORD.NE.MPI_COMM_NULL)
       IF (ord%IDO) THEN
        CALL MPI_COMM_RANK (ord%COMM_PARAORD, ord%MYID_PARAORD, IERR)
       ELSE
        ord%MYID_PARAORD = -1
       ENDIF
       IF (id%KEEP(245) .EQ. 1) THEN
#if defined(ptscotch)
         ord%ORDTOOL    = 1
         IF(PROKG) WRITE(MPG,
     &        '(" Using PT-SCOTCH for parallel ordering")')
         RETURN
#else
         id%INFOG(1) = -38
         id%INFO(1)  = -38
         IF(ord%MYID .EQ.0 ) WRITE(LP,
     &        '(" PT-SCOTCH not available")')
         RETURN
#endif
       ELSE IF (id%KEEP(245) .EQ. 2) THEN
#if defined(parmetis) || defined(parmetis3)
        ord%ORDTOOL    = 2
        IF(PROKG) WRITE(MPG,
     &        '(" Using ParMETIS for parallel ordering")')
         RETURN
#else
         id%INFOG(1) = -38
         id%INFO(1)  = -38
         IF(ord%MYID .EQ.0 ) WRITE(LP,
     &        '(" ParMETIS not available.")')
         RETURN
#endif
       END IF
      ELSE
       ord%NPROCS       = NPROCS
       ord%TOPSTRAT     = 0
       ord%SUBSTRAT     = 0
       ord%COMM         = COMM_PARASYMB
       ord%MYID         = MYID
       ord%RKinSYMB_PROC0ORD = NPROCS-id%NSLAVES
       IF (id%KEEP(245) .EQ. 1) THEN
#if defined(ptscotch)
         IF(id%NSLAVES .LT. 2) THEN
            IF(PROKG) WRITE(MPG,'("Warning: older versions
     &of PT-SCOTCH require at least 2 processors.")')
         END IF
         ord%ORDTOOL    = 1
         ord%COMM_PARAORD   = id%COMM_NODES
         ord%NPROCS_PARAORD = id%NSLAVES
         ord%IDO        = (ord%MYID .GE. 1) .OR. (id%KEEP(46) .EQ. 1)
         IF (ord%IDO) THEN
          CALL MPI_COMM_RANK (ord%COMM_PARAORD, ord%MYID_PARAORD, IERR)
         ELSE
          ord%MYID_PARAORD = -1
         ENDIF
         IF(PROKG) WRITE(MPG,
     &        '(" Using PT-SCOTCH for parallel ordering")')
         RETURN
#else
         id%INFOG(1) = -38
         id%INFO(1)  = -38
         IF(ord%MYID .EQ.0 ) WRITE(LP,
     &        '(" PT-SCOTCH not available")')
         RETURN
#endif
       ELSE IF (id%KEEP(245) .EQ. 2) THEN
#if defined(parmetis) || defined(parmetis3)
      BASE             = ord%NPROCS-id%NSLAVES
         IF(N.LE.100) THEN
            WORKERS = 2
         ELSE
            WORKERS = min(id%NSLAVES,N/16)
         END IF
         I=1
         DO
            IF (I .GT. WORKERS) EXIT
            ord%NPROCS_PARAORD = I
            I = I*2
         END DO
         IDO = (ord%MYID .GE. BASE) .AND.
     &        (ord%MYID .LE. BASE+ord%NPROCS_PARAORD-1)
         ord%IDO = IDO
         IF ( IDO ) THEN
            COLOR   = 1
         ELSE
            COLOR = MPI_UNDEFINED
         END IF
         CALL MPI_COMM_SPLIT( COMM_PARASYMB, COLOR, 0, ord%COMM_PARAORD,
     &        IERR )
         IF (ord%IDO) THEN
          CALL MPI_COMM_RANK (ord%COMM_PARAORD, ord%MYID_PARAORD, IERR)
         ELSE
          ord%MYID_PARAORD = -1
         ENDIF
         ord%ORDTOOL  = 2
         IF(PROKG) WRITE(MPG,
     &        '(" Using ParMETIS for parallel ordering")')
         RETURN
#else
         id%INFOG(1) = -38
         id%INFO(1)  = -38
         IF(ord%MYID .EQ.0 ) WRITE(LP,
     &        '(" ParMETIS not available.")')
         RETURN
#endif
       END IF
      ENDIF
      END SUBROUTINE ZMUMPS_SET_PAR_ORD
      SUBROUTINE ZMUMPS_DO_PAR_ORD(id, MYID, NPROCS, ord,
     &                             WORK, LWORK, LUMAT, 
     &                             SIZEOFBLOCKS)
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)       :: id
      INTEGER, INTENT(IN)      :: MYID, NPROCS
      TYPE(ORD_TYPE)           :: ord
      INTEGER                  :: WORK(:)
      INTEGER(8), INTENT(IN)   :: LWORK
      TYPE(LMATRIX_T), OPTIONAL       :: LUMAT
      INTEGER, INTENT(IN), OPTIONAL   :: SIZEOFBLOCKS(N)
#if defined(parmetis) || defined(parmetis3)
      INTEGER                       :: IERR
#endif
      TYPE(COMPACT_GRAPH_T)   :: GCOMP_DIST
      IF (id%KEEP(339).NE.0) THEN
       CALL MUMPS_AB_LMAT_TO_CLEAN_G ( ord%MYID, 
     &         .FALSE.,    
     &         .FALSE.,    
     &         LUMAT, GCOMP_DIST, id%INFO, id%ICNTL
     &         , MEMCNT
     &      )
        IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
        IF (GCOMP_DIST%NZG .EQ.0) THEN
          write(LP,*) ORD%MYID, 
     &      " Internal error empty subgraph", 
     &      " when calling distributed memory parallel ordering"
          id%INFO(1) = -9980
        ENDIF
      ENDIF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GOTO 500
      IF (ord%ORDTOOL .EQ. 1) THEN
#if defined(ptscotch)
        IF (id%KEEP(339).NE.0) THEN
         CALL ZMUMPS_PTSCOTCH_ORD(id, ord, WORK, LWORK,
     &                     GCOMP_DIST,
     &                     SIZEOFBLOCKS )
        ELSE
         CALL ZMUMPS_PTSCOTCH_ORD(id, ord, WORK, LWORK)
        ENDIF
#else
         id%INFOG(1) = -38
         id%INFO(1)  = -38
         WRITE(LP,*)'PT-SCOTCH not available. Aborting...'
         CALL MUMPS_ABORT()
#endif
      ELSE IF (ord%ORDTOOL .EQ. 2) THEN
#if defined(parmetis) || defined(parmetis3)
         IF (id%KEEP(339).GT.0) THEN
         CALL ZMUMPS_PARMETIS_ORD_LUMAT (id, ord, WORK, LWORK,
     &                            GCOMP_DIST,
     &                            SIZEOFBLOCKS)
         ELSE
           CALL ZMUMPS_PARMETIS_ORD(id, ord, WORK, LWORK)
         ENDIF
         IF (id%KEEP(339).EQ.0) THEN
          if(ord%IDO) CALL MPI_COMM_FREE(ord%COMM_PARAORD, IERR)
         ENDIF
#else
         id%INFOG(1) = -38
         id%INFO(1)  = -38
         WRITE(LP,*)'ParMETIS not available. Aborting...'
         CALL MUMPS_ABORT()
#endif
      END IF
  500 CONTINUE
      IF (id%KEEP(339).NE.0) THEN
             CALL MUMPS_AB_FREE_GCOMP(GCOMP_DIST, MEMCNT)
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_DO_PAR_ORD
#if defined(parmetis) || defined(parmetis3)
      SUBROUTINE ZMUMPS_PARMETIS_ORD(id, ord, WORK, LWORK) 
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)      :: id
      TYPE(ORD_TYPE)          :: ord
      INTEGER, TARGET         :: WORK(:)
      INTEGER(8), INTENT (IN) :: LWORK
      INTEGER             :: I, MYID, NPROCS, IERR, BASE, METIS_IDX_SIZE
      INTEGER, POINTER    :: FIRST(:), LAST(:), SWORK(:)
      INTEGER             :: BASEVAL, VERTLOCNBR,
     &     OPTIONS(10)
      INTEGER(8), POINTER :: VERTLOCTAB(:)
      INTEGER, POINTER    :: EDGELOCTAB(:), RCVCNTS(:)
      INTEGER(8)          :: EDGELOCNBR
      INTEGER, POINTER    :: SIZES(:), ORDER(:)
      INTEGER, POINTER    :: IDUMMY_PTR(:)
      INTEGER             :: SIZE_IDUMMY_PTR
      nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB, RCVCNTS,
     &      SIZES, ORDER, IDUMMY_PTR)
      MYID            = ord%MYID
      NPROCS          = ord%NPROCS
      IERR            = 0
      SIZE_IDUMMY_PTR = 0
      IF( LWORK.LT. int(N,8)*3_8 .OR. LWORK .LT. int(NPROCS+1,8)) THEN
         WRITE(LP,
     &        '("Insufficient workspace inside ZMUMPS_PARMETIS_ORD")')
         CALL MUMPS_ABORT()
      END IF
      BASEVAL = 1
      CALL MUMPS_REALLOC(FIRST, NPROCS+1, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(LAST, NPROCS+1, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      BASE    = id%NPROCS-id%NSLAVES
      CALL ZMUMPS_GRAPH_DIST(id, ord, FIRST,
     &     LAST, BASE, NPROCS, WORK(1_8: 2_8*int(N,8)),
     &     2_8*int(N,8), TYPE=2)
      VERTLOCNBR = LAST(MYID+1)-FIRST(MYID+1) + 1
      CALL MUMPS_I8REALLOC(VERTLOCTAB, VERTLOCNBR+1, id%INFO,
     &        LP, STRING='VERTLOCTAB', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      SWORK => WORK(int(N+1,8):3_8*int(N,8))
      CALL ZMUMPS_BUILD_DIST_GRAPH(id, ord, FIRST, LAST, VERTLOCTAB,
     &     EDGELOCTAB, SWORK, 2_8 * int(N,8))
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, ord%MYID )
      IF(id%INFO(1).LT.0) GOTO 20
      EDGELOCNBR = VERTLOCTAB(VERTLOCNBR+1)-1_8
      OPTIONS(:) = 0
      ORDER => WORK(1:N)
      CALL MUMPS_REALLOC(SIZES, 2*ord%NPROCS_PARAORD, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      IF(ord%IDO) THEN
         CALL MUMPS_METIS_IDXSIZE(METIS_IDX_SIZE) 
         IF (METIS_IDX_SIZE.EQ.32) THEN
           IF (id%KEEP(10).EQ.1) THEN
            id%INFO(1) = -52
            id%INFO(2) = 1
           ELSE
            CALL MUMPS_PARMETIS_MIXEDto32(id, 
     &           BASE, VERTLOCNBR, FIRST,
     &           VERTLOCTAB, EDGELOCTAB, BASEVAL, OPTIONS, ORDER,
     &           IDUMMY_PTR, SIZE_IDUMMY_PTR,
     &           SIZES, ord%COMM_PARAORD, ord%MYID_PARAORD, IERR)
           ENDIF
         ELSE IF (METIS_IDX_SIZE.EQ.64) THEN
            CALL MUMPS_PARMETIS_MIXEDto64
     &           (id, BASE, VERTLOCNBR, FIRST,
     &           VERTLOCTAB, EDGELOCTAB, BASEVAL, OPTIONS, ORDER,
     &           IDUMMY_PTR, SIZE_IDUMMY_PTR,
     &           SIZES, ord%COMM_PARAORD, ord%MYID_PARAORD, IERR)
         ELSE
              WRITE(*,*)
     &        "Internal error in PARMETIS wrappers, METIS_IDX_SIZE=",
     &        METIS_IDX_SIZE
              CALL MUMPS_ABORT()
         END IF
      END IF
      IF (id%KEEP(339).NE.0) THEN
        nullify(VERTLOCTAB, EDGELOCTAB)
      ELSE
        CALL MUMPS_IDEALLOC(EDGELOCTAB, MEMCNT=MEMCNT)
        IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
        CALL MUMPS_I8DEALLOC(VERTLOCTAB)
      ENDIF
      IF(IERR.GT.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GOTO 20
      CALL MPI_BCAST(SIZES(1), 2*ord%NPROCS_PARAORD, MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      ord%CBLKNBR = 2*ord%NPROCS_PARAORD-1
      CALL MUMPS_REALLOC(RCVCNTS, id%NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      DO I=1, id%NPROCS
         RCVCNTS(I) = max(LAST(I)-FIRST(I)+1,0)
      END DO
      FIRST = FIRST-1
      IF(FIRST(1) .LT. 0) THEN
         FIRST(1)   = 0
      END IF
      CALL MPI_ALLGATHERV ( ORDER(1), VERTLOCNBR, MPI_INTEGER,
     &     ord%PERMTAB(1),
     &     RCVCNTS(1), FIRST(1), MPI_INTEGER, ord%COMM, IERR )
      DO I=1, N
         ord%PERITAB(ord%PERMTAB(I)) = I
      END DO
      CALL MUMPS_REALLOC(ord%RANGTAB, 2*ord%NPROCS_PARAORD, id%INFO,
     &     LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      CALL ZMUMPS_BUILD_TREETAB(ord%TREETAB, ord%RANGTAB,
     &     SIZES, ord%CBLKNBR)
      CALL MUMPS_DEALLOC(SIZES, FIRST, LAST,
     &     RCVCNTS, MEMCNT=MEMCNT)
      CALL MUMPS_REALLOC(ord%SON, ord%CBLKNBR, id%INFO,
     &     LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%BROTHER, ord%CBLKNBR, id%INFO,
     &     LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%NW, ord%CBLKNBR, id%INFO,
     &     LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      CALL ZMUMPS_BUILD_TREE(ord)
      RETURN
 20   CONTINUE
      CALL MUMPS_DEALLOC(FIRST      , MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(LAST       , MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(SIZES      , MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(ord%RANGTAB, MEMCNT=MEMCNT)
      RETURN
      END SUBROUTINE ZMUMPS_PARMETIS_ORD
      SUBROUTINE ZMUMPS_PARMETIS_ORD_LUMAT (id, ord, WORK, LWORK,
     &                              GCOMP_DIST,
     &                              SIZEOFBLOCKS )
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)     :: id
      TYPE(ORD_TYPE)         :: ord
      INTEGER, TARGET        :: WORK(:)
      INTEGER(8), INTENT(IN) :: LWORK
      TYPE(COMPACT_GRAPH_T), OPTIONAL       :: GCOMP_DIST
      INTEGER, INTENT(IN), OPTIONAL, TARGET :: SIZEOFBLOCKS(N)
      INTEGER             :: I, MYID, NPROCS, IERR, BASE, METIS_IDX_SIZE
      INTEGER             :: MASTER
      PARAMETER     (MASTER=0)
      INTEGER, POINTER    :: FIRST(:), LAST(:), SWORK(:)
      INTEGER             :: BASEVAL, VERTLOCNBR,
     &     OPTIONS(10)
      INTEGER(8), POINTER :: VERTLOCTAB(:)
      INTEGER, POINTER    :: EDGELOCTAB(:), RCVCNTS(:)
      INTEGER(8)          :: EDGELOCNBR
      INTEGER, POINTER    :: SIZES(:), ORDER(:)
      INTEGER, POINTER    :: VELOLOCTAB(:)
      INTEGER             :: SIZE_VELOLOCTAB
      INTEGER, TARGET     :: IDUMMY(1)
      nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB, RCVCNTS,
     &      SIZES, ORDER )
      VELOLOCTAB      => IDUMMY 
      MYID            = ord%MYID
      NPROCS          = ord%NPROCS
      IERR            = 0
      SIZE_VELOLOCTAB = 0
      IF( LWORK.LT. int(N,8)*3_8 .OR. LWORK .LT. int(NPROCS+1,8)) THEN
         WRITE(LP,
     &        '("Insufficient workspace inside ZMUMPS_PARMETIS_ORD")')
         CALL MUMPS_ABORT()
      END IF
      IF(ord%IDO) THEN
        CALL MUMPS_REALLOC(FIRST, ord%NPROCS_PARAORD+1, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
        CALL MUMPS_REALLOC(LAST, ord%NPROCS_PARAORD+1, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
        IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
        CALL MUMPS_REALLOC(SIZES, 2*ord%NPROCS_PARAORD, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
        IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      ENDIF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GOTO 20
      IF(ord%IDO) THEN
         CALL MUMPS_METIS_IDXSIZE(METIS_IDX_SIZE) 
         VERTLOCNBR = GCOMP_DIST%LAST-GCOMP_DIST%FIRST+1
         EDGELOCNBR = GCOMP_DIST%NZG
         VERTLOCTAB => GCOMP_DIST%IPE
         EDGELOCTAB => GCOMP_DIST%ADJ
         IF (id%KEEP(339).NE.0) THEN
          VELOLOCTAB=>SIZEOFBLOCKS(GCOMP_DIST%FIRST:GCOMP_DIST%LAST)
          SIZE_VELOLOCTAB = VERTLOCNBR
         ENDIF
         DO I=1,ord%NPROCS_PARAORD+1
          FIRST(I) = -99
          LAST(I)  = -99
         ENDDO
         BASE = 0
#if defined(AVOID_MPI_IN_PLACE)
         CALL MPI_ALLGATHER( GCOMP_DIST%FIRST, 1, MPI_INTEGER,
     &   FIRST, 1, MPI_INTEGER, ord%COMM_PARAORD, IERR )
         CALL MPI_ALLGATHER( GCOMP_DIST%LAST, 1, MPI_INTEGER,
     &   LAST, 1, MPI_INTEGER, ord%COMM_PARAORD, IERR )
#else
         FIRST(ord%MYID_PARAORD + 1)= GCOMP_DIST%FIRST
         LAST (ord%MYID_PARAORD + 1)= GCOMP_DIST%LAST
         CALL MPI_ALLREDUCE(MPI_IN_PLACE, FIRST(1), 
     &        ord%NPROCS_PARAORD+1,
     &        MPI_INTEGER, MPI_MAX, ord%COMM_PARAORD, IERR)
         CALL MPI_ALLREDUCE(MPI_IN_PLACE, LAST(1),  
     &        ord%NPROCS_PARAORD+1,
     &        MPI_INTEGER, MPI_MAX, ord%COMM_PARAORD, IERR)
#endif
         DO I=1, ord%NPROCS_PARAORD+1
          IF (FIRST(I).EQ.-99) THEN
            FIRST(I) = GCOMP_DIST%NG+1
          ENDIF
          IF (LAST(I).EQ.-99) THEN
            LAST (I) = GCOMP_DIST%NG
          ENDIF
         ENDDO
         OPTIONS(:) = 0
         ORDER => WORK(1:N)
         BASEVAL = 1
         IF (METIS_IDX_SIZE.EQ.32) THEN
           IF (id%KEEP(10).EQ.1) THEN
            id%INFO(1) = -52
            id%INFO(2) = 1
           ELSE
            CALL MUMPS_PARMETIS_MIXEDto32(id, 
     &           BASE, VERTLOCNBR, FIRST,
     &           VERTLOCTAB, EDGELOCTAB, BASEVAL, OPTIONS, ORDER,
     &           VELOLOCTAB, SIZE_VELOLOCTAB,
     &           SIZES, ord%COMM_PARAORD, ord%MYID_PARAORD, 
     &           IERR)
           ENDIF
         ELSE IF (METIS_IDX_SIZE.EQ.64) THEN
            CALL MUMPS_PARMETIS_MIXEDto64
     &           (id, BASE, VERTLOCNBR, FIRST,
     &           VERTLOCTAB, EDGELOCTAB, BASEVAL, OPTIONS, ORDER,
     &           VELOLOCTAB, SIZE_VELOLOCTAB,
     &           SIZES, ord%COMM_PARAORD, ord%MYID_PARAORD, 
     &           IERR)
         ELSE
              WRITE(*,*)
     &        "Internal error in PARMETIS wrappers, METIS_IDX_SIZE=",
     &        METIS_IDX_SIZE
              CALL MUMPS_ABORT()
         END IF
      END IF
      nullify(VERTLOCTAB, EDGELOCTAB)
      IF(IERR.GT.0) THEN
         id%INFO(1:2) = -50
      END IF
      ord%CBLKNBR = 2*ord%NPROCS_PARAORD-1
      CALL MUMPS_REALLOC(ord%RANGTAB, ord%CBLKNBR+1, id%INFO,
     &     LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      CALL MUMPS_REALLOC(RCVCNTS, id%NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GOTO 20
      IF (ord%IDO) THEN
        DO I=1, ord%NPROCS_PARAORD
           RCVCNTS(I) = max(LAST(I)-FIRST(I)+1,0)
        END DO
        FIRST = FIRST-1
        IF(FIRST(1) .LT. 0) THEN
          FIRST(1)   = 0
        END IF
        CALL MPI_GATHERV ( ORDER(1), VERTLOCNBR, MPI_INTEGER,
     &     ord%PERMTAB(1),
     &     RCVCNTS(1), FIRST(1), MPI_INTEGER, MASTER,
     &     ord%COMM_PARAORD, IERR )
      END IF 
      IF (ord%MYID_PARAORD.EQ.MASTER) THEN
        DO I=1, N
           ord%PERITAB(ord%PERMTAB(I)) = I
        END DO
      CALL MUMPS_REALLOC(ord%TREETAB, ord%CBLKNBR, id%INFO,
     &     LP, STRING='TREETAB', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL ZMUMPS_BUILD_TREETAB(ord%TREETAB, ord%RANGTAB,
     &     SIZES, ord%CBLKNBR)
      ENDIF
      CALL MUMPS_DEALLOC(SIZES, FIRST, LAST,
     &     RCVCNTS, MEMCNT=MEMCNT)
      CALL  MPI_BCAST (ord%CBLKNBR, 1,      MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      CALL  MPI_BCAST (ord%PERMTAB(1), N,   MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      CALL  MPI_BCAST (ord%PERITAB(1), N,   MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      CALL  MPI_BCAST (ord%RANGTAB(1), ord%CBLKNBR+1, MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      CALL  MPI_BCAST (ord%TREETAB(1), ord%CBLKNBR,   MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      CALL MUMPS_REALLOC(ord%SON, ord%CBLKNBR, id%INFO,
     &     LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%BROTHER, ord%CBLKNBR, id%INFO,
     &     LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%NW, ord%CBLKNBR, id%INFO,
     &     LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      CALL ZMUMPS_BUILD_TREE(ord)
      RETURN
 20   CONTINUE
      CALL MUMPS_DEALLOC(FIRST      , MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(LAST       , MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(SIZES      , MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(ord%RANGTAB, MEMCNT=MEMCNT)
      RETURN
      END SUBROUTINE ZMUMPS_PARMETIS_ORD_LUMAT
#endif
#if defined(ptscotch)
      SUBROUTINE ZMUMPS_PTSCOTCH_ORD(id, ord, WORK, LWORK, GCOMP_DIST,
     &                               SIZEOFBLOCKS)
!$    USE OMP_LIB
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)                :: id
      TYPE(ORD_TYPE)                    :: ord
      INTEGER, TARGET                   :: WORK(:)
      INTEGER(8), INTENT(IN)            :: LWORK
      TYPE(COMPACT_GRAPH_T), OPTIONAL   :: GCOMP_DIST
      INTEGER, INTENT(IN), OPTIONAL, TARGET:: SIZEOFBLOCKS(N)
      INTEGER                       :: MYID, NPROCS, IERR
      INTEGER, POINTER              :: FIRST(:),
     &     LAST(:), SWORK(:)
      INTEGER                       :: BASEVAL, VERTLOCNBR,
     &     BASE, SCOTCH_INT_SIZE
      INTEGER(8)                    :: EDGELOCNBR
      INTEGER(8), POINTER           :: VERTLOCTAB(:)
      INTEGER, POINTER              :: EDGELOCTAB(:)
      INTEGER, POINTER              :: VELOLOCTAB(:)
      INTEGER                       :: SIZE_VELOLOCTAB
      INTEGER, TARGET               :: IDUMMY(1)
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
      INCLUDE 'scotchf.h' 
      INTEGER          :: IOMP, NOMP
      DOUBLE PRECISION :: CONTDAT(SCOTCH_CONTEXTDIM)
      INTEGER(4)       :: IERR_SCOTCH
#else
      INTEGER :: PTHREAD_NUMBER, NOMP
#endif
      nullify(FIRST, LAST, SWORK, VERTLOCTAB, EDGELOCTAB)
      VELOLOCTAB => IDUMMY 
      CALL MPI_BARRIER(ord%COMM, IERR)
      MYID            = ord%MYID
      NPROCS          = ord%NPROCS
      SIZE_VELOLOCTAB = 0
      BASEVAL  = 1
      IF (id%KEEP(339).NE.0) THEN
        VERTLOCNBR = GCOMP_DIST%LAST-GCOMP_DIST%FIRST+1
        EDGELOCNBR = GCOMP_DIST%NZG
        VERTLOCTAB => GCOMP_DIST%IPE
        EDGELOCTAB => GCOMP_DIST%ADJ
        IF (id%KEEP(339).NE.0) THEN
         VELOLOCTAB => SIZEOFBLOCKS(GCOMP_DIST%FIRST:GCOMP_DIST%LAST)
         SIZE_VELOLOCTAB = VERTLOCNBR
        ENDIF
      ELSE
        IF (LWORK .LT. int(N,8)*3_8) THEN
            WRITE(LP,
     &      '("Insufficient workspace inside ZMUMPS_PTSCOTCH_ORD")')
            CALL MUMPS_ABORT()
        END IF
        BASE     = id%NPROCS-id%NSLAVES
        CALL MUMPS_REALLOC(FIRST, NPROCS+1, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
        CALL MUMPS_REALLOC(LAST, NPROCS+1, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
        IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
        CALL ZMUMPS_GRAPH_DIST(id, ord, FIRST,
     &     LAST, BASE, NPROCS, WORK(1: 2_8*int(N,8)),
     &     2_8*int(N,8), TYPE=2)
        VERTLOCNBR = LAST(MYID+1)-FIRST(MYID+1) + 1
        CALL MUMPS_I8REALLOC(VERTLOCTAB, VERTLOCNBR+1, id%INFO,
     &        LP, STRING='VERTLOCTAB', MEMCNT=MEMCNT, ERRCODE=-7)
        IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
        SWORK => WORK(int(N+1,8):3_8*int(N,8))
        CALL ZMUMPS_BUILD_DIST_GRAPH(id, ord, FIRST, LAST, VERTLOCTAB,
     &     EDGELOCTAB, SWORK, 2_8*int(N,8))
        CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, ord%MYID )
        IF ( id%INFO(1) .LT. 0 ) GOTO 11
        EDGELOCNBR = VERTLOCTAB(VERTLOCNBR+1)-1_8
      ENDIF
      CALL MUMPS_REALLOC(ord%PERMTAB, N, id%INFO,
     &   LP, STRING='PERMTAB', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%PERITAB, N, id%INFO,
     &   LP, STRING='PERITAB', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%RANGTAB, N+1, id%INFO,
     &   LP, STRING='RANGTAB', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%TREETAB, N, id%INFO,
     &   LP, STRING='TREETAB', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      IF(ord%IDO) THEN
         CALL MUMPS_SCOTCH_INTSIZE(SCOTCH_INT_SIZE)
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
!$OMP PARALLEL PRIVATE(IOMP, IERR_SCOTCH)
!$OMP SINGLE
         NOMP=omp_get_num_threads()
!$OMP END SINGLE
         IOMP=omp_get_thread_num()
         IF (IOMP.EQ.0) THEN
           CALL SCOTCHFCONTEXTINIT(CONTDAT, IERR_SCOTCH)
           CALL SCOTCHFCONTEXTRANDOMCLONE(CONTDAT, IERR_SCOTCH)
           CALL SCOTCHFCONTEXTTHREADIMPORT1(CONTDAT, NOMP, IERR_SCOTCH)
         ENDIF
!$OMP BARRIER
         CALL SCOTCHFCONTEXTTHREADIMPORT2(CONTDAT, IOMP, IERR_SCOTCH)
#else
         NOMP=0
!$       NOMP=omp_get_max_threads()
         IF (NOMP .GT. 0) THEN
           CALL MUMPS_SCOTCH_GET_PTHREAD_NUMBER (PTHREAD_NUMBER)
           CALL MUMPS_SCOTCH_SET_PTHREAD_NUMBER (NOMP)
         ENDIF
#endif
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
         IF (IOMP.EQ.0) THEN
#endif
           IF(SCOTCH_INT_SIZE.EQ.32) THEN
             IF (id%KEEP(10).EQ.1) THEN
              id%INFO(1) = -52
              id%INFO(2) = 2
             ELSE
              CALL MUMPS_PTSCOTCH_MIXEDto32(id, ord,
     &             BASEVAL, 
     &             VERTLOCNBR, VERTLOCTAB,
     &             EDGELOCNBR, EDGELOCTAB,
     &             VELOLOCTAB, SIZE_VELOLOCTAB,
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
     &             CONTDAT, SCOTCH_CONTEXTDIM,
#endif
     &             IERR)
            ENDIF
           ELSE
              CALL MUMPS_PTSCOTCH_MIXEDto64(id, ord,
     &             BASEVAL, 
     &             VERTLOCNBR, VERTLOCTAB,
     &             EDGELOCNBR, EDGELOCTAB,
     &             VELOLOCTAB, SIZE_VELOLOCTAB,
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
     &             CONTDAT, SCOTCH_CONTEXTDIM,
#endif
     &             IERR)
           END IF
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
           CALL SCOTCHFCONTEXTEXIT(CONTDAT)
         ENDIF 
!$OMP END PARALLEL
#else
         IF (NOMP .GT. 0) THEN
           CALL MUMPS_SCOTCH_SET_PTHREAD_NUMBER (PTHREAD_NUMBER)
         ENDIF
#endif
      END IF
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GOTO 11
      CALL  MPI_BCAST (ord%CBLKNBR, 1,      MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      CALL  MPI_BCAST (ord%PERMTAB(1), N,   MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      CALL  MPI_BCAST (ord%PERITAB(1), N,   MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      CALL  MPI_BCAST (ord%RANGTAB(1), ord%CBLKNBR+1, MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      CALL  MPI_BCAST (ord%TREETAB(1), ord%CBLKNBR,   MPI_INTEGER,
     &     ord%RKinSYMB_PROC0ORD, ord%COMM, IERR)
      CALL MUMPS_REALLOC(ord%SON, ord%CBLKNBR, id%INFO,
     &     LP, STRING='SON', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%BROTHER, ord%CBLKNBR, id%INFO,
     &     LP, STRING='BROTHER', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%NW, ord%CBLKNBR, id%INFO,
     &     LP, STRING='NW', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL ZMUMPS_BUILD_TREE(ord)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      ord%N = N
      IF (id%KEEP(339).NE.0) THEN
       nullify(VERTLOCTAB, EDGELOCTAB)
      ELSE
        CALL MUMPS_DEALLOC(EDGELOCTAB, MEMCNT=MEMCNT)
        CALL MUMPS_DEALLOC(FIRST     , MEMCNT=MEMCNT)
        CALL MUMPS_DEALLOC(LAST      , MEMCNT=MEMCNT)
        CALL MUMPS_I8DEALLOC(VERTLOCTAB, MEMCNT=MEMCNT)
      ENDIF
      RETURN
 11   CONTINUE
      IF (id%KEEP(339).NE.0) THEN
        CALL MUMPS_DEALLOC(FIRST      , MEMCNT=MEMCNT)
        CALL MUMPS_DEALLOC(LAST       , MEMCNT=MEMCNT)
        CALL MUMPS_DEALLOC(ord%RANGTAB, MEMCNT=MEMCNT)
        CALL MUMPS_DEALLOC(EDGELOCTAB, MEMCNT=MEMCNT)
        CALL MUMPS_I8DEALLOC(VERTLOCTAB, MEMCNT=MEMCNT)
      ELSE
       CALL MUMPS_DEALLOC(ord%RANGTAB, MEMCNT=MEMCNT)
       nullify(VERTLOCTAB, EDGELOCTAB)
      ENDIF
      RETURN
      END SUBROUTINE ZMUMPS_PTSCOTCH_ORD
#endif
      FUNCTION ZMUMPS_STOP_DESCENT(id, ord, NACTIVE, ANODE, RPROC,
     &     ALIST, LIST, PEAKMEM, NNODES, CHECKMEM)
      IMPLICIT NONE
      LOGICAL              :: ZMUMPS_STOP_DESCENT
      INTEGER              :: NACTIVE, RPROC, ANODE, PEAKMEM, NNODES
      INTEGER              :: ALIST(NNODES), LIST(NNODES)
      TYPE(ORD_TYPE)       :: ord
      TYPE(ZMUMPS_STRUC)   :: id
      LOGICAL, OPTIONAL    :: CHECKMEM
      INTEGER              :: IPEAKMEM, BIG, MAX_NROWS, MIN_NROWS
      INTEGER              :: TOPROWS, NRL, HOSTMEM, SUBMEM
      INTEGER              :: I, NZ_ROW, WEIGHT
      LOGICAL              :: ICHECKMEM
      INTEGER              :: NZ4
      IF(present(CHECKMEM)) THEN
         ICHECKMEM = CHECKMEM
      ELSE
         ICHECKMEM = .FALSE.
      END IF
      ZMUMPS_STOP_DESCENT = .FALSE.
      IF(NACTIVE .GE. RPROC) THEN
         ZMUMPS_STOP_DESCENT = .TRUE.
         RETURN
      END IF
      IF(NACTIVE .EQ. 0) THEN
         ZMUMPS_STOP_DESCENT = .TRUE.
         RETURN
      END IF
      IF(.NOT. ICHECKMEM) RETURN
      BIG = ALIST(NACTIVE)
      IF(NACTIVE .GT. 1) THEN
         MAX_NROWS = ord%NW(ALIST(NACTIVE-1))
         MIN_NROWS = ord%NW(ALIST(1))
      ELSE
         MAX_NROWS = 0
         MIN_NROWS = N
      END IF
      DO I=1, ANODE
         WEIGHT = ord%NW(LIST(I))
         IF(WEIGHT .GT. MAX_NROWS) MAX_NROWS = WEIGHT
         IF(WEIGHT .LT. MIN_NROWS) MIN_NROWS = WEIGHT
      END DO
      I = ord%SON(BIG)
      DO
         WEIGHT = ord%NW(I)
         IF(WEIGHT .GT. MAX_NROWS) MAX_NROWS = WEIGHT
         IF(WEIGHT .LT. MIN_NROWS) MIN_NROWS = WEIGHT
         IF(ord%BROTHER(I) .EQ. -1) EXIT
         I = ord%BROTHER(I)
      END DO
      TOPROWS = ord%TOPNODES(2)+ord%RANGTAB(BIG+1)-ord%RANGTAB(BIG)
      SUBMEM  = 7 *N 
      HOSTMEM = 12*N 
      NZ4=int(id%KEEP8(28))
      NZ_ROW = 2*(NZ4/N) 
      IF (id%KEEP(339).NE.0) THEN
         NRL = 0
      ELSE
        IF(id%KEEP(46) .EQ. 0) THEN
         NRL = 0
        ELSE
         NRL = MIN_NROWS
        END IF
      ENDIF
      HOSTMEM = HOSTMEM + 2*TOPROWS*NZ_ROW
      HOSTMEM = HOSTMEM +NRL
      HOSTMEM = HOSTMEM + max(NRL,TOPROWS)*(NZ_ROW+2)
      HOSTMEM = HOSTMEM + 6*max(NRL,TOPROWS)
      HOSTMEM = HOSTMEM + 3*TOPROWS
      NRL = MAX_NROWS
      SUBMEM = SUBMEM +NRL
      SUBMEM = SUBMEM + NRL*(NZ_ROW+2)
      SUBMEM = SUBMEM + 6*NRL
      IPEAKMEM = max(HOSTMEM, SUBMEM)
      IF((IPEAKMEM .GT. PEAKMEM) .AND.
     &     (PEAKMEM .NE. 0)) THEN
         ZMUMPS_STOP_DESCENT = .TRUE.
         RETURN
      ELSE
         ZMUMPS_STOP_DESCENT = .FALSE.
         PEAKMEM = IPEAKMEM
         RETURN
      END IF
      END FUNCTION ZMUMPS_STOP_DESCENT
      FUNCTION ZMUMPS_CNT_KIDS(NODE, ord)
      IMPLICIT NONE
      INTEGER :: ZMUMPS_CNT_KIDS
      INTEGER :: NODE
      TYPE(ORD_TYPE) :: ord
      INTEGER :: CURR
      ZMUMPS_CNT_KIDS = 0
      IF(ord%SON(NODE) .EQ. -1) THEN
         RETURN
      ELSE
         ZMUMPS_CNT_KIDS = 1
         CURR = ord%SON(NODE)
         DO
            IF(ord%BROTHER(CURR) .NE. -1) THEN
               ZMUMPS_CNT_KIDS = ZMUMPS_CNT_KIDS+1
               CURR = ord%BROTHER(CURR)
            ELSE
               EXIT
            END IF
         END DO
      END IF
      RETURN
      END FUNCTION ZMUMPS_CNT_KIDS
      SUBROUTINE ZMUMPS_GET_SUBTREES(ord, id)
      USE MUMPS_TOOLS_COMMON_M, ONLY : MUMPS_MERGESORT,
     &                                 MUMPS_MERGESWAP
      IMPLICIT NONE
      TYPE(ORD_TYPE)     :: ord
      TYPE(ZMUMPS_STRUC) :: id
      INTEGER, ALLOCATABLE :: ALIST(:), AWEIGHTS(:), LIST(:), WORK(:)
      INTEGER  :: NNODES, BIG, CURR, ND, NACTIVE, RPROC, ANODE, BASE, I,
     &     NK, PEAKMEM, allocok, Iprocdeb
      LOGICAL  :: SD
      NNODES = ord%NPROCS_PARAORD
      CALL MUMPS_REALLOC(ord%TOPNODES, 2*max(NNODES,2), id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%FIRST, ord%NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ord%LAST, ord%NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      ALLOCATE(ALIST(NNODES), AWEIGHTS(NNODES), LIST(NNODES),
     &     WORK(0:NNODES+1), stat=allocok)
      IF(allocok.GT.0) THEN
         id%INFO(1)=-13
         id%INFO(2)=4*NNODES+2
      ENDIF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GO TO 90
      NACTIVE = 0
      DO I=1, ord%CBLKNBR
         IF (ord%TREETAB(I).EQ.-1) THEN
            NACTIVE = NACTIVE+1
            IF(NACTIVE.LE.NNODES) THEN
               ALIST(NACTIVE) = I
               AWEIGHTS(NACTIVE) = ord%NW(I)
            END IF
         END IF
      END DO
      IF((ord%CBLKNBR .EQ. 1) .OR.
     &   (NACTIVE.GT.NNODES) .OR.
     &   ( NNODES .LT. ZMUMPS_CNT_KIDS(ord%CBLKNBR, ord) )) THEN
         ord%TOPNODES =0 
         ord%TOPNODES(1) = 1
         ord%TOPNODES(2) = ord%RANGTAB(ord%CBLKNBR+1) - ord%RANGTAB(1)
         ord%TOPNODES(3) = ord%RANGTAB(1)
         ord%TOPNODES(4) = ord%RANGTAB(ord%CBLKNBR+1)-1
         ord%FIRST = 0
         ord%LAST  = -1
         RETURN
      END IF
      CALL MUMPS_MERGESORT(NACTIVE, AWEIGHTS(1:NACTIVE),
     &     WORK(0:NACTIVE+1))
      CALL MUMPS_MERGESWAP(NACTIVE, WORK(0:NACTIVE+1),
     &     AWEIGHTS(1:NACTIVE), 
     &     ALIST(1:NACTIVE))
      RPROC       = NNODES   
      ANODE       = 0
      PEAKMEM     = 0
      ord%TOPNODES = 0
      DO
         IF(NACTIVE .EQ. 0) EXIT
         BIG = ALIST(NACTIVE)
         NK  = ZMUMPS_CNT_KIDS(BIG, ord)
         IF((NK .GT. (RPROC-NACTIVE+1)) .OR. (NK .EQ. 0)) THEN 
            ANODE       = ANODE+1
            LIST(ANODE) = BIG
            NACTIVE     = NACTIVE-1
            RPROC       = RPROC-1
            CYCLE
         END IF
         SD = ZMUMPS_STOP_DESCENT(id, ord, NACTIVE, ANODE,
     &        RPROC, ALIST, LIST, PEAKMEM, NNODES, CHECKMEM=.TRUE.)
         IF ( SD ) 
     &        THEN
            IF(NACTIVE.GT.0) THEN
               LIST(ANODE+1:ANODE+NACTIVE) = ALIST(1:NACTIVE)
               ANODE = ANODE+NACTIVE
            END IF
            EXIT
         END IF
         ord%TOPNODES(1) = ord%TOPNODES(1)+1
         ord%TOPNODES(2) = ord%TOPNODES(2) +
     &        ord%RANGTAB(BIG+1) - ord%RANGTAB(BIG)
         ord%TOPNODES(2+2*(ord%TOPNODES(1)-1)+1) = ord%RANGTAB(BIG)
         ord%TOPNODES(2+2*(ord%TOPNODES(1)-1)+2) = 
     &        ord%RANGTAB(BIG+1)-1
         CURR              = ord%SON(BIG)
         ALIST(NACTIVE)    = CURR
         AWEIGHTS(NACTIVE) = ord%NW(CURR)
         DO
            IF(ord%BROTHER(CURR) .EQ. -1) EXIT
            NACTIVE           = NACTIVE+1
            CURR              = ord%BROTHER(CURR)
            ALIST(NACTIVE)    = CURR
            AWEIGHTS(NACTIVE) = ord%NW(CURR)
         END DO
         CALL MUMPS_MERGESORT(NACTIVE, AWEIGHTS(1:NACTIVE),
     &        WORK(0:NACTIVE+1))
         CALL MUMPS_MERGESWAP(NACTIVE, WORK(0:NACTIVE+1),
     &        AWEIGHTS(1:NACTIVE), 
     &        ALIST(1:NACTIVE))
      END DO
      DO I=1, ANODE
         AWEIGHTS(I) = ord%NW(LIST(I))
      END DO
      CALL MUMPS_MERGESORT(ANODE, AWEIGHTS(1:ANODE), WORK(0:ANODE+1))
      CALL MUMPS_MERGESWAP(ANODE, WORK(0:ANODE+1), AWEIGHTS(1:ANODE), 
     &     ALIST(1:ANODE))
      IF (id%KEEP(339).NE.0) THEN
       Iprocdeb = ord%NPROCS-ANODE+1
       IF (Iprocdeb.GT.1) THEN
         DO I=1, Iprocdeb-1
           ord%FIRST(I) = 0
           ord%LAST(I)  = -1
         ENDDO
       ENDIF
       DO I=1, ANODE
         CURR = LIST(I)
         ND = CURR
         IF(ord%SON(ND) .NE. -1) THEN
            ND = ord%SON(ND)
            DO
               IF((ord%SON(ND) .EQ. -1) .AND. 
     &              (ord%BROTHER(ND).EQ.-1)) THEN
                  EXIT
               ELSE IF(ord%BROTHER(ND) .EQ. -1) THEN
                  ND = ord%SON(ND)
               ELSE 
                  ND = ord%BROTHER(ND)
               END IF
            END DO
         END IF
         ord%FIRST(Iprocdeb) = ord%RANGTAB(ND)
         ord%LAST(Iprocdeb)  = ord%RANGTAB(CURR+1)-1
         Iprocdeb = Iprocdeb +1
       ENDDO
      ELSE
      IF (id%KEEP(46) .EQ. 1) THEN
         BASE = 0
      ELSE
         ord%FIRST(1) = 0
         ord%LAST(1)  = -1
         BASE = 1
      END IF
      DO I=1, ANODE
         CURR = LIST(I)
         ND = CURR
         IF(ord%SON(ND) .NE. -1) THEN
            ND = ord%SON(ND)
            DO
               IF((ord%SON(ND) .EQ. -1) .AND. 
     &              (ord%BROTHER(ND).EQ.-1)) THEN
                  EXIT
               ELSE IF(ord%BROTHER(ND) .EQ. -1) THEN
                  ND = ord%SON(ND)
               ELSE 
                  ND = ord%BROTHER(ND)
               END IF
            END DO
         END IF
         ord%FIRST(BASE+I) = ord%RANGTAB(ND)
         ord%LAST(BASE+I)  = ord%RANGTAB(CURR+1)-1
      END DO
      DO I=ANODE+1, id%NSLAVES
         ord%FIRST(BASE+I) = N+1
         ord%LAST(BASE+I) = N
      END DO            
      ENDIF
      DEALLOCATE(LIST, ALIST, AWEIGHTS, WORK)
 90   continue
      RETURN
      END SUBROUTINE ZMUMPS_GET_SUBTREES
      SUBROUTINE ZMUMPS_PARSYMFACT(id, ord, GPE, GNV, WORK, LWORK)  
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)     :: id
      TYPE(ORD_TYPE)         :: ord
      INTEGER, POINTER       :: GPE(:), GNV(:)
      INTEGER, TARGET        :: WORK(:)
      INTEGER(8), INTENT(IN) :: LWORK
      TYPE(GRAPH_TYPE)       :: top_graph
      INTEGER(8), POINTER    :: IPE(:), IPET(:),
     &                          BUF_PE1(:), BUF_PE2(:), TMP1(:)
      INTEGER, POINTER       :: PE(:), LENG(:), I_HALO_MAP(:)
      INTEGER, POINTER       :: NDENSE(:), LAST(:),
     &                          DEGREE(:), W(:), PERM(:),
     &                          LISTVAR_SCHUR(:), NEXT(:),
     &                          HEAD(:), NV(:), ELEN(:),
     &                          LSTVAR(:)
      INTEGER, POINTER       :: MYLIST(:), LPERM(:), LIPERM(:),
     &                          NVT(:), BUF_NV1(:),
     &                          BUF_NV2(:), ROOTPERM(:),
     &                          TMP2(:), BWORK(:), NCLIQUES(:)
      INTEGER              :: MYNCLIQUES, MYMAXVARS, ICLIQUES,
     &     TOTNCLIQUES
      INTEGER(8)           :: MYNVARS, TOTNVARS
      INTEGER(8), POINTER  :: LVARPT(:)
      INTEGER              :: HIDX, TOTEL, 
     &     NCMPA, I, J, SIZE_SCHUR, MYID,
     &     NPROCS, IERR, NROWS_LOC, GLOB_IDX, TMP,
     &     NTVAR, TGSIZE, MAXS, RHANDPE,
     &     RHANDNV, RIDX, PROC, JOB, K
      INTEGER(8)           :: PFREES, PFS_SAVE, PELEN, PFREET, PFT_SAVE
      INTEGER              :: STATUSPE(MPI_STATUS_SIZE)
      INTEGER              :: STATUSNV(MPI_STATUS_SIZE)
      INTEGER              :: STATUSCLIQUES(MPI_STATUS_SIZE)
      INTEGER, PARAMETER   :: ITAG=30
      LOGICAL              :: AGG6
      INTEGER              :: THRESH
      nullify(PE, IPE, LENG, I_HALO_MAP, NCLIQUES)
      nullify(NDENSE, LAST, DEGREE, W, PERM, LISTVAR_SCHUR,
     &     NEXT, HEAD, NV, ELEN, LSTVAR)
      nullify(MYLIST, LVARPT,
     &     LPERM, LIPERM, IPET, NVT, BUF_PE1, BUF_PE2,
     &     BUF_NV1, BUF_NV2, ROOTPERM, TMP1, TMP2, BWORK)
      MYID   = ord%MYID
      NPROCS = ord%NPROCS
      IF(LWORK .LT. 4_8*int(N,8)) THEN
         WRITE(LP,*)'Insufficient workspace in ZMUMPS_PARSYMFACT'
         CALL MUMPS_ABORT()
      ELSE
         HEAD => WORK(              1 :         N    )
         ELEN => WORK(     int(N,8)+1 : 2_8*int(N,8) )
         LENG => WORK( 2_8*int(N,8)+1 : 3_8*int(N,8) )
         PERM => WORK( 3_8*int(N,8)+1 : 4_8*int(N,8) )
      END IF
      CALL ZMUMPS_GET_SUBTREES(ord, id)
      CALL MUMPS_IDEALLOC(ord%SON, ord%BROTHER, ord%NW,
     &     ord%RANGTAB, MEMCNT=MEMCNT)
      NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1
      NRL = NROWS_LOC
      TOPROWS = ord%TOPNODES(2)
      BWORK => WORK(1_8 : 2_8*int(N,8))
      CALL ZMUMPS_BUILD_LOC_GRAPH(id, ord, HIDX, IPE, PE, LENG,
     &     I_HALO_MAP, top_graph, BWORK, 2_8*int(N,8))
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, ord%MYID )
      IF(id%INFO(1).lt.0) RETURN
      TMP = N
      DO I=1, NPROCS
         TMP = TMP-(ord%LAST(I)-ord%FIRST(I)+1)
      END DO
      TMP = ceiling(dble(TMP)*1.10D0)
      IF(MYID .EQ. 0) THEN
         TMP = max(max(TMP, HIDX),1)
      ELSE
         TMP = max(HIDX,1)
      END IF
      SIZE_SCHUR = HIDX - NROWS_LOC
      CALL MUMPS_REALLOC(NDENSE, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(LAST, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(NEXT, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(DEGREE, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(W, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(NV, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(LISTVAR_SCHUR, max(SIZE_SCHUR,1), id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      DO I=1, SIZE_SCHUR
         LISTVAR_SCHUR(I) = NROWS_LOC+I
      END DO
      THRESH = -1
      AGG6   = .FALSE.
      PFREES = IPE(NROWS_LOC+1)
      PFS_SAVE = PFREES
      PELEN = PFREES-1 + 2_8*int(NROWS_LOC+ord%TOPNODES(2),8)
         DO I=1, HIDX
            PERM(I) = I
         END DO
         IF(SIZE_SCHUR.EQ.0) THEN
            JOB = 0
         ELSE
            JOB = 1
         END IF
         IF(HIDX .GT.0) THEN
           TOTEL = HIDX
           NV(1) = -1
           CALL MUMPS_SYMQAMD_NEW(JOB, THRESH, NDENSE(1), HIDX,
     &        TOTEL, PELEN, IPE(1), PFREES, LENG(1), PE(1), NV(1), 
     &        ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), NEXT(1), 
     &        W(1), PERM(1), LISTVAR_SCHUR(1), SIZE_SCHUR, AGG6)
         ENDIF
      MYNCLIQUES = 0
      MYNVARS    = 0
      MYMAXVARS  = 0
      DO I=1, HIDX
         IF(IPE(I) .GT. 0) THEN
            MYMAXVARS  = MAX(MYMAXVARS,LENG(I))
            MYNVARS    = MYNVARS+LENG(I)
            MYNCLIQUES = MYNCLIQUES+1
         END IF
      END DO
      CALL MPI_REDUCE(MYNVARS, TOTNVARS, 1, MPI_INTEGER8,
     &     MPI_SUM, 0, ord%COMM, IERR)
      CALL MUMPS_REALLOC(NCLIQUES, NPROCS, id%INFO,
     &     LP, STRING='NCLIQUES', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MPI_GATHER(MYNCLIQUES, 1, MPI_INTEGER, NCLIQUES(1), 1, 
     &     MPI_INTEGER, 0, ord%COMM, IERR)
      IF(ord%MYID.EQ.0) THEN
         TOTNCLIQUES = sum(NCLIQUES)
         CALL MUMPS_I8REALLOC(LVARPT, TOTNCLIQUES+1, id%INFO,
     &        LP, STRING='LVARPT', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_IREALLOC8(LSTVAR, TOTNVARS, id%INFO,
     &        LP, STRING='LSTVAR', MEMCNT=MEMCNT, ERRCODE=-7)
         LVARPT(1) = 1_8
         ICLIQUES  = 0
         DO I=1, HIDX
            IF(IPE(I) .GT. 0) THEN
               ICLIQUES = ICLIQUES+1
               LVARPT(ICLIQUES+1) = LVARPT(ICLIQUES)+LENG(I)
               DO J=0, LENG(I)-1
                  LSTVAR(LVARPT(ICLIQUES)+J) =
     &                 I_HALO_MAP(PE(IPE(I)+J)-NROWS_LOC)
               END DO
            END IF
         END DO
         DO PROC=1, NPROCS-1
            DO I=1, NCLIQUES(PROC+1)
               ICLIQUES = ICLIQUES+1
               CALL MPI_RECV(K, 1, MPI_INTEGER, PROC, ITAG, ord%COMM,
     &              STATUSCLIQUES, IERR)
               LVARPT(ICLIQUES+1) = LVARPT(ICLIQUES)+K
               CALL MPI_RECV(LSTVAR(LVARPT(ICLIQUES)), K, MPI_INTEGER,
     &              PROC, ITAG, ord%COMM, STATUSCLIQUES, IERR)
            END DO
         END DO
         LPERM => WORK(3_8*int(N,8)+1_8 : 4_8*int(N,8))
         NTVAR   = ord%TOPNODES(2)
         CALL ZMUMPS_MAKE_LOC_IDX(id, ord%TOPNODES, LPERM, LIPERM, ord)
         CALL ZMUMPS_ASSEMBLE_TOP_GRAPH(id, ord%TOPNODES(2), LPERM,
     &        top_graph, TOTNCLIQUES, LSTVAR, LVARPT, IPET, PE,
     &        LENG, ELEN)
         TGSIZE = ord%TOPNODES(2)+TOTNCLIQUES
         PFREET = IPET(TGSIZE+1)
         PFT_SAVE = PFREET
         nullify(LPERM)
      ELSE
         CALL MUMPS_REALLOC(MYLIST, MYMAXVARS, id%INFO,
     &        LP, STRING='MYLIST', MEMCNT=MEMCNT, ERRCODE=-7)
         IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
         DO I=1, HIDX
            IF(IPE(I) .GT. 0) THEN
               DO J=1, LENG(I)
                  MYLIST(J) = I_HALO_MAP(PE(IPE(I)+J-1)-NROWS_LOC)
               END DO
               CALL MPI_SEND(LENG(I), 1, MPI_INTEGER, 0, ITAG,
     &              ord%COMM, IERR)
               CALL MPI_SEND(MYLIST(1), LENG(I), MPI_INTEGER, 0, ITAG,
     &              ord%COMM, IERR)
            END IF
         END DO
      END IF
      CALL MUMPS_IDEALLOC(top_graph%IRN_LOC,
     &     top_graph%JCN_LOC, ord%TOPNODES, MEMCNT=MEMCNT)
      IF(MYID .EQ. 0) THEN
         CALL MUMPS_IREALLOC8(PE, max(PFREET+int(TGSIZE,8),1_8),id%INFO,
     &        LP, COPY=.TRUE., STRING='J2:PE', MEMCNT=MEMCNT,
     &        ERRCODE=-7)
         CALL MUMPS_REALLOC(NDENSE, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:NDENSE', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(NVT, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:NVT', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(LAST, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:LAST', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(DEGREE, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:DEGREE', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(NEXT, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:NEXT', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(W, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:W', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(LISTVAR_SCHUR, max(TOTNCLIQUES,1), id%INFO,
     &        LP, STRING='J2:LVSCH', MEMCNT=MEMCNT, ERRCODE=-7)
         IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
         DO I=1, TOTNCLIQUES
            LISTVAR_SCHUR(I) = NTVAR+I
         END DO
         THRESH = -1
            CALL MUMPS_REALLOC(HEAD, max(TGSIZE,1), id%INFO,
     &        LP, STRING='J2:HEAD', MEMCNT=MEMCNT, ERRCODE=-7)
            CALL MUMPS_REALLOC(PERM, max(TGSIZE,1), id%INFO,
     &           LP, COPY=.TRUE., STRING='J2:PERM',
     &           MEMCNT=MEMCNT, ERRCODE=-7)
            IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
            DO I=1, TGSIZE
               PERM(I) = I
            END DO
            PELEN = max(PFREET+int(TGSIZE,8),1_8)
            IF(TGSIZE.GT.0) THEN 
              TOTEL = TGSIZE
              NVT(1) = -1
              CALL MUMPS_SYMQAMD_NEW(2, -1, NDENSE(1), TGSIZE,
     &          TOTEL, PELEN, IPET(1), PFREET, LENG(1), PE(1), 
     &          NVT(1), ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), 
     &          NEXT(1), W(1), PERM(1), LISTVAR_SCHUR(1), TOTNCLIQUES, 
     &          AGG6)
             ENDIF
      END IF
      CALL MPI_BARRIER(ord%COMM, IERR)
      CALL MPI_BARRIER(ord%COMM, IERR)
      CALL MUMPS_DEALLOC(LISTVAR_SCHUR, MEMCNT=MEMCNT) 
      CALL MUMPS_DEALLOC(PE, MEMCNT=MEMCNT) 
      IF(MYID .EQ. 0) THEN
         MAXS = NROWS_LOC
         DO I=2, NPROCS
            IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS)
     &           MAXS = (ord%LAST(I)-ord%FIRST(I)+1)
         END DO
         CALL MUMPS_I8REALLOC(BUF_PE1, max(MAXS,1), id%INFO,
     &        LP, STRING='BUF_PE1', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_I8REALLOC(BUF_PE2, max(MAXS,1), id%INFO,
     &        LP, STRING='BUF_PE2', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(BUF_NV1, max(MAXS,1), id%INFO,
     &        LP, STRING='BUF_NV1', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(BUF_NV2, max(MAXS,1), id%INFO,
     &        LP, STRING='BUF_NV2', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(GPE, N, id%INFO,
     &        LP, STRING='GPE', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(GNV, N, id%INFO,
     &        LP, STRING='GNV', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(ROOTPERM, TOTNCLIQUES, id%INFO,
     &        LP, STRING='ROOTPERM', MEMCNT=MEMCNT, ERRCODE=-7)
         IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
         RIDX = 0
         TMP1    => BUF_PE1
         TMP2    => BUF_NV1
         NULLIFY(BUF_PE1, BUF_NV1)
         BUF_PE1 => IPE
         BUF_NV1 => NV
         DO PROC=0, NPROCS-2
            CALL MPI_IRECV(BUF_PE2(1), ord%LAST(PROC+2)-
     &           ord%FIRST(PROC+2)+1, MPI_INTEGER8, PROC+1, PROC+1,
     &           ord%COMM, RHANDPE, IERR)
            CALL MPI_IRECV(BUF_NV2(1), ord%LAST(PROC+2)-
     &           ord%FIRST(PROC+2)+1, MPI_INTEGER, PROC+1, PROC+1,
     &           ord%COMM, RHANDNV, IERR)
            DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1
               GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1)
               IF(BUF_PE1(I) .GT. 0) THEN
                  RIDX=RIDX+1
                  ROOTPERM(RIDX) = GLOB_IDX
                  GNV(GLOB_IDX) = BUF_NV1(I)
               ELSE IF (BUF_PE1(I) .EQ. 0) THEN
                  GPE(GLOB_IDX) = 0
                  GNV(GLOB_IDX) = BUF_NV1(I)
               ELSE
                  GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+
     &                 ord%FIRST(PROC+1)-1)
                  GNV(GLOB_IDX) = BUF_NV1(I)
               END IF
            END DO
            CALL MPI_WAIT(RHANDPE, STATUSPE, IERR)
            CALL MPI_WAIT(RHANDNV, STATUSNV, IERR)
            IF(PROC .NE. 0) THEN
               TMP1    => BUF_PE1
               TMP2    => BUF_NV1
            END IF
            BUF_PE1 => BUF_PE2
            BUF_NV1 => BUF_NV2
            NULLIFY(BUF_PE2, BUF_NV2)
            BUF_PE2 => TMP1
            BUF_NV2 => TMP2
            NULLIFY(TMP1, TMP2)
         END DO
         DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1
            GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1)
            IF(BUF_PE1(I) .GT. 0) THEN
               RIDX=RIDX+1
               ROOTPERM(RIDX) = GLOB_IDX
               GNV(GLOB_IDX) = BUF_NV1(I)
            ELSE IF (BUF_PE1(I) .EQ. 0) THEN
               GPE(GLOB_IDX) = 0
               GNV(GLOB_IDX) = BUF_NV1(I)
            ELSE
               GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+
     &              ord%FIRST(PROC+1)-1)
               GNV(GLOB_IDX) = BUF_NV1(I)
            END IF
         END DO
         DO I=1, NTVAR
            GLOB_IDX = LIPERM(I)
            IF(IPET(I) .EQ. 0) THEN
               GPE(GLOB_IDX) = 0
               GNV(GLOB_IDX) = NVT(I)
            ELSE
               GPE(GLOB_IDX) = -LIPERM(-IPET(I))
               GNV(GLOB_IDX) = NVT(I)
            END IF
         END DO
         DO I=1, TOTNCLIQUES
            GLOB_IDX      = ROOTPERM(I)
            GPE(GLOB_IDX) = -LIPERM(-IPET(NTVAR+I))
         END DO
      ELSE
         CALL MPI_SEND(IPE(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1,
     &        MPI_INTEGER8, 0, MYID, ord%COMM, IERR)
         CALL MPI_SEND(NV(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1,
     &        MPI_INTEGER, 0, MYID, ord%COMM, IERR)
      END IF
      CALL MUMPS_DEALLOC(BUF_NV1, BUF_NV2, MEMCNT=MEMCNT)
      CALL MUMPS_I8DEALLOC(BUF_PE1, BUF_PE2, IPE, IPET,
     &     TMP1, LVARPT, MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(PE, I_HALO_MAP, NDENSE,
     &     LAST, DEGREE, MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(W, LISTVAR_SCHUR, NEXT,
     &     NV, MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(LSTVAR, NCLIQUES, MYLIST, 
     &     MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(LPERM, LIPERM, NVT, MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(ROOTPERM, TMP2, MEMCNT=MEMCNT)
      NULLIFY(HEAD, ELEN, LENG, PERM)
      RETURN
      END SUBROUTINE ZMUMPS_PARSYMFACT
      SUBROUTINE ZMUMPS_PARSYMFACT_LUMAT(id, ord, GPE, GNV, WORK, LWORK,
     &                                   LUMAT, SIZEOFBLOCKS)  
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)   :: id
      TYPE(ORD_TYPE)       :: ord
      INTEGER, POINTER     :: GPE(:), GNV(:)
      INTEGER, TARGET      :: WORK(:)
      TYPE(LMATRIX_T), INTENT(IN) :: LUMAT
      INTEGER, INTENT(IN)  :: SIZEOFBLOCKS(id%NBLK)
      TYPE(GRAPH_TYPE)     :: top_graph
      INTEGER(8), POINTER  :: IPE(:), IPET(:),
     &     BUF_PE1(:), BUF_PE2(:), TMP1(:)
      INTEGER, POINTER     :: PE(:),
     &     LENG(:), I_HALO_MAP(:)
      INTEGER, POINTER     :: NDENSE(:), LAST(:),
     &     DEGREE(:), W(:), PERM(:),
     &     LISTVAR_SCHUR(:), NEXT(:),
     &     HEAD(:), NV(:), ELEN(:),
     &     LSTVAR(:)
      INTEGER, POINTER     :: MYLIST(:), 
     &     LPERM(:),
     &     LIPERM(:),
     &     NVT(:), BUF_NV1(:),
     &     BUF_NV2(:), ROOTPERM(:),
     &     TMP2(:), BWORK(:), NCLIQUES(:), MAPTAB(:)
      INTEGER              :: MYNCLIQUES, MYMAXVARS, ICLIQUES,
     &     TOTNCLIQUES
      INTEGER(8)           :: MYNVARS, TOTNVARS, LWORK
      INTEGER(8), POINTER  :: LVARPT(:)
      INTEGER              :: HIDX, TOTEL, 
     &     NCMPA, I, J, SIZE_SCHUR, MYID,
     &     NPROCS, IERR, NROWS_LOC, GLOB_IDX, TMP,
     &     NTVAR, TGSIZE, MAXS, RHANDPE,
     &     RHANDNV, RIDX, PROC, JOB, K
      INTEGER(8)           :: PFREES, PFS_SAVE, PELEN, PFREET, PFT_SAVE
      INTEGER              :: STATUSPE(MPI_STATUS_SIZE)
      INTEGER              :: STATUSNV(MPI_STATUS_SIZE)
      INTEGER              :: STATUSCLIQUES(MPI_STATUS_SIZE)
      INTEGER, PARAMETER   :: ITAG=30
      LOGICAL              :: AGG6
      INTEGER              :: THRESH
      nullify(PE, IPE, LENG, I_HALO_MAP, NCLIQUES)
      nullify(NDENSE, LAST, DEGREE, W, PERM, LISTVAR_SCHUR,
     &     NEXT, HEAD, NV, ELEN, LSTVAR)
      nullify(MYLIST, LVARPT, MAPTAB,
     &     LPERM, LIPERM, IPET, NVT, BUF_PE1, BUF_PE2,
     &     BUF_NV1, BUF_NV2, ROOTPERM, TMP1, TMP2, BWORK, MAPTAB)
      MYID   = ord%MYID
      NPROCS = ord%NPROCS
      IF( LWORK .LT. 4_8*int(N,8) ) THEN
         WRITE(LP,*)
     &      'Insufficient workspace in ZMUMPS_PARSYMFACT_LUMAT'
         CALL MUMPS_ABORT()
      ENDIF
      HEAD => WORK(              1   :         N    )
      ELEN => WORK(     int(N,8)+1_8 : 2_8*int(N,8) )
      LENG => WORK( 2_8*int(N,8)+1_8 : 3_8*int(N,8) )
      PERM => WORK( 3_8*int(N,8)+1_8 : 4_8*int(N,8) )
      CALL ZMUMPS_GET_SUBTREES(ord, id)
      CALL MUMPS_IDEALLOC(ord%SON, ord%BROTHER, ord%NW,
     &     ord%RANGTAB, MEMCNT=MEMCNT)
      NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1
      NRL = NROWS_LOC
      TOPROWS = ord%TOPNODES(2)
      BWORK  => WORK(1_8 : 2_8*int(N,8))
       CALL ZMUMPS_LUMAT_TO_LOC_GRAPH(
     &     LUMAT, id, ord, HIDX, IPE, PE, LENG,
     &     I_HALO_MAP, BWORK, 2_8*int(N,8))
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM, ord%MYID )
      IF(id%INFO(1).lt.0) RETURN
      TMP = N
      DO I=1, NPROCS
         TMP = TMP-(ord%LAST(I)-ord%FIRST(I)+1)
      END DO
      TMP = ceiling(dble(TMP)*1.10D0)
      IF(MYID .EQ. 0) THEN
         TMP = max(max(TMP, HIDX),1)
      ELSE
         TMP = max(HIDX,1)
      END IF
      SIZE_SCHUR = HIDX - NROWS_LOC
      CALL MUMPS_REALLOC(NDENSE, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(LAST, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(NEXT, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(DEGREE, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(W, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(NV, TMP, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(LISTVAR_SCHUR, max(SIZE_SCHUR,1), id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      DO I=1, SIZE_SCHUR
         LISTVAR_SCHUR(I) = NROWS_LOC+I
      END DO
      THRESH = -1
      AGG6   = .FALSE.
      PFREES = IPE(NROWS_LOC+1)
      PFS_SAVE = PFREES
      PELEN = PFREES-1 + 2_8*int(NROWS_LOC+ord%TOPNODES(2),8)
         DO I=1, HIDX
            PERM(I) = I
         END DO
         IF(SIZE_SCHUR.EQ.0) THEN
            JOB = 0
         ELSE
            JOB = 1
         END IF
         IF(HIDX .GT.0) THEN
           NV(1) = -1 
           TOTEL = HIDX
           IF ((N.LT.NORIG).OR.(id%KEEP(339).NE.0)) THEN
             TOTEL = 0
             DO I=1,NROWS_LOC
               NV(I) = SIZEOFBLOCKS (
     &                 ord%PERITAB(ord%FIRST(MYID+1)+I-1)
     &                                  )
               TOTEL = TOTEL + NV(I)
             ENDDO
             DO I=NROWS_LOC+1, HIDX
               NV(I) =  SIZEOFBLOCKS (I_HALO_MAP(I-NROWS_LOC))
               TOTEL = TOTEL + NV(I)
              ENDDO
           ENDIF
           CALL MUMPS_SYMQAMD_NEW(JOB, THRESH, NDENSE(1), HIDX,
     &        TOTEL, PELEN, IPE(1), PFREES, LENG(1), PE(1), NV(1), 
     &        ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), NEXT(1), 
     &        W(1), PERM(1), LISTVAR_SCHUR(1), SIZE_SCHUR, AGG6)
         ENDIF
      MYNCLIQUES = 0
      MYNVARS    = 0
      MYMAXVARS  = 0
      DO I=1, HIDX
         IF(IPE(I) .GT. 0) THEN
            MYMAXVARS  = MAX(MYMAXVARS,LENG(I))
            MYNVARS    = MYNVARS+LENG(I)
            MYNCLIQUES = MYNCLIQUES+1
         END IF
      END DO
      CALL MPI_REDUCE(MYNVARS, TOTNVARS, 1, MPI_INTEGER8,
     &     MPI_SUM, 0, ord%COMM, IERR)
      CALL MUMPS_REALLOC(NCLIQUES, NPROCS, id%INFO,
     &     LP, STRING='NCLIQUES', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MPI_GATHER(MYNCLIQUES, 1, MPI_INTEGER, NCLIQUES(1), 1, 
     &     MPI_INTEGER, 0, ord%COMM, IERR)
      IF(ord%MYID.EQ.0) THEN
         TOTNCLIQUES = sum(NCLIQUES)
         CALL MUMPS_I8REALLOC(LVARPT, TOTNCLIQUES+1, id%INFO,
     &        LP, STRING='LVARPT', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_IREALLOC8(LSTVAR, TOTNVARS, id%INFO,
     &        LP, STRING='LSTVAR', MEMCNT=MEMCNT, ERRCODE=-7)
         LVARPT(1) = 1_8
         ICLIQUES  = 0
         DO I=1, HIDX
            IF(IPE(I) .GT. 0) THEN
               ICLIQUES = ICLIQUES+1
               LVARPT(ICLIQUES+1) = LVARPT(ICLIQUES)+LENG(I)
               DO J=0, LENG(I)-1
                  LSTVAR(LVARPT(ICLIQUES)+J) =
     &                 I_HALO_MAP(PE(IPE(I)+J)-NROWS_LOC)
               END DO
            END IF
         END DO
         DO PROC=1, NPROCS-1
            DO I=1, NCLIQUES(PROC+1)
               ICLIQUES = ICLIQUES+1
               CALL MPI_RECV(K, 1, MPI_INTEGER, PROC, ITAG, ord%COMM,
     &              STATUSCLIQUES, IERR)
               LVARPT(ICLIQUES+1) = LVARPT(ICLIQUES)+K
               CALL MPI_RECV(LSTVAR(LVARPT(ICLIQUES)), K, MPI_INTEGER,
     &              PROC, ITAG, ord%COMM, STATUSCLIQUES, IERR)
            END DO
         END DO
      ELSE
         CALL MUMPS_REALLOC(MYLIST, MYMAXVARS, id%INFO,
     &        LP, STRING='MYLIST', MEMCNT=MEMCNT, ERRCODE=-7)
         IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
         DO I=1, HIDX
            IF(IPE(I) .GT. 0) THEN
               DO J=1, LENG(I)
                  MYLIST(J) = I_HALO_MAP(PE(IPE(I)+J-1)-NROWS_LOC)
               END DO
               CALL MPI_SEND(LENG(I), 1, MPI_INTEGER, 0, ITAG,
     &              ord%COMM, IERR)
               CALL MPI_SEND(MYLIST(1), LENG(I), MPI_INTEGER, 0, ITAG,
     &              ord%COMM, IERR)
            END IF
         END DO
      END IF
      CALL MUMPS_DEALLOC(PE, MEMCNT=MEMCNT) 
      IF (id%KEEP(339).NE.0) THEN
          MAPTAB => WORK(1:N)
          CALL MUMPS_BUILD_TOP_GRAPH (LUMAT, id, ord, top_graph, MAPTAB)
      ENDIF
      IF (MYID.EQ.0) THEN
        LPERM => WORK( 3_8*int(N,8)+1_8 : 4_8*int(N,8) )
        NTVAR = ord%TOPNODES(2)
        CALL ZMUMPS_MAKE_LOC_IDX(id, ord%TOPNODES, LPERM, LIPERM, ord)
        CALL ZMUMPS_ASSEMBLE_TOP_GRAPH(id, ord%TOPNODES(2), LPERM,
     &        top_graph, TOTNCLIQUES, LSTVAR, LVARPT, IPET, PE,
     &        LENG, ELEN)
        TGSIZE = ord%TOPNODES(2)+TOTNCLIQUES
        PFREET = IPET(TGSIZE+1)
        PFT_SAVE = PFREET
        nullify(LPERM)
      ENDIF
      CALL MUMPS_IDEALLOC(top_graph%IRN_LOC,
     &     top_graph%JCN_LOC, ord%TOPNODES, MEMCNT=MEMCNT)
      IF(MYID .EQ. 0) THEN
         CALL MUMPS_IREALLOC8(PE, max(PFREET+int(TGSIZE,8),1_8),id%INFO,
     &        LP, COPY=.TRUE., STRING='J2:PE', MEMCNT=MEMCNT,
     &        ERRCODE=-7)
         CALL MUMPS_REALLOC(NDENSE, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:NDENSE', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(NVT, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:NVT', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(LAST, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:LAST', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(DEGREE, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:DEGREE', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(NEXT, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:NEXT', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(W, max(TGSIZE,1), id%INFO, LP,
     &        STRING='J2:W', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(LISTVAR_SCHUR, max(TOTNCLIQUES,1), id%INFO,
     &        LP, STRING='J2:LVSCH', MEMCNT=MEMCNT, ERRCODE=-7)
         IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
         DO I=1, TOTNCLIQUES
            LISTVAR_SCHUR(I) = NTVAR+I
         END DO
         THRESH = -1
            CALL MUMPS_REALLOC(HEAD, max(TGSIZE,1), id%INFO,
     &        LP, STRING='J2:HEAD', MEMCNT=MEMCNT, ERRCODE=-7)
            CALL MUMPS_REALLOC(PERM, max(TGSIZE,1), id%INFO,
     &           LP, COPY=.TRUE., STRING='J2:PERM',
     &           MEMCNT=MEMCNT, ERRCODE=-7)
            IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
            DO I=1, TGSIZE
               PERM(I) = I
            END DO
            PELEN = max(PFREET+int(TGSIZE,8),1_8)
            IF(TGSIZE.GT.0) THEN 
              NVT(1) = -1 
              TOTEL = TGSIZE
              IF ((N.LT.NORIG).OR.(id%KEEP(339).NE.0)) THEN
                TOTEL = TOTNCLIQUES
                DO I=1,NTVAR
                  NVT(I) = SIZEOFBLOCKS( LIPERM(I) )
                  TOTEL = TOTEL + NVT(I)
                ENDDO
              ENDIF
              CALL MUMPS_SYMQAMD_NEW(2, -1, NDENSE(1),
     &           TGSIZE, TOTEL, PELEN, IPET(1), PFREET, LENG(1), PE(1), 
     &           NVT(1), ELEN(1), LAST(1), NCMPA, DEGREE(1), HEAD(1), 
     &           NEXT(1), W(1), PERM(1), LISTVAR_SCHUR(1), TOTNCLIQUES, 
     &           AGG6)
            ENDIF
        CALL MUMPS_DEALLOC(PE, MEMCNT=MEMCNT) 
      END IF
      CALL MPI_BARRIER(ord%COMM, IERR)
      CALL MPI_BARRIER(ord%COMM, IERR)
      CALL MUMPS_DEALLOC(LISTVAR_SCHUR, MEMCNT=MEMCNT) 
      IF(MYID .EQ. 0) THEN
         MAXS = NROWS_LOC
         DO I=2, NPROCS
            IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS)
     &           MAXS = (ord%LAST(I)-ord%FIRST(I)+1)
         END DO
         CALL MUMPS_I8REALLOC(BUF_PE1, max(MAXS,1), id%INFO,
     &        LP, STRING='BUF_PE1', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_I8REALLOC(BUF_PE2, max(MAXS,1), id%INFO,
     &        LP, STRING='BUF_PE2', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(BUF_NV1, max(MAXS,1), id%INFO,
     &        LP, STRING='BUF_NV1', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(BUF_NV2, max(MAXS,1), id%INFO,
     &        LP, STRING='BUF_NV2', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(GPE, N, id%INFO,
     &        LP, STRING='GPE', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(GNV, N, id%INFO,
     &        LP, STRING='GNV', MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_REALLOC(ROOTPERM, TOTNCLIQUES, id%INFO,
     &        LP, STRING='ROOTPERM', MEMCNT=MEMCNT, ERRCODE=-7)
         IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
         RIDX = 0
         TMP1    => BUF_PE1
         TMP2    => BUF_NV1
         NULLIFY(BUF_PE1, BUF_NV1)
         BUF_PE1 => IPE
         BUF_NV1 => NV
         DO PROC=0, NPROCS-2
            CALL MPI_IRECV(BUF_PE2(1), ord%LAST(PROC+2)-
     &           ord%FIRST(PROC+2)+1, MPI_INTEGER8, PROC+1, PROC+1,
     &           ord%COMM, RHANDPE, IERR)
            CALL MPI_IRECV(BUF_NV2(1), ord%LAST(PROC+2)-
     &           ord%FIRST(PROC+2)+1, MPI_INTEGER, PROC+1, PROC+1,
     &           ord%COMM, RHANDNV, IERR)
            DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1
               GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1)
               IF(BUF_PE1(I) .GT. 0) THEN
                  RIDX=RIDX+1
                  ROOTPERM(RIDX) = GLOB_IDX
                  GNV(GLOB_IDX) = BUF_NV1(I)
               ELSE IF (BUF_PE1(I) .EQ. 0) THEN
                  GPE(GLOB_IDX) = 0
                  GNV(GLOB_IDX) = BUF_NV1(I)
               ELSE
                  GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+
     &                 ord%FIRST(PROC+1)-1)
                  GNV(GLOB_IDX) = BUF_NV1(I)
               END IF
            END DO
            CALL MPI_WAIT(RHANDPE, STATUSPE, IERR)
            CALL MPI_WAIT(RHANDNV, STATUSNV, IERR)
            IF(PROC .NE. 0) THEN
               TMP1    => BUF_PE1
               TMP2    => BUF_NV1
            END IF
            BUF_PE1 => BUF_PE2
            BUF_NV1 => BUF_NV2
            NULLIFY(BUF_PE2, BUF_NV2)
            BUF_PE2 => TMP1
            BUF_NV2 => TMP2
            NULLIFY(TMP1, TMP2)
         END DO
         DO I=1, ord%LAST(PROC+1)-ord%FIRST(PROC+1)+1
            GLOB_IDX = ord%PERITAB(I+ord%FIRST(PROC+1)-1)
            IF(BUF_PE1(I) .GT. 0) THEN
               RIDX=RIDX+1
               ROOTPERM(RIDX) = GLOB_IDX
               GNV(GLOB_IDX) = BUF_NV1(I)
            ELSE IF (BUF_PE1(I) .EQ. 0) THEN
               GPE(GLOB_IDX) = 0
               GNV(GLOB_IDX) = BUF_NV1(I)
            ELSE
               GPE(GLOB_IDX) = -ord%PERITAB(-BUF_PE1(I)+
     &              ord%FIRST(PROC+1)-1)
               GNV(GLOB_IDX) = BUF_NV1(I)
            END IF
         END DO
         DO I=1, NTVAR
            GLOB_IDX = LIPERM(I)
            IF(IPET(I) .EQ. 0) THEN
               GPE(GLOB_IDX) = 0
               GNV(GLOB_IDX) = NVT(I)
            ELSE
               GPE(GLOB_IDX) = -LIPERM(-IPET(I))
               GNV(GLOB_IDX) = NVT(I)
            END IF
         END DO
         DO I=1, TOTNCLIQUES
            GLOB_IDX      = ROOTPERM(I)
            GPE(GLOB_IDX) = -LIPERM(-IPET(NTVAR+I))
         END DO
      ELSE
         CALL MPI_SEND(IPE(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1,
     &        MPI_INTEGER8, 0, MYID, ord%COMM, IERR)
         CALL MPI_SEND(NV(1), ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1,
     &        MPI_INTEGER, 0, MYID, ord%COMM, IERR)
      END IF
      CALL MUMPS_DEALLOC(BUF_NV1, BUF_NV2, MEMCNT=MEMCNT)
      CALL MUMPS_I8DEALLOC(BUF_PE1, BUF_PE2, IPE, IPET,
     &     TMP1, LVARPT, MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(PE, I_HALO_MAP, NDENSE,
     &     LAST, DEGREE, MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(W, LISTVAR_SCHUR, NEXT,
     &     NV, MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(LSTVAR, NCLIQUES, MYLIST, 
     &     MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(LPERM, LIPERM, NVT, MEMCNT=MEMCNT)
      CALL MUMPS_DEALLOC(ROOTPERM, TMP2, MEMCNT=MEMCNT)
      NULLIFY(HEAD, ELEN, LENG, PERM, BWORK, MAPTAB, LPERM)
      RETURN
      END SUBROUTINE ZMUMPS_PARSYMFACT_LUMAT
      SUBROUTINE ZMUMPS_MAKE_LOC_IDX(id, TOPNODES, LPERM, LIPERM, ord)
      IMPLICIT NONE 
      TYPE(ZMUMPS_STRUC)   :: id
      INTEGER, POINTER  :: TOPNODES(:), LPERM(:), LIPERM(:)
      TYPE(ORD_TYPE)    :: ord
      INTEGER           :: I, J, K, GIDX
      CALL MUMPS_REALLOC(LPERM , ord%N, id%INFO,
     &        LP, STRING='LIDX:LPERM', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(LIPERM, TOPNODES(2), id%INFO,
     &        LP, STRING='LIDX:LIPERM', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      LPERM = 0
      K = 1 
      DO I=TOPNODES(1), 1, -1
         DO J=TOPNODES(2*I+1), TOPNODES(2*I+2)
            GIDX        = ord%PERITAB(J) 
            LPERM(GIDX) = K
            LIPERM(K)   = GIDX
            K           = K+1
         END DO
      END DO
      RETURN
      END SUBROUTINE ZMUMPS_MAKE_LOC_IDX
      SUBROUTINE ZMUMPS_ASSEMBLE_TOP_GRAPH(id, NLOCVARS, LPERM,
     &     top_graph, NCLIQUES, LSTVAR, LVARPT, IPE, PE, LENG, ELEN)
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)  :: id
      TYPE(GRAPH_TYPE)    :: top_graph
      INTEGER, POINTER    :: LPERM(:), LSTVAR(:), 
     &     PE(:), LENG(:), ELEN(:)
      INTEGER(8)          :: LVARPT(:)
      INTEGER             :: NCLIQUES
      INTEGER(8), POINTER :: IPE(:)
      INTEGER             :: I, IDX, NLOCVARS
      INTEGER(8)          :: INNZ, PNT, SAVEPNT
      CALL MUMPS_REALLOC(LENG, max(NLOCVARS+NCLIQUES,1)  , id%INFO,
     &        LP, STRING='ATG:LENG', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(ELEN, max(NLOCVARS+NCLIQUES,1)  , id%INFO,
     &        LP, STRING='ATG:ELEN', MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_I8REALLOC(IPE , NLOCVARS+NCLIQUES+1, id%INFO,
     &        LP, STRING='ATG:IPE', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      LENG = 0
      ELEN = 0
      DO INNZ=1, top_graph%NZ_LOC
         IF((LPERM(top_graph%JCN_LOC(INNZ)) .NE. 0) .AND.
     &        (top_graph%JCN_LOC(INNZ) .NE. top_graph%IRN_LOC(INNZ)))
     &        THEN
            LENG(LPERM(top_graph%IRN_LOC(INNZ))) =
     &           LENG(LPERM(top_graph%IRN_LOC(INNZ))) + 1
         END IF
      END DO
      DO I=1, NCLIQUES
         DO INNZ=LVARPT(I), LVARPT(I+1)-1
            ELEN(LPERM(LSTVAR(INNZ))) = ELEN(LPERM(LSTVAR(INNZ)))+1
            LENG(NLOCVARS+I) = LENG(NLOCVARS+I)+1
         END DO
      END DO
      IPE(1) = 1
      DO I=1, NLOCVARS+NCLIQUES
         IPE(I+1) = IPE(I)+int(LENG(I),8)+int(ELEN(I),8)
      END DO
      CALL MUMPS_IREALLOC8(PE, IPE(NLOCVARS+NCLIQUES+1)+
     &     int(NLOCVARS,8)+int(NCLIQUES,8),
     &     id%INFO, LP, STRING='ATG:PE', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      LENG = 0
      ELEN = 0
      DO I=1, NCLIQUES
         DO INNZ=LVARPT(I), LVARPT(I+1)-1
            IDX = LPERM(LSTVAR(INNZ))
            PE(IPE(IDX)+int(ELEN(IDX),8)) = NLOCVARS+I
            PE(IPE(NLOCVARS+I)+int(LENG(NLOCVARS+I),8)) = IDX
            ELEN(LPERM(LSTVAR(INNZ))) = ELEN(LPERM(LSTVAR(INNZ)))+1
            LENG(NLOCVARS+I) = LENG(NLOCVARS+I)+1
         end do
      end do
      DO INNZ=1, top_graph%NZ_LOC
         IF((LPERM(top_graph%JCN_LOC(INNZ)) .NE. 0) .AND.
     &        (top_graph%JCN_LOC(INNZ) .NE. top_graph%IRN_LOC(INNZ)))
     &        THEN
            PE(IPE(LPERM(top_graph%IRN_LOC(INNZ)))+
     &           ELEN(LPERM(top_graph%IRN_LOC(INNZ))) +
     &           LENG(LPERM(top_graph%IRN_LOC(INNZ)))) =
     &           LPERM(top_graph%JCN_LOC(INNZ))
            LENG(LPERM(top_graph%IRN_LOC(INNZ))) =
     &           LENG(LPERM(top_graph%IRN_LOC(INNZ))) + 1
         END IF
      END DO
      DO I=1, NLOCVARS+NCLIQUES
         LENG(I) = LENG(I)+ELEN(I)
      END DO
      SAVEPNT = 1
      PNT = 0
      LPERM(1:NLOCVARS+NCLIQUES) = 0
      DO I=1, NLOCVARS+NCLIQUES
         DO INNZ=IPE(I), IPE(I+1)-1
            IF(LPERM(PE(INNZ)) .EQ. I) THEN
               LENG(I) = LENG(I)-1
            ELSE
               LPERM(PE(INNZ)) = I 
               PNT = PNT+1
               PE(PNT) = PE(INNZ)
            END IF
         END DO
         IPE(I) = SAVEPNT
         SAVEPNT = PNT+1
      END DO
      IPE(NLOCVARS+NCLIQUES+1) = SAVEPNT
      RETURN
      END SUBROUTINE ZMUMPS_ASSEMBLE_TOP_GRAPH
#if defined(parmetis) || defined(parmetis3)
      SUBROUTINE ZMUMPS_BUILD_TREETAB(TREETAB, RANGTAB, SIZES, CBLKNBR)
      INTEGER, POINTER  :: TREETAB(:), RANGTAB(:), SIZES(:)
      INTEGER           :: CBLKNBR,allocok
      INTEGER           :: LCHILD, RCHILD, K, I
      INTEGER, POINTER  :: PERM(:)
      ALLOCATE(PERM(CBLKNBR),stat=allocok)
      if(allocok.GT.0) then
         write(*,*) "Allocation error of PERM in ZMUMPS_BUILD_TREETAB"
         return
      endif
      TREETAB(CBLKNBR) = -1
      IF(CBLKNBR .EQ. 1) THEN
         DEALLOCATE(PERM)
         TREETAB(1) = -1
         RANGTAB(1) = 1
         RANGTAB(2)= SIZES(1)+1
         RETURN
      END IF
      LCHILD = CBLKNBR - (CBLKNBR+1)/2
      RCHILD = CBLKNBR-1
      K = 1
      PERM(CBLKNBR) = CBLKNBR
      PERM(LCHILD) = CBLKNBR+1 - (2*K+1)
      PERM(RCHILD) = CBLKNBR+1 - (2*K)
      TREETAB(RCHILD) = CBLKNBR
      TREETAB(LCHILD) = CBLKNBR
      IF(CBLKNBR .GT. 3) THEN
         CALL REC_TREETAB(TREETAB, PERM, (CBLKNBR-1)/2,
     &        LCHILD, CBLKNBR, 2*K+1)
         CALL REC_TREETAB(TREETAB, PERM, (CBLKNBR-1)/2,
     &        RCHILD, CBLKNBR, 2*K)
      END IF
      RANGTAB(1)=1
      DO I=1, CBLKNBR
         RANGTAB(I+1) = RANGTAB(I)+SIZES(PERM(I))
      END DO
      DEALLOCATE(PERM)
      RETURN
      CONTAINS
      RECURSIVE SUBROUTINE REC_TREETAB(TREETAB, PERM, SUBNODES,
     &     ROOTN, CBLKNBR, K)
      INTEGER, POINTER  :: TREETAB(:), PERM(:)
      INTEGER           :: SUBNODES, ROOTN, K, CBLKNBR
      INTEGER           :: LCHILD, RCHILD
      LCHILD = ROOTN - (SUBNODES+1)/2
      RCHILD = ROOTN-1
      PERM(LCHILD) = CBLKNBR+1 - (2*K+1)
      PERM(RCHILD) = CBLKNBR+1 - (2*K)
      TREETAB(RCHILD) = ROOTN
      TREETAB(LCHILD) = ROOTN
      IF(SUBNODES .GT. 3) THEN
         CALL REC_TREETAB(TREETAB, PERM, (SUBNODES-1)/2, LCHILD,
     &        CBLKNBR, 2*K+1)
         CALL REC_TREETAB(TREETAB, PERM, (SUBNODES-1)/2, RCHILD,
     &        CBLKNBR, 2*K)
      END IF
      END SUBROUTINE REC_TREETAB
      END SUBROUTINE ZMUMPS_BUILD_TREETAB
#endif
#if defined(ptscotch) || defined(parmetis) || defined(parmetis3)
      SUBROUTINE ZMUMPS_BUILD_DIST_GRAPH(id, ord, FIRST, LAST, IPE,
     &     PE, WORK, LWORK)
#if defined(DETERMINISTIC_PARALLEL_GRAPH)
      USE MUMPS_TOOLS_COMMON_M, ONLY : MUMPS_MERGESORT,
     &                                 MUMPS_MERGESWAP1
#endif
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)      :: id
      TYPE(ORD_TYPE)          :: ord
      INTEGER(8), POINTER     :: IPE(:)
      INTEGER, POINTER        :: FIRST(:), LAST(:), PE(:),
     &     WORK(:)
      INTEGER(8), INTENT(IN)  :: LWORK
      INTEGER                 :: IERR, MYID, NPROCS
      INTEGER                 :: I, PROC, J, LOC_ROW
      INTEGER(8)              :: LOCNNZ, INNZ, NEW_LOCNNZ, OFFDIAG,
     &                           RCVPNT, PNT, SAVEPNT, DUPS, TOTDUPS
      INTEGER                 :: NROWS_LOC
      INTEGER                 :: STATUS(MPI_STATUS_SIZE)
      INTEGER, POINTER        :: MAPTAB(:)
      INTEGER(8), POINTER     :: MSGCNT(:), SNDCNT(:), RCVCNT(:)
      INTEGER, POINTER        :: RDISPL(:), BUFLEVEL(:),
     &     SIPES(:,:), LENG(:)
      INTEGER, POINTER        :: TSENDI(:),
     &     TSENDJ(:), RCVBUF(:)
      TYPE(ARRPNT), POINTER   :: APNT(:)
      INTEGER                 :: BUFSIZE, SOURCE, MAXS, allocok
      INTEGER, PARAMETER      :: ITAG=30
      LOGICAL                 :: FLAG
      DOUBLE PRECISION        :: SYMMETRY
      INTEGER(KIND=8)         :: TLEN
#if defined(DETERMINISTIC_PARALLEL_GRAPH)
      INTEGER                 :: L
#endif
      nullify(MAPTAB, SNDCNT, RCVCNT)
      nullify(RDISPL, MSGCNT, SIPES, LENG, BUFLEVEL)
      nullify(TSENDI, TSENDJ, RCVBUF, APNT)
      MYID   = ord%MYID
      NPROCS = ord%NPROCS
      IF(LWORK .LT. int(N,8)*2_8) THEN
         WRITE(LP,
     &        '("Insufficient workspace inside BUILD_SCOTCH_GRAPH")')
         CALL MUMPS_ABORT()
      END IF
      CALL MUMPS_I8REALLOC(SNDCNT, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_I8REALLOC(RCVCNT, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_I8REALLOC(MSGCNT, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(RDISPL, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      ALLOCATE(APNT(NPROCS), stat=allocok)
      IF(allocok.GT.0) THEN
         id%INFO(1)=-13
         id%INFO(2)=NPROCS
      ENDIF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GO TO 90
      SNDCNT = 0
      BUFSIZE = 1000
      BUFSIZE = id%KEEP(39)
      LOCNNZ = id%KEEP8(29)
      NROWS_LOC = LAST(MYID+1)-FIRST(MYID+1)+1
      MAPTAB => WORK(       1    :         N )
      LENG   => WORK( int(N+1,8) : 2_8*int(N,8) )
      MAXS = 0
      DO I=1, NPROCS
         IF((LAST(I)-FIRST(I)+1) .GT. MAXS) THEN
            MAXS = LAST(I)-FIRST(I)+1
         END IF
         DO J=FIRST(I), LAST(I)
            MAPTAB(J) = I
         END DO
      END DO
      ALLOCATE(SIPES(max(1,MAXS), NPROCS), stat=allocok)
      IF(allocok.GT.0) THEN
         id%INFO(1)=-13
         id%INFO(2)=max(1,MAXS)*NPROCS
      ENDIF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GO TO 90
      OFFDIAG=0
      SIPES=0
      DO INNZ=1, LOCNNZ
         IF(id%IRN_loc(INNZ) .NE. id%JCN_loc(INNZ)) THEN
            OFFDIAG = OFFDIAG+1
            PROC = MAPTAB(id%IRN_loc(INNZ))
            LOC_ROW = id%IRN_loc(INNZ)-FIRST(PROC)+1
            SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1
            SNDCNT(PROC) = SNDCNT(PROC)+1
            PROC = MAPTAB(id%JCN_loc(INNZ))
            LOC_ROW = id%JCN_loc(INNZ)-FIRST(PROC)+1
            SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1
            SNDCNT(PROC) = SNDCNT(PROC)+1
         END IF
      END DO
      CALL MPI_ALLREDUCE (OFFDIAG, id%KEEP8(127), 1, MPI_INTEGER8,
     &     MPI_SUM, ord%COMM, IERR)
      id%KEEP8(127) = id%KEEP8(127)+3*N
      id%KEEP8(126) = id%KEEP8(127)-2*N
      CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER8, RCVCNT(1), 1,
     &     MPI_INTEGER8, ord%COMM, IERR)
      CALL MUMPS_I8DEALLOC(SNDCNT, MEMCNT=MEMCNT)
      RDISPL(:) = MAXS
      CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), RDISPL(1), 
     &     MPI_INTEGER, MPI_SUM, ord%COMM, IERR )
      DEALLOCATE(SIPES)
      TLEN = 0_8
      IPE(1) = 1_8
      DO I=1, NROWS_LOC
        IPE(I+1) = IPE(I) + int(LENG(I),8)
         TLEN = TLEN+int(LENG(I),8)
      END DO
      CALL MUMPS_IREALLOC8(PE, max(IPE(NROWS_LOC+1)-1_8,1_8), id%INFO,
     &        LP, STRING='PE', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      LENG(:) = 0
      CALL MUMPS_REALLOC(BUFLEVEL, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL ZMUMPS_SEND_BUF(APNT, PROC, NPROCS, BUFSIZE, IPE, PE, LENG,
     &     RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
      NEW_LOCNNZ = 0
      DO I=1, NPROCS
         NEW_LOCNNZ = NEW_LOCNNZ+RCVCNT(I)
         MSGCNT(I) = RCVCNT(I)/int(BUFSIZE,8)
      END DO
      RCVPNT = 1
      BUFLEVEL = 0 
      DO INNZ=1, LOCNNZ
         IF(mod(INNZ,int(BUFSIZE,8)/10_8) .EQ. 0) THEN
            CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, ord%COMM,
     &           FLAG, STATUS, IERR )
            IF(FLAG) THEN
               SOURCE = STATUS(MPI_SOURCE)
               CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE,
     &              ITAG, ord%COMM, STATUS, IERR)
               CALL ZMUMPS_ASSEMBLE_MSG(BUFSIZE, RCVBUF, IPE, PE, LENG)
               MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1
               RCVPNT = RCVPNT + BUFSIZE
            END IF
         END IF
         IF(id%IRN_loc(INNZ) .NE. id%JCN_loc(INNZ)) THEN
            PROC = MAPTAB(id%IRN_loc(INNZ))
            APNT(PROC)%BUF(2*BUFLEVEL(PROC)+1) = id%IRN_loc(INNZ)-
     &           FIRST(PROC)+1
            APNT(PROC)%BUF(2*BUFLEVEL(PROC)+2) = id%JCN_loc(INNZ)
            BUFLEVEL(PROC) = BUFLEVEL(PROC)+1
            IF(BUFLEVEL(PROC) .EQ. BUFSIZE) THEN
               CALL ZMUMPS_SEND_BUF(APNT, PROC, NPROCS, BUFSIZE, IPE,
     &              PE, LENG, RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
            END IF
            PROC = MAPTAB(id%JCN_loc(INNZ))
            APNT(PROC)%BUF(2*BUFLEVEL(PROC)+1) = id%JCN_loc(INNZ)-
     &           FIRST(PROC)+1
            APNT(PROC)%BUF(2*BUFLEVEL(PROC)+2) = id%IRN_loc(INNZ)
            BUFLEVEL(PROC) = BUFLEVEL(PROC)+1
            IF(BUFLEVEL(PROC) .EQ. BUFSIZE) THEN
               CALL ZMUMPS_SEND_BUF(APNT, PROC, NPROCS, BUFSIZE, IPE,
     &              PE, LENG, RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
            END IF
         END IF
      END DO
      CALL ZMUMPS_SEND_BUF(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG,
     &     RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
      DUPS = 0
      PNT = 0
      SAVEPNT = 1
      MAPTAB = 0
      DO I=1, NROWS_LOC
         DO INNZ=IPE(I),IPE(I+1)-1
            IF(MAPTAB(PE(INNZ)) .EQ. I) THEN
               DUPS = DUPS+1
            ELSE
               MAPTAB(PE(INNZ)) = I 
               PNT = PNT+1
               PE(PNT) = PE(INNZ)
            END IF
         END DO
         IPE(I) = SAVEPNT
         SAVEPNT = PNT+1
      END DO
      CALL MPI_REDUCE( DUPS, TOTDUPS, 1, MPI_INTEGER8, MPI_SUM,
     &     0,  ord%COMM, IERR )
      IF(MYID .EQ. 0) THEN
         SYMMETRY = dble(TOTDUPS)/(dble(id%KEEP8(28))-dble(N))
         SYMMETRY = min(SYMMETRY,1.0d0)
         IF(id%KEEP(50) .GE. 1) SYMMETRY = 1.d0
         IF(PROKG) WRITE(MPG,'(" Structural symmetry is:",i3,"%")')
     &        ceiling(SYMMETRY*100.d0)
         id%INFOG(8) = ceiling(SYMMETRY*100.0d0)
      END IF
      IPE(NROWS_LOC+1) = SAVEPNT
      CALL MUMPS_DEALLOC(BUFLEVEL, RDISPL, MEMCNT=MEMCNT)
      CALL MUMPS_I8DEALLOC(MSGCNT, SNDCNT, RCVCNT, MEMCNT=MEMCNT)
      DEALLOCATE(APNT)
#if defined(DETERMINISTIC_PARALLEL_GRAPH)
      DO I=1, LAST(MYID+1)-FIRST(MYID+1)+1
         L = int(IPE(I+1)-IPE(I))
         CALL MUMPS_MERGESORT(L,
     &        PE(IPE(I):IPE(I+1)-1),
     &        WORK(:))
         CALL MUMPS_MERGESWAP1(L, WORK(:),
     &        PE(IPE(I):IPE(I+1)-1))
      END DO
#endif
 90   continue
      RETURN
      END SUBROUTINE ZMUMPS_BUILD_DIST_GRAPH
#endif      
      SUBROUTINE ZMUMPS_BUILD_LOC_GRAPH(id, ord, GSIZE, IPE, PE, LENG,
     &     I_HALO_MAP, top_graph, WORK, LWORK)
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)   :: id
      TYPE(ORD_TYPE)       :: ord
      TYPE(GRAPH_TYPE)     :: top_graph
      INTEGER(8), POINTER  :: IPE(:)
      INTEGER, POINTER     :: PE(:), LENG(:),
     &     I_HALO_MAP(:), WORK(:)
      INTEGER(8), INTENT(in) :: LWORK
      INTEGER              :: GSIZE
      INTEGER                :: IERR, MYID, NPROCS
      INTEGER                :: I, PROC, J, LOC_ROW
      INTEGER(8)             :: LOCNNZ, INNZ, NEW_LOCNNZ, TOP_CNT, TIDX,
     &                          RCVPNT
      INTEGER                :: IIDX,JJDX
      INTEGER                :: HALO_SIZE, NROWS_LOC, DUPS
      INTEGER                :: STATUS(MPI_STATUS_SIZE)
      INTEGER(8), POINTER    :: MSGCNT(:), SNDCNT(:), RCVCNT(:)
      INTEGER, POINTER       :: MAPTAB(:),
     &     HALO_MAP(:), BUFLEVEL(:)
      INTEGER, POINTER       :: RDISPL(:),
     &     SIPES(:,:)
      INTEGER, POINTER       :: TSENDI(:),
     &     TSENDJ(:), RCVBUF(:)
      TYPE(ARRPNT), POINTER  :: APNT(:)
      INTEGER                :: BUFSIZE, SOURCE, MAXS, allocok
      INTEGER(8)             :: PNT, SAVEPNT
      INTEGER, PARAMETER     :: ITAG=30
      INTEGER(KIND=8)        :: TLEN
      LOGICAL                :: FLAG
      nullify(MAPTAB, SNDCNT, RCVCNT, HALO_MAP)
      nullify(RDISPL, MSGCNT, SIPES, BUFLEVEL)
      nullify(TSENDI, TSENDJ, RCVBUF, APNT)
      MYID   = ord%MYID
      NPROCS = ord%NPROCS
      IF( LWORK .LT. int(N,8)*2_8 ) THEN
         WRITE(LP,
     &        '("Insufficient workspace inside BUILD_LOC_GRAPH")')
         CALL MUMPS_ABORT()
      END IF
      MAPTAB   => WORK(      1    :         N   )
      HALO_MAP => WORK(int(N+1,8) : 2_8*int(N,8))
      CALL MUMPS_I8REALLOC(SNDCNT, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_I8REALLOC(RCVCNT, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_I8REALLOC(MSGCNT, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(RDISPL, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      ALLOCATE(APNT(NPROCS), stat=allocok)
      IF(allocok.GT.0) THEN
         id%INFO(1)=-13
         id%INFO(2)=NPROCS
      ENDIF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GO TO 90
      SNDCNT = 0
      TOP_CNT = 0
      BUFSIZE = 10000
      BUFSIZE = id%KEEP(39)
      LOCNNZ = id%KEEP8(29)
      NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1
      MAPTAB = 0
      MAXS = 0
      DO I=1, NPROCS
         IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS) THEN
            MAXS = ord%LAST(I)-ord%FIRST(I)+1
         END IF
         DO J=ord%FIRST(I), ord%LAST(I)
            MAPTAB(ord%PERITAB(J)) = I
         END DO
      END DO
      ALLOCATE(SIPES(max(1,MAXS), NPROCS), stat=allocok)
      IF(allocok.GT.0) THEN
         id%INFO(1)=-13
         id%INFO(2)=max(1,MAXS)*NPROCS
      ENDIF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GO TO 90
      SIPES(:,:)  = 0
      TOP_CNT     = 0
      DO INNZ=1, LOCNNZ
         IF(id%IRN_loc(INNZ) .NE. id%JCN_loc(INNZ)) THEN
            PROC = MAPTAB(id%IRN_loc(INNZ))
            IF(PROC .EQ. 0) THEN
               TOP_CNT = TOP_CNT+1
            ELSE
               IIDX = ord%PERMTAB(id%IRN_loc(INNZ))
               LOC_ROW = IIDX-ord%FIRST(PROC)+1
               SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1
               SNDCNT(PROC) = SNDCNT(PROC)+1
            END IF
            PROC = MAPTAB(id%JCN_loc(INNZ))
            IF(PROC .EQ. 0) THEN
               TOP_CNT = TOP_CNT+1
            ELSE
               IIDX = ord%PERMTAB(id%JCN_loc(INNZ))
               LOC_ROW = IIDX-ord%FIRST(PROC)+1
               SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+1
               SNDCNT(PROC) = SNDCNT(PROC)+1
            END IF
         END IF
      END DO
      CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER8, RCVCNT(1), 1,
     &     MPI_INTEGER8, ord%COMM, IERR)
      I = ceiling(dble(MAXS)*1.20D0)
      CALL MUMPS_REALLOC(LENG, max(I,1), id%INFO,
     &        LP, STRING='B_L_G:LENG', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      CALL MUMPS_I8DEALLOC(SNDCNT, MEMCNT=MEMCNT)
      RDISPL(:) = MAXS
      CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), RDISPL(1), 
     &     MPI_INTEGER, MPI_SUM, ord%COMM, IERR )
      DEALLOCATE(SIPES)
      I = ceiling(dble(NROWS_LOC+1)*1.20D0)
      CALL MUMPS_I8REALLOC(IPE, max(I,1), id%INFO,
     &        LP, STRING='B_L_G:IPE', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      TLEN = 0_8
      IPE(1) = 1_8
      DO I=1, NROWS_LOC
         IPE(I+1) = IPE(I) + int(LENG(I),8)
         TLEN = TLEN+int(LENG(I),8)
      END DO
      CALL MUMPS_IREALLOC8(TSENDI, max(TOP_CNT,1_8), id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_IREALLOC8(TSENDJ, max(TOP_CNT,1_8), id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      LENG(:) = 0
      CALL MUMPS_REALLOC(BUFLEVEL, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL ZMUMPS_SEND_BUF(APNT, PROC, NPROCS, BUFSIZE, IPE, PE,
     &     LENG, RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
      NEW_LOCNNZ = 0
      DO I=1, NPROCS
         NEW_LOCNNZ = NEW_LOCNNZ + RCVCNT(I)
         MSGCNT(I) = RCVCNT(I)/int(BUFSIZE,8)
      END DO
      CALL MUMPS_IREALLOC8(PE, max(NEW_LOCNNZ+
     &     2_8*int(NROWS_LOC+ord%TOPNODES(2),8),1_8),
     &     id%INFO, LP, STRING='B_L_G:PE', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      RCVPNT   = 1
      BUFLEVEL = 0 
      TIDX     = 0
      DO INNZ=1, LOCNNZ
         IF(mod(INNZ,int(BUFSIZE/10,8)) .EQ. 0) THEN
            CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, ord%COMM,
     &           FLAG, STATUS, IERR )
            IF(FLAG) THEN
               SOURCE = STATUS(MPI_SOURCE)
               CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE,
     &              ITAG, ord%COMM, STATUS, IERR)
               CALL ZMUMPS_ASSEMBLE_MSG(BUFSIZE, RCVBUF, IPE, PE, LENG)
               MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1
               RCVPNT = RCVPNT + BUFSIZE
            END IF
         END IF
         IF(id%IRN_loc(INNZ) .NE. id%JCN_loc(INNZ)) THEN
            PROC = MAPTAB(id%IRN_loc(INNZ))
            IF((MAPTAB(id%JCN_loc(INNZ)).NE.PROC) .AND.
     &           (MAPTAB(id%JCN_loc(INNZ)).NE.0)  .AND.
     &           (PROC.NE.0)) THEN
               IERR = -50
               id%INFO(1) = IERR
            END IF
            IF(PROC .EQ. 0) THEN
               TIDX = TIDX+1
               TSENDI(TIDX) = id%IRN_loc(INNZ)
               TSENDJ(TIDX) = id%JCN_loc(INNZ)
            ELSE
               IIDX = ord%PERMTAB(id%IRN_loc(INNZ))
               JJDX = ord%PERMTAB(id%JCN_loc(INNZ))
               APNT(PROC)%BUF(2*BUFLEVEL(PROC)+1)=IIDX-ord%FIRST(PROC)+1
               IF( (JJDX .GE. ord%FIRST(PROC)) .AND.
     &              (JJDX .LE. ord%LAST(PROC)) ) THEN
                  APNT(PROC)%BUF(2*BUFLEVEL(PROC)+2) =
     &            JJDX-ord%FIRST(PROC)+1
               ELSE
                  APNT(PROC)%BUF(2*BUFLEVEL(PROC)+2) = -id%JCN_loc(INNZ)
               END IF
               BUFLEVEL(PROC) = BUFLEVEL(PROC)+1
               IF(BUFLEVEL(PROC) .EQ. BUFSIZE) THEN
                  CALL ZMUMPS_SEND_BUF(APNT, PROC, NPROCS, BUFSIZE, IPE,
     &                 PE, LENG, RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
               END IF
            END IF
            PROC = MAPTAB(id%JCN_loc(INNZ))
            IF(PROC .EQ. 0) THEN
               TIDX = TIDX+1
               TSENDI(TIDX) = id%JCN_loc(INNZ)
               TSENDJ(TIDX) = id%IRN_loc(INNZ)
            ELSE
               IIDX = ord%PERMTAB(id%JCN_loc(INNZ))
               JJDX = ord%PERMTAB(id%IRN_loc(INNZ))
               APNT(PROC)%BUF(2*BUFLEVEL(PROC)+1) =
     &         IIDX-ord%FIRST(PROC)+1
               IF( (JJDX .GE. ord%FIRST(PROC)) .AND.
     &              (JJDX .LE. ord%LAST(PROC)) ) THEN
                  APNT(PROC)%BUF(2*BUFLEVEL(PROC)+2) =
     &            JJDX-ord%FIRST(PROC)+1
               ELSE
                  APNT(PROC)%BUF(2*BUFLEVEL(PROC)+2) = -id%IRN_loc(INNZ)
               END IF
               BUFLEVEL(PROC) = BUFLEVEL(PROC)+1
               IF(BUFLEVEL(PROC) .EQ. BUFSIZE) THEN
                  CALL ZMUMPS_SEND_BUF(APNT, PROC, NPROCS, BUFSIZE, IPE,
     &                 PE, LENG, RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
               END IF
            END IF
         END IF
      END DO
      CALL ZMUMPS_SEND_BUF(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG,
     &     RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
      DUPS = 0
      PNT = 0
      SAVEPNT = 1
      MAPTAB(:) = 0
      HALO_MAP(:) = 0
      HALO_SIZE = 0
      DO I=1, NROWS_LOC
         DO INNZ=IPE(I),IPE(I+1)-1
            IF(PE(INNZ) .LT. 0) THEN
               IF(HALO_MAP(-PE(INNZ)) .EQ. 0) THEN
                  HALO_SIZE = HALO_SIZE+1
                  HALO_MAP(-PE(INNZ)) = NROWS_LOC+HALO_SIZE
               END IF
               PE(INNZ) = HALO_MAP(-PE(INNZ))
            END IF
            IF(MAPTAB(PE(INNZ)) .EQ. I) THEN
               DUPS = DUPS+1
               LENG(I) = LENG(I)-1
            ELSE
               MAPTAB(PE(INNZ)) = I 
               PNT = PNT+1
               PE(PNT) = PE(INNZ)
            END IF
         END DO
         IPE(I) = SAVEPNT
         SAVEPNT = PNT+1
      END DO
      IPE(NROWS_LOC+1) = SAVEPNT
      CALL MUMPS_REALLOC(I_HALO_MAP, HALO_SIZE, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      J=0
      DO I=1, N
         IF(HALO_MAP(I) .GT. 0) THEN
            J = J+1
            I_HALO_MAP(HALO_MAP(I)-NROWS_LOC) = I
         END IF
         IF(J .EQ. HALO_SIZE) EXIT 
      END DO
      CALL MUMPS_REALLOC(LENG, max(NROWS_LOC+HALO_SIZE,1), id%INFO,
     &     LP, COPY=.TRUE.,
     &     STRING='lcgrph:leng', MEMCNT=MEMCNT, ERRCODE=-7)
      LENG(NROWS_LOC+1:NROWS_LOC+HALO_SIZE) = 0
      CALL MUMPS_I8REALLOC(IPE, NROWS_LOC+HALO_SIZE+1, id%INFO,
     &     LP, COPY=.TRUE.,
     &     STRING='lcgrph:ipe', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      IPE(NROWS_LOC+2:NROWS_LOC+HALO_SIZE+1) = IPE(NROWS_LOC+1)
      GSIZE = NROWS_LOC + HALO_SIZE
      CALL MPI_GATHER(TOP_CNT, 1, MPI_INTEGER8, RCVCNT(1), 1, 
     & MPI_INTEGER8, 0, ord%COMM, IERR)
      IF(MYID.EQ.0) THEN
         NEW_LOCNNZ = sum(RCVCNT)
         top_graph%NZ_LOC = NEW_LOCNNZ
         CALL MUMPS_IREALLOC8(top_graph%IRN_LOC, max(1_8,NEW_LOCNNZ), 
     &        id%INFO, LP, MEMCNT=MEMCNT, ERRCODE=-7)
         CALL MUMPS_IREALLOC8(top_graph%JCN_LOC, max(1_8,NEW_LOCNNZ), 
     &        id%INFO, LP, MEMCNT=MEMCNT, ERRCODE=-7)
         IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
         CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), 
     &         ord%COMM, ord%MYID)
         IF ( id%INFO(1) .LT. 0 ) GO TO 90
      ELSE
         ALLOCATE(top_graph%IRN_LOC(1), top_graph%JCN_LOC(1),
     &        stat=allocok)
         IF(allocok.GT.0) THEN
            id%INFO(1)=-13
            id%INFO(2)=2
         ENDIF
         CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), 
     &         ord%COMM, ord%MYID)
         IF ( id%INFO(1) .LT. 0 ) GO TO 90
      END IF
      IF(MYID.EQ.0) THEN
         top_graph%IRN_LOC(1:TOP_CNT) = TSENDI(1:TOP_CNT)
         top_graph%JCN_LOC(1:TOP_CNT) = TSENDJ(1:TOP_CNT)
         DO PROC=2, NPROCS
            DO WHILE (RCVCNT(PROC) .GT. 0)
               I = int(min(int(BUFSIZE,8), RCVCNT(PROC)))
               CALL MPI_RECV(top_graph%IRN_LOC(TOP_CNT+1), I,
     &              MPI_INTEGER, PROC-1, ITAG, ord%COMM, STATUS, IERR)
               CALL MPI_RECV(top_graph%JCN_LOC(TOP_CNT+1), I,
     &              MPI_INTEGER, PROC-1, ITAG, ord%COMM, STATUS, IERR)
               RCVCNT(PROC) = RCVCNT(PROC)-I
               TOP_CNT = TOP_CNT+I
            END DO
         END DO
      ELSE
         DO WHILE (TOP_CNT .GT. 0)
            I = int(MIN(int(BUFSIZE,8), TOP_CNT))
            CALL MPI_SEND(TSENDI(TOP_CNT-I+1), I,
     &           MPI_INTEGER, 0, ITAG, ord%COMM, IERR)
            CALL MPI_SEND(TSENDJ(TOP_CNT-I+1), I,
     &           MPI_INTEGER, 0, ITAG, ord%COMM, IERR)
            TOP_CNT = TOP_CNT-I
         END DO
      END IF
      CALL MUMPS_DEALLOC(BUFLEVEL, RDISPL, TSENDI,
     &     TSENDJ, MEMCNT=MEMCNT)
      CALL MUMPS_I8DEALLOC(MSGCNT, SNDCNT, RCVCNT, MEMCNT=MEMCNT)
      DEALLOCATE(APNT)
 90   continue
      RETURN
      END SUBROUTINE ZMUMPS_BUILD_LOC_GRAPH
      SUBROUTINE ZMUMPS_LUMAT_TO_LOC_GRAPH 
     &     (LUMAT, id, ord, GSIZE, IPE, PE, LENG,
     &     I_HALO_MAP, WORK, LWORK)
      IMPLICIT NONE
      TYPE(LMATRIX_T), INTENT(IN) :: LUMAT
      TYPE(ZMUMPS_STRUC)   :: id
      TYPE(ORD_TYPE)       :: ord
      INTEGER(8), POINTER  :: IPE(:)
      INTEGER, POINTER     :: PE(:), LENG(:),
     &     I_HALO_MAP(:), WORK(:)
      INTEGER(8), INTENT(IN) :: LWORK
      INTEGER              :: GSIZE
      INTEGER                :: IERR, MYID, NPROCS
      INTEGER                :: I, PROC, J, LOC_ROW 
      INTEGER                :: ROWSIZE, IORIG, JORIG, PROCJ
      INTEGER(8)             :: INNZ, NEW_LOCNNZ, RCVPNT
      INTEGER                :: IIDX,JJDX
      INTEGER                :: HALO_SIZE, NROWS_LOC
      INTEGER                :: STATUS(MPI_STATUS_SIZE)
      INTEGER(8), POINTER    :: MSGCNT(:), SNDCNT(:), RCVCNT(:)
      INTEGER, POINTER       :: MAPTAB(:)
      INTEGER, POINTER       :: HALO_MAP(:), BUFLEVEL(:)
      INTEGER, POINTER       :: RDISPL(:),  SIPES(:,:)
      INTEGER, POINTER       :: RCVBUF(:)
      TYPE(ARRPNT), POINTER  :: APNT(:)
      INTEGER                :: BUFSIZE, SOURCE, MAXS, allocok
      INTEGER, PARAMETER     :: ITAG=30
      INTEGER(KIND=8)        :: TLEN
      LOGICAL                :: FLAG
      nullify(MAPTAB, SNDCNT, RCVCNT, HALO_MAP)
      nullify(RDISPL, MSGCNT, SIPES, BUFLEVEL)
      nullify( RCVBUF, APNT)
      MYID   = ord%MYID
      NPROCS = ord%NPROCS
      IF ( LWORK .LT.2_8 * int(N,8) ) THEN
         WRITE(LP,
     &   '("Insufficient workspace inside ZMUMPS_LUMAT_TO_LOC_GRAPH")')
         CALL MUMPS_ABORT()
      END IF
      MAPTAB   => WORK(       1    :         N   )
      HALO_MAP => WORK( int(N+1,8) : 2_8*int(N,8))
      CALL MUMPS_I8REALLOC(SNDCNT, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_I8REALLOC(RCVCNT, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_I8REALLOC(MSGCNT, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_REALLOC(RDISPL, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      ALLOCATE(APNT(NPROCS), stat=allocok)
      IF(allocok.GT.0) THEN
         id%INFO(1)=-13
         id%INFO(2)=NPROCS
      ENDIF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GO TO 90
      SNDCNT = 0
      BUFSIZE = 10000
      BUFSIZE = id%KEEP(39)
      NROWS_LOC = ord%LAST(MYID+1)-ord%FIRST(MYID+1)+1
      MAPTAB = 0
      MAXS = 0
      DO I=1, NPROCS
         IF((ord%LAST(I)-ord%FIRST(I)+1) .GT. MAXS) THEN
            MAXS = ord%LAST(I)-ord%FIRST(I)+1
         END IF
         DO J=ord%FIRST(I), ord%LAST(I)
            MAPTAB(ord%PERITAB(J)) = I
         END DO
      END DO
      ALLOCATE(SIPES(max(1,MAXS), NPROCS), stat=allocok)
      IF(allocok.GT.0) THEN
         id%INFO(1)=-13
         id%INFO(2)=max(1,MAXS)*NPROCS
      ENDIF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GO TO 90
      SIPES    = 0
      DO J =1, LUMAT%NBCOL_LOC
         ROWSIZE = LUMAT%COL(J)%NBINCOL
         JORIG   = J + LUMAT%FIRST -1 
         PROC = MAPTAB(JORIG)
         IF(PROC .EQ. 0) CYCLE
         JJDX = ord%PERMTAB(JORIG)
         LOC_ROW = JJDX-ord%FIRST(PROC)+1
         SIPES(LOC_ROW, PROC) = SIPES(LOC_ROW, PROC)+ROWSIZE
         SNDCNT(PROC) = SNDCNT(PROC)+ROWSIZE
      ENDDO
      CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER8, RCVCNT(1), 1,
     &     MPI_INTEGER8, ord%COMM, IERR)
      I = ceiling(dble(MAXS)*1.20D0)
      CALL MUMPS_REALLOC(LENG, max(I,1), id%INFO,
     &        LP, STRING='B_L_G:LENG', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      CALL MUMPS_I8DEALLOC(SNDCNT, MEMCNT=MEMCNT)
      RDISPL(:) = MAXS
      CALL MPI_REDUCE_SCATTER ( SIPES(1,1), LENG(1), RDISPL(1), 
     &     MPI_INTEGER, MPI_SUM, ord%COMM, IERR )
      DEALLOCATE(SIPES)
      I = ceiling(dble(NROWS_LOC+1)*1.20D0)
      CALL MUMPS_I8REALLOC(IPE, max(I,1), id%INFO,
     &        LP, STRING='B_L_G:IPE', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      TLEN = 0_8
      IPE(1) = 1_8
      DO I=1, NROWS_LOC
         IPE(I+1) = IPE(I) + int(LENG(I),8)
         TLEN = TLEN+int(LENG(I),8)
      END DO
      LENG(:) = 0
      CALL MUMPS_REALLOC(BUFLEVEL, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL ZMUMPS_SEND_BUF(APNT, PROC, NPROCS, BUFSIZE, IPE, PE,
     &     LENG, RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
      NEW_LOCNNZ = 0
      DO I=1, NPROCS
         NEW_LOCNNZ = NEW_LOCNNZ + RCVCNT(I)
         MSGCNT(I) = RCVCNT(I)/int(BUFSIZE,8)
      END DO
      CALL MUMPS_IREALLOC8(PE, max(NEW_LOCNNZ+
     &     2_8*int(NROWS_LOC+ord%TOPNODES(2),8),1_8),
     &     id%INFO, LP, STRING='B_L_G:PE', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      RCVPNT   = 1
      BUFLEVEL = 0 
      INNZ     = 1
      DO I=1, LUMAT%NBCOL_LOC
       IF ( LUMAT%COL(I)%NBINCOL.EQ.0) CYCLE
       IORIG   = I + LUMAT%FIRST -1 
       PROC    = MAPTAB(IORIG)
       DO J=1,  LUMAT%COL(I)%NBINCOL
         IF(mod(INNZ,int(BUFSIZE/10,8)) .EQ. 0) THEN
            CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, ord%COMM,
     &           FLAG, STATUS, IERR )
            IF(FLAG) THEN
               SOURCE = STATUS(MPI_SOURCE)
               CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER, SOURCE,
     &              ITAG, ord%COMM, STATUS, IERR)
               CALL ZMUMPS_ASSEMBLE_MSG(BUFSIZE, RCVBUF, IPE, PE, LENG)
               MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1
               RCVPNT = RCVPNT + BUFSIZE
            END IF
         END IF
         INNZ    = INNZ +1
         JORIG = LUMAT%COL(I)%IRN(J)
         PROCJ = MAPTAB(JORIG)
         IF((PROCJ.NE.PROC) .AND.
     &           (PROC.NE.0)  .AND.
     &           (PROCJ.NE.0)) THEN
               IERR = -50
               id%INFO(1) = IERR
         END IF
         IF (PROC.NE.0) THEN
              IIDX = ord%PERMTAB(IORIG)
              JJDX = ord%PERMTAB(JORIG)
              APNT(PROC)%BUF(2*BUFLEVEL(PROC)+1)=IIDX-ord%FIRST(PROC)+1
               IF( (JJDX .GE. ord%FIRST(PROC)) .AND.
     &              (JJDX .LE. ord%LAST(PROC)) ) THEN
                  APNT(PROC)%BUF(2*BUFLEVEL(PROC)+2) =
     &            JJDX-ord%FIRST(PROC)+1
               ELSE
                  APNT(PROC)%BUF(2*BUFLEVEL(PROC)+2) = -JORIG
               END IF
               BUFLEVEL(PROC) = BUFLEVEL(PROC)+1
               IF(BUFLEVEL(PROC) .EQ. BUFSIZE) THEN
                  CALL ZMUMPS_SEND_BUF(APNT, PROC, NPROCS, BUFSIZE, IPE,
     &                 PE, LENG, RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
               END IF
            END IF
       ENDDO
      ENDDO
      CALL ZMUMPS_SEND_BUF(APNT, -1, NPROCS, BUFSIZE, IPE, PE, LENG,
     &     RCVBUF, MSGCNT, BUFLEVEL, ord%COMM)
      HALO_MAP(:) = 0
      HALO_SIZE = 0
      DO I=1, NROWS_LOC
         DO INNZ=IPE(I),IPE(I+1)-1
            IF(PE(INNZ) .LT. 0) THEN
               IF(HALO_MAP(-PE(INNZ)) .EQ. 0) THEN
                  HALO_SIZE = HALO_SIZE+1
                  HALO_MAP(-PE(INNZ)) = NROWS_LOC+HALO_SIZE
               END IF
               PE(INNZ) = HALO_MAP(-PE(INNZ))
            END IF
         END DO
      END DO
      CALL MUMPS_REALLOC(I_HALO_MAP, HALO_SIZE, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      J=0
      DO I=1, N
         IF(HALO_MAP(I) .GT. 0) THEN
            J = J+1
            I_HALO_MAP(HALO_MAP(I)-NROWS_LOC) = I
         END IF
         IF(J .EQ. HALO_SIZE) EXIT 
      END DO
      CALL MUMPS_REALLOC(LENG, max(NROWS_LOC+HALO_SIZE,1), id%INFO,
     &     LP, COPY=.TRUE.,
     &     STRING='lcgrph:leng', MEMCNT=MEMCNT, ERRCODE=-7)
      LENG(NROWS_LOC+1:NROWS_LOC+HALO_SIZE) = 0
      CALL MUMPS_I8REALLOC(IPE, NROWS_LOC+HALO_SIZE+1, id%INFO,
     &     LP, COPY=.TRUE.,
     &     STRING='lcgrph:ipe', MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      IPE(NROWS_LOC+2:NROWS_LOC+HALO_SIZE+1) = IPE(NROWS_LOC+1)
      GSIZE = NROWS_LOC + HALO_SIZE
      CALL MUMPS_DEALLOC(BUFLEVEL, RDISPL, MEMCNT=MEMCNT)
      CALL MUMPS_I8DEALLOC(MSGCNT, SNDCNT, RCVCNT, MEMCNT=MEMCNT)
      DEALLOCATE(APNT)
 90   continue
      RETURN
      END SUBROUTINE ZMUMPS_LUMAT_TO_LOC_GRAPH
      SUBROUTINE MUMPS_BUILD_TOP_GRAPH
     &     (LUMAT, id, ord, top_graph, MAPTAB)
      IMPLICIT NONE
      TYPE(LMATRIX_T), INTENT(IN) :: LUMAT
      TYPE(ZMUMPS_STRUC)   :: id
      TYPE(ORD_TYPE)       :: ord
      TYPE(GRAPH_TYPE)     :: top_graph
      INTEGER, POINTER     :: MAPTAB(:)
      INTEGER                :: IERR, MYID, NPROCS
      INTEGER                :: I, PROC, J, PROCJ
      INTEGER                :: ROWSIZE, IORIG, JORIG
      INTEGER(8)             :: NEW_LOCNNZ, TOP_CNT, TIDX
      INTEGER                :: STATUS(MPI_STATUS_SIZE)
      INTEGER(8), POINTER    :: RCVCNT(:)
      INTEGER, POINTER       :: TSENDI(:), TSENDJ(:) 
      INTEGER                :: BUFSIZE, allocok
      INTEGER, PARAMETER     :: ITAG=30
      nullify(RCVCNT,TSENDI,TSENDJ)
      MYID   = ord%MYID
      NPROCS = ord%NPROCS
       MAPTAB = 0
       DO I=1, NPROCS
         DO J=ord%FIRST(I), ord%LAST(I)
           MAPTAB(ord%PERITAB(J)) = I
         END DO
       END DO
      CALL MUMPS_I8REALLOC(RCVCNT, NPROCS, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), ord%COMM, ord%MYID )
      IF ( id%INFO(1) .LT. 0 ) GO TO 90
      TOP_CNT = 0
      BUFSIZE = 10000
      BUFSIZE = id%KEEP(39)
      TOP_CNT     = 0
      DO J =1, LUMAT%NBCOL_LOC
         JORIG   = J + LUMAT%FIRST -1 
         PROC = MAPTAB(JORIG)
         IF(PROC .EQ. 0) THEN
           ROWSIZE = LUMAT%COL(J)%NBINCOL
           TOP_CNT = TOP_CNT+ROWSIZE
         ENDIF
      ENDDO
      CALL MUMPS_IREALLOC8(TSENDI, max(TOP_CNT,1_8), id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_IREALLOC8(TSENDJ, max(TOP_CNT,1_8), id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      TIDX     = 0
      DO I=1, LUMAT%NBCOL_LOC
       IF ( LUMAT%COL(I)%NBINCOL.EQ.0) CYCLE
       IORIG   = I + LUMAT%FIRST -1 
       PROC    = MAPTAB(IORIG)
       IF (PROC.NE.0) CYCLE
       DO J=1,  LUMAT%COL(I)%NBINCOL
         JORIG = LUMAT%COL(I)%IRN(J)
         PROCJ = MAPTAB(JORIG)
         IF (PROCJ.EQ.0) THEN
               TIDX = TIDX+1
               TSENDI(TIDX) = IORIG
               TSENDJ(TIDX) = JORIG
         ENDIF
       ENDDO
      ENDDO
      CALL MPI_GATHER(TIDX, 1, MPI_INTEGER8, RCVCNT(1), 1, 
     & MPI_INTEGER8, 0, ord%COMM, IERR)
      IF(MYID.EQ.0) THEN
         NEW_LOCNNZ = sum(RCVCNT)
      ELSE
         NEW_LOCNNZ = 0_8
      ENDIF
      top_graph%NZ_LOC = NEW_LOCNNZ
      IF(MYID.EQ.0) THEN
       CALL MUMPS_IREALLOC8(top_graph%IRN_LOC, max(1_8,NEW_LOCNNZ), 
     &      id%INFO, LP, MEMCNT=MEMCNT, ERRCODE=-7)
       CALL MUMPS_IREALLOC8(top_graph%JCN_LOC, max(1_8,NEW_LOCNNZ), 
     &      id%INFO, LP, MEMCNT=MEMCNT, ERRCODE=-7)
       IF(MEMCNT .GT. MAXMEM) MAXMEM=MEMCNT
      ELSE
       ALLOCATE(top_graph%IRN_LOC(1), top_graph%JCN_LOC(1),
     &      stat=allocok)
       IF(allocok.GT.0) THEN
          id%INFO(1)=-13
          id%INFO(2)=2
         ENDIF
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), ord%COMM, ord%MYID)
      IF ( id%INFO(1) .LT. 0 ) GO TO 90
      IF(MYID.EQ.0) THEN
         top_graph%IRN_LOC(1:TIDX) = TSENDI(1:TIDX)
         top_graph%JCN_LOC(1:TIDX) = TSENDJ(1:TIDX)
         DO PROC=2, NPROCS
            DO WHILE (RCVCNT(PROC) .GT. 0)
               I = int(min(int(BUFSIZE,8), RCVCNT(PROC)))
               CALL MPI_RECV(top_graph%IRN_LOC(TIDX+1), I,
     &              MPI_INTEGER, PROC-1, ITAG, ord%COMM, STATUS, IERR)
               CALL MPI_RECV(top_graph%JCN_LOC(TIDX+1), I,
     &              MPI_INTEGER, PROC-1, ITAG, ord%COMM, STATUS, IERR)
               RCVCNT(PROC) = RCVCNT(PROC)-I
               TIDX = TIDX+I
            END DO
         END DO
      ELSE
         DO WHILE (TIDX .GT. 0)
            I = int(MIN(int(BUFSIZE,8), TIDX))
            CALL MPI_SEND(TSENDI(TIDX-I+1), I,
     &           MPI_INTEGER, 0, ITAG, ord%COMM, IERR)
            CALL MPI_SEND(TSENDJ(TIDX-I+1), I,
     &           MPI_INTEGER, 0, ITAG, ord%COMM, IERR)
            TIDX = TIDX-I
         END DO
      END IF
      CALL MUMPS_DEALLOC( TSENDI, TSENDJ, MEMCNT=MEMCNT)
      CALL MUMPS_I8DEALLOC(RCVCNT, MEMCNT=MEMCNT)
 90   continue
      RETURN
      END SUBROUTINE MUMPS_BUILD_TOP_GRAPH
      SUBROUTINE ZMUMPS_SEND_BUF(APNT, PROC, NPROCS, BUFSIZE, IPE, PE,
     &     LENG, RCVBUF, MSGCNT, SNDCNT, COMM)
      IMPLICIT NONE
      INTEGER                 :: NPROCS, PROC, COMM, allocok
      TYPE(ARRPNT)            :: APNT(:)
      INTEGER                 :: BUFSIZE
      INTEGER, POINTER        :: RCVBUF(:), LENG(:), PE(:)
      INTEGER                 :: SNDCNT(:)
      INTEGER(8)              :: MSGCNT(:), IPE(:)
      LOGICAL, SAVE           :: INIT = .TRUE.
      INTEGER, POINTER, SAVE  :: SPACE(:,:,:)
      LOGICAL, POINTER, SAVE  :: PENDING(:)
      INTEGER, POINTER, SAVE  :: REQ(:), CPNT(:)
      INTEGER                 :: IERR, MYID, I, SOURCE
      INTEGER(8)              :: TOTMSG
      LOGICAL                 :: FLAG, TFLAG
      INTEGER                 :: STATUS(MPI_STATUS_SIZE)
      INTEGER                 :: TSTATUS(MPI_STATUS_SIZE)
      INTEGER, PARAMETER      :: ITAG=30, FTAG=31
      INTEGER, POINTER        :: TMPI(:), RCVCNT(:)
      CALL MPI_COMM_RANK (COMM, MYID, IERR)
      CALL MPI_COMM_SIZE (COMM, NPROCS, IERR)
      IF(INIT) THEN
         ALLOCATE(SPACE(2*BUFSIZE, 2, NPROCS), stat=allocok)
         IF(allocok.GT.0) THEN
            write(*,*) "Allocation error of SPACE in ZMUMPS_SEND_BUF"
            return
         ENDIF
         ALLOCATE(RCVBUF(2*BUFSIZE), stat=allocok)
         IF(allocok.GT.0) THEN
            write(*,*) "Allocation error of RCVBUF in ZMUMPS_SEND_BUF"
            return
         ENDIF
         ALLOCATE(PENDING(NPROCS), CPNT(NPROCS), stat=allocok)
         IF(allocok.GT.0) THEN
            write(*,*) "Allocation error of PENDING/CPNT"
     &           ," in ZMUMPS_SEND_BUF"
            return
         ENDIF
         ALLOCATE(REQ(NPROCS), stat=allocok)
         IF(allocok.GT.0) THEN
            write(*,*) "Allocation error of REQ in ZMUMPS_SEND_BUF"
            return
         ENDIF
         PENDING = .FALSE.
         DO I=1, NPROCS
            APNT(I)%BUF => SPACE(:,1,I)
            CPNT(I)   = 1
         END DO
         INIT = .FALSE.
         RETURN
      END IF
      IF(PROC .EQ. -1) THEN
         TOTMSG = sum(MSGCNT)
         DO
            IF(TOTMSG .EQ. 0) EXIT
            CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER,
     &           MPI_ANY_SOURCE, ITAG, COMM, STATUS, IERR)
            CALL ZMUMPS_ASSEMBLE_MSG(BUFSIZE, RCVBUF, IPE, PE, LENG)
            SOURCE = STATUS(MPI_SOURCE)
            TOTMSG = TOTMSG-1
            MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1
         END DO
         DO I=1, NPROCS
            IF(PENDING(I)) THEN
               CALL MPI_WAIT(REQ(I), TSTATUS, IERR)
            END IF
         END DO
         ALLOCATE(RCVCNT(NPROCS), stat=allocok)
         IF(allocok.GT.0) THEN
            write(*,*) "Allocation error of RCVCNT in ZMUMPS_SEND_BUF"
            return
         ENDIF
         CALL MPI_ALLTOALL(SNDCNT(1), 1, MPI_INTEGER, RCVCNT(1), 1,
     &        MPI_INTEGER, COMM, IERR)
         DO I=1, NPROCS
            IF(SNDCNT(I) .GT. 0) THEN
               TMPI => APNT(I)%BUF(:)
               CALL MPI_ISEND(TMPI(1), 2*SNDCNT(I), MPI_INTEGER, I-1,
     &              FTAG, COMM, REQ(I), IERR)
            END IF
         END DO
         DO I=1, NPROCS
            IF(RCVCNT(I) .GT. 0) THEN
               CALL MPI_RECV(RCVBUF(1), 2*RCVCNT(I), MPI_INTEGER, I-1,
     &              FTAG, COMM, STATUS, IERR)
               CALL ZMUMPS_ASSEMBLE_MSG(RCVCNT(I), RCVBUF,
     &              IPE, PE, LENG)
            END IF
         END DO
         DO I=1, NPROCS
            IF(SNDCNT(I) .GT. 0) THEN
               CALL MPI_WAIT(REQ(I), TSTATUS, IERR)
            END IF
         END DO
         DEALLOCATE(SPACE)
         DEALLOCATE(PENDING, CPNT)
         DEALLOCATE(REQ)
         DEALLOCATE(RCVBUF, RCVCNT)
         nullify(SPACE, PENDING, CPNT, REQ, RCVBUF, RCVCNT)
         INIT = .TRUE.
         RETURN
      END IF
      IF(PENDING(PROC)) THEN
         DO
            CALL MPI_TEST(REQ(PROC), TFLAG, TSTATUS, IERR)
            IF(TFLAG) THEN
               PENDING(PROC) = .FALSE.
               EXIT
            ELSE
               CALL MPI_IPROBE( MPI_ANY_SOURCE, ITAG, COMM,
     &              FLAG, STATUS, IERR )
               IF(FLAG) THEN
                  SOURCE = STATUS(MPI_SOURCE)
                  CALL MPI_RECV(RCVBUF(1), 2*BUFSIZE, MPI_INTEGER,
     &                 SOURCE, ITAG, COMM, STATUS, IERR)
                  CALL ZMUMPS_ASSEMBLE_MSG(BUFSIZE, RCVBUF, IPE,
     &                 PE, LENG)
                  MSGCNT(SOURCE+1)=MSGCNT(SOURCE+1)-1
               END IF
            END IF
         END DO
      END IF
      TMPI => APNT(PROC)%BUF(:)
      CALL MPI_ISEND(TMPI(1), 2*BUFSIZE, MPI_INTEGER, PROC-1,
     &     ITAG, COMM, REQ(PROC), IERR)
      PENDING(PROC) = .TRUE.
      CPNT(PROC) = mod(CPNT(PROC),2)+1
      APNT(PROC)%BUF => SPACE(:,CPNT(PROC),PROC)
      SNDCNT(PROC)  = 0
      RETURN
      END SUBROUTINE ZMUMPS_SEND_BUF
      SUBROUTINE ZMUMPS_ASSEMBLE_MSG(BUFSIZE, RCVBUF, IPE, PE, LENG)
      IMPLICIT NONE
      INTEGER             :: BUFSIZE
      INTEGER             :: RCVBUF(:), PE(:), LENG(:)
      INTEGER(8)          :: IPE(:)
      INTEGER             :: I, ROW, COL
      DO I=1, 2*BUFSIZE, 2
         ROW = RCVBUF(I)
         COL = RCVBUF(I+1)
         PE(IPE(ROW)+LENG(ROW)) = COL
         LENG(ROW) = LENG(ROW) + 1
      END DO
      RETURN
      END SUBROUTINE ZMUMPS_ASSEMBLE_MSG 
#if defined(ptscotch) || defined(parmetis) || defined(parmetis3)
      SUBROUTINE ZMUMPS_BUILD_TREE(ord)
      TYPE(ORD_TYPE)  :: ord
      INTEGER :: I
      ord%SON     = -1
      ord%BROTHER = -1
      ord%NW      = 0
      DO I=1, ord%CBLKNBR
         ord%NW(I) = ord%NW(I)+ord%RANGTAB(I+1) - ord%RANGTAB(I)  
         IF (ord%TREETAB(I) .NE. -1) THEN
            IF (ord%SON(ord%TREETAB(I)) .EQ. -1) THEN
               ord%SON(ord%TREETAB(I)) = I
            ELSE
               ord%BROTHER(I) = ord%SON(ord%TREETAB(I))
               ord%SON(ord%TREETAB(I)) = I
            END IF
            ord%NW(ord%TREETAB(I)) = ord%NW(ord%TREETAB(I))+ ord%NW(I)
         END IF
      END DO
      RETURN
      END SUBROUTINE ZMUMPS_BUILD_TREE
      SUBROUTINE ZMUMPS_GRAPH_DIST(id, ord, FIRST,
     &     LAST, BASE, NPROCS, WORK, LWORK, TYPE)
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC)     :: id
      TYPE(ORD_TYPE)         :: ord
      INTEGER                :: FIRST(:), LAST(:), BASE, NPROCS, TYPE
      INTEGER, TARGET        :: WORK(:)
      INTEGER(8), INTENT(IN) :: LWORK
      INTEGER, POINTER       :: TMP(:), NZ_ROW(:)
      INTEGER                :: I, IERR, P, F, J
      INTEGER(8)             :: LOCNNZ, INNZ, LOCOFFDIAG,
     &     OFFDIAG, T, SHARE
      DO I=0, BASE-1
         FIRST(I+1) = 0
         LAST(I+1)  = -1
      END DO
      IF(TYPE.EQ.1) THEN
         SHARE = int(N/ord%NPROCS_PARAORD,8)
         DO I=1, ord%NPROCS_PARAORD
            FIRST(BASE+I) = (I-1)*int(SHARE)+1
            LAST (BASE+I) = (I)*int(SHARE)
         END DO
         LAST(BASE+ord%NPROCS_PARAORD) = 
     &                        MAX(LAST(BASE+ord%NPROCS_PARAORD), N)
         DO I = ord%NPROCS_PARAORD+1, id%NSLAVES+1
            FIRST(BASE+I) = N+1
            LAST (BASE+I) = N
         END DO
      ELSE IF (TYPE.EQ.2) THEN
         IF (LWORK .LT. 2_8*int(N,8)) THEN
           WRITE(*,*) "Insufficient workspace in ZMUMPS_GRAPH_DIST"
           CALL MUMPS_ABORT()
         ENDIF
         TMP    => WORK(1:N)
         NZ_ROW => WORK(int(N+1,8):2-8*int(N,8))
         TMP = 0
         LOCOFFDIAG = 0_8
         LOCNNZ = id%KEEP8(29)
         DO INNZ=1, LOCNNZ
            IF(id%IRN_loc(INNZ) .NE. id%JCN_loc(INNZ)) THEN
               TMP(id%IRN_loc(INNZ)) = TMP(id%IRN_loc(INNZ))+1
               LOCOFFDIAG = LOCOFFDIAG+1
               IF(id%SYM.GT.0) THEN
                  TMP(id%JCN_loc(INNZ)) = TMP(id%JCN_loc(INNZ))+1
                  LOCOFFDIAG = LOCOFFDIAG+1
               END IF
            END IF
         END DO
         CALL MUMPS_BIGALLREDUCE(.FALSE., TMP(1), NZ_ROW(1), N,
     &        MPI_INTEGER, MPI_SUM, ord%COMM, IERR)
         CALL MPI_ALLREDUCE(LOCOFFDIAG, OFFDIAG, 1,
     &        MPI_INTEGER8, MPI_SUM, ord%COMM, IERR)
         nullify(TMP)
         SHARE = (OFFDIAG-1_8)/int(ord%NPROCS_PARAORD,8) + 1_8
         P = 0
         T = 0_8
         F = 1
         DO I=1, N
            T = T+int(NZ_ROW(I),8)
            IF (
     &           (T .GE. SHARE) .OR.
     &           ((N-I).EQ.(ord%NPROCS_PARAORD-P-1)) .OR.
     &           (I.EQ.N)
     &           ) THEN
               P             = P+1
               IF(P.EQ.ord%NPROCS_PARAORD) THEN
                  FIRST(BASE+P) = F
                  LAST(BASE+P)  = N
                  EXIT
               ELSE
                  FIRST(BASE+P) = F
                  LAST(BASE+P)  = I
                  F             = I+1
                  T             = 0_8
               END IF
            END IF
         END DO
         DO J=P+1, NPROCS+1-BASE
            FIRST(BASE+J) = N+1
            LAST(BASE+J)  = N
         END DO
      END IF         
      RETURN
      END SUBROUTINE ZMUMPS_GRAPH_DIST
#endif     
      FUNCTION MUMPS_GETSIZE(A)
      INTEGER, POINTER :: A(:)
      INTEGER          :: MUMPS_GETSIZE
      IF(associated(A)) THEN
         MUMPS_GETSIZE = size(A)
      ELSE
         MUMPS_GETSIZE = 0_8
      END IF
      RETURN
      END FUNCTION MUMPS_GETSIZE
#if defined(parmetis) || defined(parmetis3)
      SUBROUTINE MUMPS_PARMETIS_MIXEDto32(id, 
     &     BASE, VERTLOCNBR, FIRST,
     &     VERTLOCTAB, EDGELOCTAB, BASEVAL, OPTIONS, ORDER,
     &     VELOLOCTAB, SIZE_VELOLOCTAB,
     &     SIZES, COMM, MYID, IERR)
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC) :: id
      INTEGER            :: FIRST(:), EDGELOCTAB(:), OPTIONS(:)
      INTEGER            :: SIZES(:), ORDER(:)
      INTEGER(8)         :: VERTLOCTAB(:)
      INTEGER            :: VERTLOCNBR, BASEVAL, IERR, COMM, MYID, 
     &                      BASE
      INTEGER            :: VELOLOCTAB(:)
      INTEGER            :: SIZE_VELOLOCTAB
      INTEGER, POINTER   :: VERTLOCTAB_I4(:)
      IF( VERTLOCTAB(VERTLOCNBR+1).GT.huge(VERTLOCNBR)) THEN
         id%INFO(1) = -51
         CALL MUMPS_SET_IERROR(
     &    VERTLOCTAB(VERTLOCNBR+1), id%INFO(2))
      END IF
      nullify(VERTLOCTAB_I4)
      CALL MUMPS_REALLOC(VERTLOCTAB_I4, VERTLOCNBR+1, id%INFO,
     &     id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     COMM, MYID )
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     COMM, MYID )
      IF ( id%INFO(1) .LT. 0 ) RETURN
      CALL MUMPS_ICOPY_64TO32(VERTLOCTAB(1),
     &     VERTLOCNBR+1, VERTLOCTAB_I4(1))
      IF (SIZE_VELOLOCTAB.EQ.VERTLOCNBR) THEN
       CALL MUMPS_PARMETIS_VWGT(FIRST(1+BASE), VERTLOCTAB_I4(1),
     &     EDGELOCTAB(1), BASEVAL, OPTIONS(1), ORDER(1),
     &     SIZES(1), COMM, VELOLOCTAB(1), IERR)
      ELSE
       CALL MUMPS_PARMETIS(FIRST(1+BASE), VERTLOCTAB_I4(1),
     &     EDGELOCTAB(1), BASEVAL, OPTIONS(1), ORDER(1),
     &     SIZES(1), COMM, IERR)
      ENDIF
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_DEALLOC(VERTLOCTAB_I4, MEMCNT=MEMCNT)
      RETURN
      END SUBROUTINE MUMPS_PARMETIS_MIXEDto32
      SUBROUTINE MUMPS_PARMETIS_MIXEDto64
     &     (id, BASE, VERTLOCNBR, FIRST,
     &     VERTLOCTAB, EDGELOCTAB, BASEVAL, OPTIONS, ORDER,
     &     VELOLOCTAB, SIZE_VELOLOCTAB,
     &     SIZES, COMM, MYID, IERR)
      IMPLICIT NONE
      TYPE(ZMUMPS_STRUC) :: id
      INTEGER            :: FIRST(:), EDGELOCTAB(:), OPTIONS(:)
      INTEGER            :: SIZES(:), ORDER(:)
      INTEGER(8)         :: VERTLOCTAB(:)
      INTEGER            :: VERTLOCNBR, BASEVAL, IERR, COMM, MYID,
     &                      BASE
      INTEGER            :: VELOLOCTAB(:)
      INTEGER            :: SIZE_VELOLOCTAB
      INTEGER(8), POINTER :: FIRST_I8(:), EDGELOCTAB_I8(:),
     &     SIZES_I8(:), ORDER_I8(:), VELOLOCTAB_I8(:)
      INTEGER(8)          :: VERTLOCNBR_I8
#if defined(parmetis)
      INTEGER(8), POINTER :: OPTIONS_I8(:)
      INTEGER(8)          :: BASEVAL_I8
      nullify(OPTIONS_I8)
      IF (id%KEEP(10).NE.1) THEN
       CALL MUMPS_I8REALLOC(OPTIONS_I8, size(OPTIONS), id%INFO,
     &     id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
       IF ( id%INFO(1) .LT. 0 ) RETURN
       CALL MUMPS_ICOPY_32TO64(OPTIONS(1), size(OPTIONS)
     &      , OPTIONS_I8(1))
       BASEVAL_I8 = int(BASEVAL,8)
      END IF
#endif
      nullify(FIRST_I8, EDGELOCTAB_I8, SIZES_I8, ORDER_I8, 
     &        VELOLOCTAB_I8)
      IF (id%KEEP(10).EQ.1) THEN
       IF (SIZE_VELOLOCTAB.EQ.VERTLOCNBR) THEN
        CALL MUMPS_PARMETIS_VWGT_64(FIRST(1+BASE), VERTLOCTAB(1),
     &     EDGELOCTAB(1),
     &     BASEVAL, OPTIONS(1),
     &     ORDER(1),
     &     SIZES(1), COMM, VELOLOCTAB(1), IERR)
       ELSE
        CALL MUMPS_PARMETIS_64(FIRST(1+BASE), VERTLOCTAB(1),
     &     EDGELOCTAB(1),
     &     BASEVAL, OPTIONS(1),
     &     ORDER(1),
     &     SIZES(1), COMM, IERR)
       ENDIF
      ELSE
       CALL MUMPS_I8REALLOC(FIRST_I8, size(FIRST), id%INFO,
     &     id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
       IF ( id%INFO(1) .LT. 0 ) GOTO 5
       IF (SIZE_VELOLOCTAB.EQ.VERTLOCNBR) THEN
        CALL MUMPS_I8REALLOC(VELOLOCTAB_I8, VERTLOCNBR, 
     &        id%INFO, id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
        IF ( id%INFO(1) .LT. 0 ) GOTO 5
       ENDIF
       CALL MUMPS_I8REALLOC8(EDGELOCTAB_I8, 
     &     VERTLOCTAB(VERTLOCNBR+1)-1_8,
     &     id%INFO, id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
       IF ( id%INFO(1) .LT. 0 ) GOTO 5
       CALL MUMPS_I8REALLOC(SIZES_I8, size(SIZES), id%INFO,
     &     id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
       IF ( id%INFO(1) .LT. 0 ) GOTO 5
       CALL MUMPS_I8REALLOC(ORDER_I8, size(ORDER), id%INFO,
     &     id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
       IF ( id%INFO(1) .LT. 0 ) GOTO 5
 5     CONTINUE
       CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     COMM, MYID )
       IF ( id%INFO(1) .LT. 0 ) RETURN
       CALL MUMPS_ICOPY_32TO64(FIRST(1), size(FIRST), FIRST_I8(1))
       CALL MUMPS_ICOPY_32TO64_64C(EDGELOCTAB(1),
     &     VERTLOCTAB(VERTLOCNBR+1)-1_8, EDGELOCTAB_I8(1))
       IF (SIZE_VELOLOCTAB.EQ.VERTLOCNBR) THEN
        VERTLOCNBR_I8 = int(VERTLOCNBR,8)
        CALL MUMPS_ICOPY_32TO64_64C(VELOLOCTAB(1),
     &     VERTLOCNBR_I8, VELOLOCTAB_I8(1))
       ENDIF
       IF (SIZE_VELOLOCTAB.EQ.VERTLOCNBR) THEN
        CALL MUMPS_PARMETIS_VWGT_64(FIRST_I8(1+BASE), VERTLOCTAB(1),
     &     EDGELOCTAB_I8(1),
#if defined(parmetis3)
     &     BASEVAL, OPTIONS(1),
#else
     &     BASEVAL_I8, OPTIONS_I8(1),
#endif
     &     ORDER_I8(1),
     &     SIZES_I8(1), COMM, VELOLOCTAB_I8(1),
     &     IERR)
       ELSE
        CALL MUMPS_PARMETIS_64(FIRST_I8(1+BASE), VERTLOCTAB(1),
     &     EDGELOCTAB_I8(1),
#if defined(parmetis3)
     &     BASEVAL, OPTIONS(1),
#else
     &     BASEVAL_I8, OPTIONS_I8(1),
#endif
     &     ORDER_I8(1),
     &     SIZES_I8(1), COMM, IERR)
       ENDIF
      END IF
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     COMM, MYID )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF ( id%KEEP(10) .NE. 1 ) THEN
        CALL MUMPS_ICOPY_64TO32(ORDER_I8(1),
     &       size(ORDER), ORDER(1))
        CALL MUMPS_ICOPY_64TO32(SIZES_I8(1),
     &       size(SIZES), SIZES(1))
      ENDIF
 10   CONTINUE 
      CALL MUMPS_I8DEALLOC(FIRST_I8, MEMCNT=MEMCNT)
      CALL MUMPS_I8DEALLOC(SIZES_I8, MEMCNT=MEMCNT)
      CALL MUMPS_I8DEALLOC(EDGELOCTAB_I8, MEMCNT=MEMCNT)
      CALL MUMPS_I8DEALLOC(ORDER_I8, MEMCNT=MEMCNT)
      IF (SIZE_VELOLOCTAB.EQ.VERTLOCNBR)
     & CALL MUMPS_I8DEALLOC(VELOLOCTAB_I8, MEMCNT=MEMCNT)
#if defined(parmetis)
      CALL MUMPS_I8DEALLOC(OPTIONS_I8, MEMCNT=MEMCNT)
#endif
      RETURN
      END SUBROUTINE MUMPS_PARMETIS_MIXEDto64
#endif
#if defined(ptscotch)
      SUBROUTINE MUMPS_PTSCOTCH_MIXEDto32(id, ord,
     &     BASEVAL, 
     &     VERTLOCNBR, VERTLOCTAB,
     &     EDGELOCNBR, EDGELOCTAB, 
     &     VELOLOCTAB, SIZE_VELOLOCTAB,
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
     &             CONTDAT, LCONTDAT,
#endif
     &     IERR)
      IMPLICIT NONE
      INCLUDE 'ptscotchf.h'
      TYPE(ZMUMPS_STRUC)  :: id
      TYPE(ORD_TYPE)      :: ord
      INTEGER             :: BASEVAL, VERTLOCNBR
      INTEGER(8)          :: EDGELOCNBR
      INTEGER(8)          :: VERTLOCTAB(:)
      INTEGER             :: EDGELOCTAB(:)
      INTEGER             :: VELOLOCTAB(:)
      INTEGER, INTENT(IN) :: SIZE_VELOLOCTAB
      INTEGER             :: IERR
      INTEGER, POINTER    :: VERTLOCTAB_I4(:)
      INTEGER             :: EDGELOCNBR_I4, MYWORKID
      DOUBLE PRECISION    :: GRAPHDAT(SCOTCH_DGRAPHDIM),
     &     ORDEDAT(SCOTCH_DORDERDIM), STRADAT(SCOTCH_STRATDIM),
     &     CORDEDAT(SCOTCH_ORDERDIM)
      CHARACTER  STRSTRING*1024
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
      INTEGER             :: LCONTDAT
      DOUBLE PRECISION    :: CONTDAT(LCONTDAT)
      DOUBLE PRECISION    :: GRAPHDAT_BEFORE_CONTEXT(SCOTCH_DGRAPHDIM)
#endif
      IF (.NOT.ord%IDO) RETURN
      nullify(VERTLOCTAB_I4)
      CALL MUMPS_REALLOC(VERTLOCTAB_I4, VERTLOCNBR+1, id%INFO, LP,
     &     MEMCNT=MEMCNT, ERRCODE=-7)
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) RETURN      
      CALL MUMPS_ICOPY_64TO32(VERTLOCTAB(1),
     &     VERTLOCNBR+1, VERTLOCTAB_I4(1))
      EDGELOCNBR_I4 = int(EDGELOCNBR)
      IF(ord%SUBSTRAT .NE. 0) THEN
         STRSTRING='n{sep=m{asc=b{width=3,strat=q{strat=f}},'//
     &        'low=q{strat=h},vert=1000,dvert=100,dlevl=0,'//
     &        'proc=1,seq=q{strat=m{type=h,vert=100,'//
     &        'low=h{pass=10},asc=b{width=3,bnd=f{bal=0.2},'//
     &        'org=h{pass=10}f{bal=0.2}}}}},ole=s,ose=s,osq=s}'
      END IF
      IF(ord%IDO) THEN
         CALL MPI_COMM_RANK (ord%COMM_PARAORD, MYWORKID, IERR)
      ELSE
         MYWORKID = -1
      END IF
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
      CALL MUMPS_DGRAPHINIT(GRAPHDAT_BEFORE_CONTEXT, ord%COMM_PARAORD,
     &                      IERR)
      CALL SCOTCHFCONTEXTBINDDGRAPH(CONTDAT, GRAPHDAT_BEFORE_CONTEXT,
     &                              GRAPHDAT, IERR)
#else
      CALL MUMPS_DGRAPHINIT(GRAPHDAT, ord%COMM_PARAORD, IERR)
#endif
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF (SIZE_VELOLOCTAB.EQ.VERTLOCNBR) THEN
       CALL SCOTCHFDGRAPHBUILD(GRAPHDAT, BASEVAL, VERTLOCNBR,
     &     VERTLOCNBR, VERTLOCTAB_I4(1), VERTLOCTAB_I4(2),
     &     VELOLOCTAB(1), VERTLOCTAB_I4(1), EDGELOCNBR_I4,
     &     EDGELOCNBR_I4, EDGELOCTAB(1), EDGELOCTAB(1),
     &     EDGELOCTAB(1), IERR)
      ELSE
       CALL SCOTCHFDGRAPHBUILD(GRAPHDAT, BASEVAL, VERTLOCNBR,
     &     VERTLOCNBR, VERTLOCTAB_I4(1), VERTLOCTAB_I4(2),
     &     VERTLOCTAB_I4(1), VERTLOCTAB_I4(1), EDGELOCNBR_I4,
     &     EDGELOCNBR_I4, EDGELOCTAB(1), EDGELOCTAB(1),
     &     EDGELOCTAB(1), IERR)
      ENDIF
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      CALL SCOTCHFSTRATINIT(STRADAT, IERR)
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF(ord%SUBSTRAT .NE. 0) THEN
         CALL SCOTCHFSTRATDGRAPHORDER(STRADAT, STRSTRING, IERR)
      END IF
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      CALL SCOTCHFDGRAPHORDERINIT(GRAPHDAT, ORDEDAT, IERR)
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      CALL SCOTCHFDGRAPHORDERCOMPUTE(GRAPHDAT, ORDEDAT, STRADAT,
     &     IERR)
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF(MYWORKID .EQ. 0) THEN
         CALL SCOTCHFDGRAPHCORDERINIT(GRAPHDAT, CORDEDAT,
     &        ord%PERMTAB(1), ord%PERITAB(1), ord%CBLKNBR,
     &        ord%RANGTAB(1), ord%TREETAB(1), IERR)
         IF(IERR.NE.0) THEN
            id%INFO(1:2) = -50
         END IF
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF(MYWORKID .EQ. 0) THEN
         CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT,
     &        CORDEDAT, IERR)
         IF(IERR.NE.0) THEN
            id%INFO(1:2) = -50
         END IF
      ELSE
         CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT,
     &        ORDEDAT, IERR)
         IF(IERR.NE.0) THEN
            id%INFO(1:2) = -50
         END IF
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF(MYWORKID .EQ. 0) 
     &     CALL SCOTCHFDGRAPHCORDEREXIT(GRAPHDAT, CORDEDAT)
      CALL SCOTCHFDGRAPHORDEREXIT(GRAPHDAT, ORDEDAT)
      CALL SCOTCHFSTRATEXIT(STRADAT)
      CALL SCOTCHFDGRAPHEXIT(GRAPHDAT)
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
      CALL SCOTCHFDGRAPHEXIT(GRAPHDAT_BEFORE_CONTEXT)
#endif
 10   CONTINUE
      CALL MUMPS_DEALLOC(VERTLOCTAB_I4, MEMCNT=MEMCNT)
      RETURN
      END SUBROUTINE MUMPS_PTSCOTCH_MIXEDto32
      SUBROUTINE MUMPS_PTSCOTCH_MIXEDto64(id, ord,
     &     BASEVAL, 
     &     VERTLOCNBR, VERTLOCTAB,
     &     EDGELOCNBR, EDGELOCTAB,
     &     VELOLOCTAB, SIZE_VELOLOCTAB,
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
     &             CONTDAT, LCONTDAT,
#endif
     &     IERR)
      IMPLICIT NONE
      INCLUDE 'ptscotchf.h'
      TYPE(ZMUMPS_STRUC)  :: id
      TYPE(ORD_TYPE)      :: ord
      INTEGER             :: BASEVAL, VERTLOCNBR
      INTEGER(8)          :: EDGELOCNBR
      INTEGER(8)          :: VERTLOCTAB(:)
      INTEGER             :: EDGELOCTAB(:)
      INTEGER             :: VELOLOCTAB(:)
      INTEGER, INTENT(IN) :: SIZE_VELOLOCTAB
      INTEGER             :: IERR
      INTEGER             :: MYWORKID
      DOUBLE PRECISION    :: GRAPHDAT(SCOTCH_DGRAPHDIM),
     &     ORDEDAT(SCOTCH_DORDERDIM), STRADAT(SCOTCH_STRATDIM),
     &     CORDEDAT(SCOTCH_ORDERDIM)
      CHARACTER  STRSTRING*1024
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
      INTEGER             :: LCONTDAT
      DOUBLE PRECISION    :: CONTDAT(LCONTDAT)
      DOUBLE PRECISION    :: GRAPHDAT_BEFORE_CONTEXT(SCOTCH_DGRAPHDIM)
#endif
      INTEGER(8), POINTER :: EDGELOCTAB_I8(:), PERMTAB_I8(:),
     &     PERITAB_I8(:), RANGTAB_I8(:), TREETAB_I8(:), VELOLOCTAB_I8(:)
      INTEGER(8)          :: CBLKNBR_I8, VERTLOCNBR_I8, BASEVAL_I8
      IF(ord%SUBSTRAT .NE. 0) THEN
         STRSTRING='n{sep=m{asc=b{width=3,strat=q{strat=f}},'//
     &        'low=q{strat=h},vert=1000,dvert=100,dlevl=0,'//
     &        'proc=1,seq=q{strat=m{type=h,vert=100,'//
     &        'low=h{pass=10},asc=b{width=3,bnd=f{bal=0.2},'//
     &        'org=h{pass=10}f{bal=0.2}}}}},ole=s,ose=s,osq=s}'
      END IF
      IF(ord%IDO) THEN
         CALL MPI_COMM_RANK (ord%COMM_PARAORD, MYWORKID, IERR)
      ELSE
         MYWORKID = -1
      END IF
      nullify(EDGELOCTAB_I8, PERMTAB_I8, PERITAB_I8,
     &     RANGTAB_I8, TREETAB_I8, VELOLOCTAB_I8)
      IF (id%KEEP(10).NE.1) THEN 
       CALL MUMPS_I8REALLOC8(EDGELOCTAB_I8, 
     &     VERTLOCTAB(VERTLOCNBR+1)-1_8,
     &     id%INFO, id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
       IF ( id%INFO(1) .LT. 0 ) GOTO 5
       IF (SIZE_VELOLOCTAB.EQ.VERTLOCNBR) THEN
        CALL MUMPS_I8REALLOC(VELOLOCTAB_I8, VERTLOCNBR, 
     &        id%INFO, id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
        IF ( id%INFO(1) .LT. 0 ) GOTO 5
       ENDIF
       IF (MYWORKID .EQ. 0) THEN
         CALL MUMPS_I8REALLOC(PERMTAB_I8, size(ord%PERMTAB),
     &        id%INFO, id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
         IF ( id%INFO(1) .LT. 0 ) GOTO 5
         CALL MUMPS_I8REALLOC(PERITAB_I8, size(ord%PERITAB),
     &        id%INFO, id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
         IF ( id%INFO(1) .LT. 0 ) GOTO 5
         CALL MUMPS_I8REALLOC(TREETAB_I8, size(ord%TREETAB),
     &        id%INFO, id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
         IF ( id%INFO(1) .LT. 0 ) GOTO 5
         CALL MUMPS_I8REALLOC(RANGTAB_I8, size(ord%RANGTAB),
     &        id%INFO, id%ICNTL(1), MEMCNT=MEMCNT, ERRCODE=-7)
       END IF
 5     CONTINUE
       CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
       IF ( id%INFO(1) .LT. 0 ) RETURN
       CALL MUMPS_ICOPY_32TO64_64C(EDGELOCTAB(1),
     &     VERTLOCTAB(VERTLOCNBR+1)-1_8, EDGELOCTAB_I8(1))
       VERTLOCNBR_I8 = int(VERTLOCNBR,8)
       IF (SIZE_VELOLOCTAB.EQ.VERTLOCNBR) THEN
        CALL MUMPS_ICOPY_32TO64_64C(VELOLOCTAB(1),
     &     VERTLOCNBR_I8, VELOLOCTAB_I8(1))
       ENDIF
       BASEVAL_I8    = int(BASEVAL,8)
      ENDIF
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
      CALL MUMPS_DGRAPHINIT(GRAPHDAT_BEFORE_CONTEXT, ord%COMM_PARAORD,
     &                      IERR)
      CALL SCOTCHFCONTEXTBINDDGRAPH(CONTDAT, GRAPHDAT_BEFORE_CONTEXT,
     &                              GRAPHDAT, IERR)
#else
      CALL MUMPS_DGRAPHINIT(GRAPHDAT, ord%COMM_PARAORD, IERR)
#endif
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF (SIZE_VELOLOCTAB.EQ.VERTLOCNBR) THEN
       IF (id%KEEP(10).NE.1) THEN
        CALL SCOTCHFDGRAPHBUILD(GRAPHDAT, BASEVAL_I8, VERTLOCNBR_I8,
     &     VERTLOCNBR_I8, VERTLOCTAB(1), VERTLOCTAB(2),
     &     VELOLOCTAB_I8(1), VERTLOCTAB(1), EDGELOCNBR,
     &     EDGELOCNBR, EDGELOCTAB_I8(1), EDGELOCTAB_I8(1),
     &     EDGELOCTAB_I8(1), IERR)
       ELSE
        CALL SCOTCHFDGRAPHBUILD(GRAPHDAT, BASEVAL, VERTLOCNBR,
     &     VERTLOCNBR, VERTLOCTAB(1), VERTLOCTAB(2),
     &     VELOLOCTAB(1), VERTLOCTAB(1), EDGELOCNBR,
     &     EDGELOCNBR, EDGELOCTAB(1), EDGELOCTAB(1),
     &     EDGELOCTAB(1), IERR)
       ENDIF
      ELSE
       IF (id%KEEP(10).NE.1) THEN
        CALL SCOTCHFDGRAPHBUILD(GRAPHDAT, BASEVAL_I8, VERTLOCNBR_I8,
     &     VERTLOCNBR_I8, VERTLOCTAB(1), VERTLOCTAB(2),
     &     VERTLOCTAB(1), VERTLOCTAB(1), EDGELOCNBR,
     &     EDGELOCNBR, EDGELOCTAB_I8(1), EDGELOCTAB_I8(1),
     &     EDGELOCTAB_I8(1), IERR)
       ELSE
        CALL SCOTCHFDGRAPHBUILD(GRAPHDAT, BASEVAL, VERTLOCNBR,
     &     VERTLOCNBR, VERTLOCTAB(1), VERTLOCTAB(2),
     &     VERTLOCTAB(1), VERTLOCTAB(1), EDGELOCNBR,
     &     EDGELOCNBR, EDGELOCTAB(1), EDGELOCTAB(1),
     &     EDGELOCTAB(1), IERR)
       ENDIF
      ENDIF
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      CALL SCOTCHFSTRATINIT(STRADAT, IERR)
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF(ord%SUBSTRAT .NE. 0) THEN
         CALL SCOTCHFSTRATDGRAPHORDER(STRADAT, STRSTRING, IERR)
      END IF
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      CALL SCOTCHFDGRAPHORDERINIT(GRAPHDAT, ORDEDAT, IERR)
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      CALL SCOTCHFDGRAPHORDERCOMPUTE(GRAPHDAT, ORDEDAT, STRADAT,
     &     IERR)
      IF(IERR.NE.0) THEN
         id%INFO(1:2) = -50
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF(MYWORKID .EQ. 0) THEN
        IF (id%KEEP(10).NE.1) THEN 
         CALL SCOTCHFDGRAPHCORDERINIT(GRAPHDAT, CORDEDAT,
     &        PERMTAB_I8(1), PERITAB_I8(1), CBLKNBR_I8, RANGTAB_I8(1),
     &        TREETAB_I8(1), IERR)
        ELSE
         CALL SCOTCHFDGRAPHCORDERINIT(GRAPHDAT, CORDEDAT,
     &        ord%PERMTAB(1), ord%PERITAB(1), ord%CBLKNBR,
     &         ord%RANGTAB(1),ord%TREETAB(1), IERR)
        ENDIF
         IF(IERR.NE.0) THEN
            id%INFO(1:2) = -50
         END IF
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF(MYWORKID .EQ. 0) THEN
         CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT,
     &        CORDEDAT, IERR)
         IF(IERR.NE.0) THEN
            id%INFO(1:2) = -50
         END IF
      ELSE
         CALL SCOTCHFDGRAPHORDERGATHER(GRAPHDAT, ORDEDAT,
     &        ORDEDAT, IERR)
         IF(IERR.NE.0) THEN
            id%INFO(1:2) = -50
         END IF
      END IF
      CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1),
     &     ord%COMM_PARAORD, ord%MYID_PARAORD )
      IF ( id%INFO(1) .LT. 0 ) GOTO 10
      IF(MYWORKID .EQ. 0) 
     &     CALL SCOTCHFDGRAPHCORDEREXIT(GRAPHDAT, CORDEDAT)
      CALL SCOTCHFDGRAPHORDEREXIT(GRAPHDAT, ORDEDAT)
      CALL SCOTCHFSTRATEXIT(STRADAT) 
      CALL SCOTCHFDGRAPHEXIT(GRAPHDAT)
#if defined(MUMPS_SCOTCHIMPORTOMPTHREADS)
      CALL SCOTCHFDGRAPHEXIT(GRAPHDAT_BEFORE_CONTEXT)
#endif
 10   CONTINUE
      IF (id%KEEP(10).NE.1) THEN
       CALL MUMPS_I8DEALLOC(EDGELOCTAB_I8, MEMCNT=MEMCNT)
       IF (SIZE_VELOLOCTAB.GT.0)
     & CALL MUMPS_I8DEALLOC(VELOLOCTAB_I8, MEMCNT=MEMCNT)
       IF(MYWORKID .EQ. 0) THEN
         CALL MUMPS_ICOPY_64TO32(PERMTAB_I8(1),
     &        size(ord%PERMTAB), ord%PERMTAB(1))
         CALL MUMPS_ICOPY_64TO32(PERITAB_I8(1),
     &        size(ord%PERITAB), ord%PERITAB(1))
         CALL MUMPS_ICOPY_64TO32(TREETAB_I8(1),
     &        size(ord%TREETAB), ord%TREETAB(1))
         CALL MUMPS_ICOPY_64TO32(RANGTAB_I8(1),
     &        size(ord%RANGTAB), ord%RANGTAB(1))
         ord%CBLKNBR = int(CBLKNBR_I8)
         CALL MUMPS_I8DEALLOC(PERMTAB_I8, MEMCNT=MEMCNT)
         CALL MUMPS_I8DEALLOC(PERITAB_I8, MEMCNT=MEMCNT)
         CALL MUMPS_I8DEALLOC(RANGTAB_I8, MEMCNT=MEMCNT)
         CALL MUMPS_I8DEALLOC(TREETAB_I8, MEMCNT=MEMCNT)
       END IF
      ENDIF
      RETURN
      END SUBROUTINE MUMPS_PTSCOTCH_MIXEDto64
#endif      
      END MODULE
