tools_common.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	mumps_find_unit (iunit)
subroutine	mumps_make1root (n, frere, fils, nfsiz, theroot)
integer function	mumps_encode_tpn_iproc (tpn, iproc, k199)
integer function	mumps_typenode_rough (procinfo_inode, k199)
integer function	mumps_typenode (procinfo_inode, k199)
subroutine	mumps_typeandprocnode (tpn, mumps_procnode, procinfo_inode, k199)
integer function	mumps_procnode (procinfo_inode, k199)
integer function	mumps_typesplit (procinfo_inode, k199)
logical function	mumps_rootssarbr (procinfo_inode, k199)
logical function	mumps_inssarbr (procinfo_inode, k199)
logical function	mumps_in_or_root_ssarbr (procinfo_inode, k199)
subroutine	mumps_set_ssarbr_dad (ssarbr, inode, dad, n, keep28, step, procnode_steps, k199)
logical function	mumps_i_am_candidate (myid, slavef, inode, nmb_par2, istep_to_iniv2, k71, step, n, candidates, keep24)
subroutine	mumps_secdeb (t)
subroutine	mumps_secfin (t)
subroutine	mumps_sort_doubles (n, val, id)
subroutine	mumps_sort_doubles_dec (n, val, id)
subroutine	mumps_mem_centralize (myid, comm, info, infog, irank)
integer function	mumps_get_pool_length (max_active_nodes, keep, keep8)
subroutine	mumps_init_pool_dist_bwd (n, nb_prun_roots, pruned_roots, myroot, myid_nodes, keep, keep8, step, procnode_steps, ipool, lpool)
subroutine	mumps_init_pool_dist_bwd_l0 (n, nb_prun_roots, pruned_roots, myroot, myid_nodes, keep, keep8, step, procnode_steps, ipool, lpool, to_process)
subroutine	mumps_init_pool_dist_na_bwd (n, myroot, myid_nodes, na, lna, keep, keep8, step, procnode_steps, ipool, lpool)
subroutine	mumps_init_pool_dist_na_bwd_l0 (n, myroot, myid_nodes, na, lna, keep, keep8, step, procnode_steps, ipool, lpool, l0_omp_mapping)
subroutine	mumps_init_pool_dist_na_bwdl0es (n, myroot, myid_nodes, na, lna, keep, keep8, step, procnode_steps, ipool, lpool, l0_omp_mapping, to_process)
subroutine	mumps_init_pool_dist (n, leaf, myid_nodes, k199, na, lna, keep, keep8, step, procnode_steps, ipool, lpool)
subroutine	mumps_init_pool_dist_nona (n, leaf, myid_nodes, lleaves, leaves, keep, keep8, step, procnode_steps, ipool, lpool)
subroutine	mumps_init_nroot_dist (n, nbroot, nroot_loc, myid_nodes, slavef, na, lna, keep, step, procnode_steps)
subroutine	mumps_nblocal_roots_or_leaves (n, nbrorl, rorl_list, nrorl_loc, myid_nodes, slavef, keep, step, procnode_steps)
logical function	mumps_compare_tab (tab1, tab2, len1, len2)
subroutine	mumps_sort_int (n, val, id)
subroutine	mumps_sort_int_dec (n, val, id)
subroutine	mumps_sort_int8 (n, val, id)
subroutine	mumps_abort ()
subroutine	mumps_get_perlu (keep12, icntl14, keep50, keep54, icntl6, icntl8)
subroutine	mumps_reducei8 (in, out, mpi_op, root, comm)
subroutine	mumps_allreducei8 (in, out, mpi_op, comm)
subroutine	mumps_seti8toi4 (i8, i)
subroutine	mumps_abort_on_overflow (i8, string)
subroutine	mumps_set_ierror (size8, ierror)
subroutine	mumps_storei8 (i8, int_array)
subroutine	mumps_geti8 (i8, int_array)
subroutine	mumps_addi8toarray (int_array, i8)
subroutine	mumps_subtri8toarray (int_array, i8)
logical function	mumps_seqana_avail (icntl7)
logical function	mumps_parana_avail (which)
subroutine	mumps_sort_step (n, frere, step, fils, na, lna, ne, nd, dad, ldad, use_dad, nsteps, info, lp, procnode, slavef)
subroutine	mumps_check_comm_nodes (comm_nodes, exit_flag)
subroutine	mumps_get_proc_per_node (k414, myid, nbprocs, comm)
subroutine	mumps_icopy_32to64 (intab, sizetab, outtab8)
subroutine	mumps_icopy_32to64_64c (intab, sizetab8, outtab8)
subroutine	mumps_icopy_32to64_64c_ip (in_out_tab48, sizetab)
recursive subroutine	mumps_icopy_32to64_64c_ip_rec (in_out_tab48, sizetab)
subroutine	mumps_icopy_64to32 (intab8, sizetab, outtab)
subroutine	mumps_icopy_64to32_64c (intab8, sizetab, outtab)
subroutine	mumps_icopy_64to32_64c_ip (in_out_tab48, sizetab)
recursive subroutine	mumps_icopy_64to32_64c_ip_rec (in_out_tab48, sizetab)
subroutine	mumps_get_nnz_internal (nnz, nz, nnz_i)
subroutine	mumps_npiv_critical_path (n, nsteps, step, frere, fils, na, lna, ne, maxnpivtree)
subroutine	mumps_ldltpanel_nbtarget (npiv, nb_target, keep)
subroutine	mumps_ldltpanel_storage (npiv, keep, iw, nb_entries)
subroutine	mumps_ldltpanel_panelinfos (npiv, keep, iw, nb_target, nbpanels, panel_col, panel_pos, panel_tabsize, ignore_k459)
subroutine	mumps_ldltpanel_sizes (npiv, keep, iw, panel_sizes, nbpanels)
subroutine	mumps_build_arch_node_comm (comm, newcomm, newsize, newrank)
subroutine	mumps_destroy_arch_node_comm (arch_node_comm)
subroutine	mumps_dm_fac_upd_dyn_memcnts (mem_count_allocated, atomic_updates, keep8, iflag, ierror, k69upd, k71upd)
subroutine	mumps_set_parti_regular (slavef, keep, keep8, procs, mem_distrib, ncb, nfront, nslaves_node, tab_pos, slaves_list, size_slaves_list, myid, inode, tab_maxs_arg, sup_proc_arg, max_surf, nb_row_max)

Function/Subroutine Documentation

mumps_abort()

subroutine mumps_abort

Definition at line 780 of file tools_common.F.

#if defined(PRINT_BACKTRACE_ON_ABORT) 
#if defined(__INTEL_COMPILER)
      USE ifcore
#endif
      IMPLICIT NONE
      include 'mpif.h'
      INTEGER IERR, IERRCODE
#if defined(__GFORTRAN__)
      CALL backtrace()
#endif
#if defined(__INTEL_COMPILER)
!$OMP CRITICAL(MUMPS_TRACEBACKQQ)
      CALL tracebackqq("MUMPS_ABORT calls TRACEBACKQQ:",
     &                 user_exit_code=-1)
!$OMP END CRITICAL(MUMPS_TRACEBACKQQ)
#endif
#else
      IMPLICIT NONE
      include 'mpif.h'
      INTEGER IERR, IERRCODE
#endif
      ierrcode = -99
      CALL mpi_abort(mpi_comm_world, ierrcode, ierr)
      RETURN

mumps_abort_on_overflow()

subroutine mumps_abort_on_overflow	(	integer(8), intent(in)	i8,
		character(*), intent(in)	string )

Definition at line 853 of file tools_common.F.

      IMPLICIT NONE
      INTEGER(8), INTENT(IN) :: I8
      CHARACTER(*), INTENT(IN) :: STRING
      INTEGER I
      IF ( i8 .GT. int(huge(i),8)) THEN
        WRITE(*,*) string
        CALL mumps_abort()
      ENDIF
      RETURN

mumps_addi8toarray()

subroutine mumps_addi8toarray	(	integer, dimension(2), intent(inout)	int_array,
		integer(8), intent(in)	i8 )

Definition at line 902 of file tools_common.F.

      IMPLICIT NONE
      INTEGER(8), intent(in) :: I8
      INTEGER, intent(inout) :: INT_ARRAY(2)
      INTEGER(8) :: I8TMP
      CALL mumps_geti8(i8tmp, int_array)
      i8tmp = i8tmp + i8
      CALL mumps_storei8(i8tmp, int_array)
      RETURN

mumps_allreducei8()

subroutine mumps_allreducei8	(	integer(8)	in,
		integer(8)	out,
		integer	mpi_op,
		integer	comm )

Definition at line 828 of file tools_common.F.

      IMPLICIT NONE
      include 'mpif.h'
      INTEGER COMM, MPI_OP
      INTEGER(8) IN, OUT
      INTEGER IERR
      DOUBLE PRECISION DIN, DOUT
      din =dble(in)
      dout=0.0d0
      CALL mpi_allreduce(din, dout, 1, mpi_double_precision,
     &                   mpi_op, comm, ierr)
      out=int(dout,kind=8)
      RETURN

mumps_build_arch_node_comm()

subroutine mumps_build_arch_node_comm	(	integer, intent(in)	comm,
		integer, intent(out)	newcomm,
		integer, intent(out)	newsize,
		integer, intent(out)	newrank )

Definition at line 1429 of file tools_common.F.

      IMPLICIT NONE
      include 'mpif.h'
      INTEGER, INTENT(IN)  :: COMM
      INTEGER, INTENT(OUT) :: NEWCOMM, NEWSIZE, NEWRANK
      INTEGER :: SMALLEST_ID_ON_SAME_NODE, IPROC, MYID, IERR, NPROCS
      INTEGER :: TMPNAME_LENGTH, MYNAME_LENGTH
      CHARACTER(len=MPI_MAX_PROCESSOR_NAME) :: MYNAME, TMPNAME
      smallest_id_on_same_node = -1
      CALL mpi_comm_rank( comm, myid, ierr )
      CALL mpi_comm_size( comm, nprocs, ierr )
      CALL mpi_get_processor_name(myname, myname_length, ierr )
      DO iproc = 0, nprocs - 1
        IF (myid .EQ. iproc) THEN
          tmpname = myname
          tmpname_length = myname_length
        ENDIF
        CALL mpi_bcast( tmpname_length, 1, mpi_integer,
     &                  iproc, comm, ierr )
        CALL mpi_bcast( tmpname, tmpname_length, mpi_character,
     &                  iproc, comm, ierr)
        IF (smallest_id_on_same_node .LT. 0) THEN
         IF ( tmpname_length .EQ. myname_length ) THEN
          IF ( tmpname(1:tmpname_length) .EQ. myname(1:myname_length) )
     &    THEN
            smallest_id_on_same_node = iproc
          ENDIF
         ENDIF
        ENDIF
      ENDDO
      CALL mpi_comm_split( comm, smallest_id_on_same_node, 0,
     &                     newcomm, ierr )
      CALL mpi_comm_rank( newcomm, newrank, ierr )
      CALL mpi_comm_size( newcomm, newsize, ierr )
      RETURN

mumps_check_comm_nodes()

subroutine mumps_check_comm_nodes	(	integer, intent(in)	comm_nodes,
		logical, intent(out)	exit_flag )

Definition at line 1086 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN)  :: COMM_NODES
      LOGICAL, INTENT(OUT) :: EXIT_FLAG
      include 'mumps_tags.h'
      include 'mpif.h'
      INTEGER :: STATUS(MPI_STATUS_SIZE), IERR
      CALL mpi_iprobe( mpi_any_source, terreur, comm_nodes,
     &            exit_flag, status, ierr)
      RETURN

mumps_compare_tab()

logical function mumps_compare_tab	(	integer, dimension(len1)	tab1,
		integer, dimension(len2)	tab2,
		integer	len1,
		integer	len2 )

Definition at line 691 of file tools_common.F.

      IMPLICIT NONE
      INTEGER LEN1 , LEN2 ,I
      INTEGER TAB1(LEN1)
      INTEGER TAB2(LEN2)
      mumps_compare_tab=.false.
      IF(len1 .NE. len2) THEN
         RETURN
      ENDIF
      DO i=1 , len1
         IF(tab1(i) .NE. tab2(i)) THEN
            RETURN
         ENDIF
      ENDDO
      mumps_compare_tab=.true.
      RETURN

mumps_destroy_arch_node_comm()

subroutine mumps_destroy_arch_node_comm

(

integer

arch_node_comm

)

Definition at line 1466 of file tools_common.F.

      IMPLICIT NONE
      INTEGER :: ARCH_NODE_COMM, IERR
      include 'mpif.h'
      CALL mpi_comm_free( arch_node_comm, ierr )
      RETURN

mumps_dm_fac_upd_dyn_memcnts()

subroutine mumps_dm_fac_upd_dyn_memcnts	(	integer(8), intent(in)	mem_count_allocated,
		logical, intent(in)	atomic_updates,
		integer(8), dimension(150), intent(inout)	keep8,
		integer, intent(inout)	iflag,
		integer, intent(inout)	ierror,
		logical, intent(in)	k69upd,
		logical, intent(in)	k71upd )

Definition at line 1473 of file tools_common.F.

      IMPLICIT NONE
      INTEGER(8), INTENT(IN)        :: MEM_COUNT_ALLOCATED
      INTEGER(8), INTENT(INOUT)     :: KEEP8(150)
      LOGICAL, INTENT(IN)           :: ATOMIC_UPDATES
      INTEGER, INTENT(INOUT)        :: IFLAG, IERROR
      LOGICAL, INTENT(IN) :: K69UPD
      LOGICAL, INTENT(IN) :: K71UPD
      INTEGER(8) :: KEEP8TMPCOPY
      IF (mem_count_allocated.GT.0) THEN
           IF (atomic_updates ) THEN
!$OMP        ATOMIC CAPTURE
             keep8(73) = keep8(73) + mem_count_allocated
             keep8tmpcopy = keep8(73)
!$omp        END atomic
!$OMP        ATOMIC UPDATE
             keep8(74) = max(keep8(74), keep8tmpcopy)
!$OMP        END ATOMIC
           ELSE
             keep8(73) = keep8(73) + mem_count_allocated
             keep8tmpcopy = keep8(73)
             keep8(74) = max(keep8(74), keep8(73))
           ENDIF
           IF ( keep8tmpcopy .GT. keep8(75) ) THEN
             iflag = -19
             CALL mumps_set_ierror(
     &            (keep8tmpcopy-keep8(75)), ierror)
           ENDIF
           IF ( k69upd ) THEN
             IF ( atomic_updates ) THEN
!$OMP          ATOMIC CAPTURE
               keep8(69) = keep8(69) + mem_count_allocated
               keep8tmpcopy = keep8(69)
!$OMP          END ATOMIC
!$OMP          ATOMIC UPDATE
               keep8(68) = max(keep8(68), keep8tmpcopy)
!$omp          END atomic
             ELSE
               keep8(69) = keep8(69) + mem_count_allocated
               keep8(68) = max(keep8(69), keep8(68))
             ENDIF
           ENDIF
           IF ( k71upd ) THEN
             IF ( atomic_updates ) THEN
!$OMP          ATOMIC CAPTURE
               keep8(71) = keep8(71) + mem_count_allocated
               keep8tmpcopy = keep8(71)
!$OMP          END ATOMIC
!$OMP          ATOMIC UPDATE
               keep8(70) = max(keep8(70), keep8tmpcopy)
!$OMP          END ATOMIC
             ELSE
               keep8(71) = keep8(71) + mem_count_allocated
               keep8(70) = max(keep8(71), keep8(70))
             ENDIF
           ENDIF
      ELSE
           IF (atomic_updates) THEN
!$OMP ATOMIC UPDATE
             keep8(73) = keep8(73) + mem_count_allocated
!$OMP END ATOMIC
             IF ( k69upd ) THEN
!$OMP ATOMIC UPDATE
               keep8(69) = keep8(69) + mem_count_allocated
!$OMP END ATOMIC
             ENDIF
             IF ( k71upd ) THEN
!$OMP ATOMIC UPDATE
               keep8(71) = keep8(71) + mem_count_allocated
!$OMP END ATOMIC
             ENDIF
           ELSE
             keep8(73) = keep8(73) + mem_count_allocated
             IF ( k69upd ) THEN
               keep8(69) = keep8(69) + mem_count_allocated
             ENDIF
             IF ( k71upd ) THEN
               keep8(71) = keep8(71) + mem_count_allocated
             ENDIF
           ENDIF
      ENDIF
      RETURN

mumps_encode_tpn_iproc()

integer function mumps_encode_tpn_iproc	(	integer, intent(in)	tpn,
		integer, intent(in)	iproc,
		integer, intent(in)	k199 )

Definition at line 69 of file tools_common.F.

      INTEGER, INTENT(IN) :: TPN, IPROC, K199
      IF (k199 < 0) THEN
        mumps_encode_tpn_iproc = iproc + ishft(tpn+1, 24)
      ELSE
        mumps_encode_tpn_iproc = (tpn-1)*k199+iproc+1
      ENDIF
      RETURN

mumps_find_unit()

subroutine mumps_find_unit

(

integer

iunit

)

Definition at line 14 of file tools_common.F.

      IMPLICIT NONE
      INTEGER :: IUNIT
      INTEGER, PARAMETER :: UNIT_MIN = 10 
      INTEGER, PARAMETER :: UNIT_MAX = 500
      INTEGER :: I
      LOGICAL :: BUSY
      iunit = -1
      DO i = unit_min, unit_max
        INQUIRE(unit=i, opened=busy)
        IF ( .NOT. busy ) THEN
          iunit = i
          RETURN
        END IF
      ENDDO
      RETURN

mumps_get_nnz_internal()

subroutine mumps_get_nnz_internal	(	integer(8), intent(in)	nnz,
		integer, intent(in)	nz,
		integer(8), intent(out)	nnz_i )

Definition at line 1247 of file tools_common.F.

      INTEGER   , INTENT(IN)  :: NZ
      INTEGER(8), INTENT(IN)  :: NNZ
      INTEGER(8), INTENT(OUT) :: NNZ_i
      IF (nnz > 0_8) THEN
        nnz_i = nnz
      ELSE
        nnz_i = int(nz, 8)
      ENDIF

mumps_get_perlu()

subroutine mumps_get_perlu	(	integer, intent(out)	keep12,
		integer, intent(in)	icntl14,
		integer, intent(in)	keep50,
		integer, intent(in)	keep54,
		integer, intent(in)	icntl6,
		integer, intent(in)	icntl8 )

Definition at line 806 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, intent(out)::KEEP12
      INTEGER, intent(in)::ICNTL14,KEEP50,KEEP54,ICNTL6,ICNTL8
      keep12 = icntl14 
      RETURN

mumps_get_pool_length()

integer function mumps_get_pool_length	(	integer	max_active_nodes,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8 )

Definition at line 429 of file tools_common.F.

      IMPLICIT NONE
      INTEGER MAX_ACTIVE_NODES
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      mumps_get_pool_length = max_active_nodes + 1 + 3
      RETURN

mumps_get_proc_per_node()

subroutine mumps_get_proc_per_node	(	integer	k414,
		integer	myid,
		integer	nbprocs,
		integer	comm )

Definition at line 1097 of file tools_common.F.

      IMPLICIT NONE
      include 'mpif.h'
      INTEGER :: K414, MyID, NbProcs, COMM, ALLOCOK
      INTEGER :: ierr,MyNAME_length,MyNAME_length_RCV,i,j
      CHARACTER(len=MPI_MAX_PROCESSOR_NAME) :: MyNAME
      CHARACTER, dimension(:), allocatable :: MyNAME_TAB,MyNAME_TAB_RCV
      logical :: SAME_NAME
      call mpi_get_processor_name(myname, myname_length, ierr)
      allocate(myname_tab(myname_length), stat=allocok)
      IF(allocok.LT.0) THEN
         write(*,*) "Allocation error in MUMPS_GET_PROC_PER_NODE"
         call mumps_abort()
      ENDIF
      DO i=1, myname_length
         myname_tab(i) = myname(i:i)
      ENDDO
      k414=0
      do i=0, nbprocs-1
         if(myid .eq. i) then
            myname_length_rcv  = myname_length
         else
            myname_length_rcv = 0
         endif
         call mpi_bcast(myname_length_rcv,1,mpi_integer,
     &        i,comm,ierr)
         allocate(myname_tab_rcv(myname_length_rcv), stat=allocok)
         IF(allocok.LT.0) THEN
            write(*,*) "Allocation error in MUMPS_GET_PROC_PER_NODE"
            call mumps_abort()
         ENDIF
         if(myid .eq. i) then
            myname_tab_rcv = myname_tab
         endif
         call mpi_bcast(myname_tab_rcv,myname_length_rcv,mpi_character,
     &        i,comm,ierr)
         same_name=.false.
         IF(myname_length .EQ. myname_length_rcv) THEN
            DO j=1, myname_length
               IF(myname_tab(j) .NE. myname_tab_rcv(j)) THEN
                  goto 100
               ENDIF
            ENDDO
            same_name=.true.
         ENDIF
 100     continue
         IF(same_name) k414=k414+1
         deallocate(myname_tab_rcv)
      enddo
      deallocate(myname_tab)

mumps_geti8()

subroutine mumps_geti8	(	integer(8), intent(out)	i8,
		integer, dimension(2), intent(in)	int_array )

Definition at line 887 of file tools_common.F.

      IMPLICIT NONE
      INTEGER(8), intent(out)  :: I8
      INTEGER,    intent(in)  :: INT_ARRAY(2)
      INTEGER(kind(0_4)) :: I32
      INTEGER(8) :: IDIV, IPAR
      parameter(ipar=int(huge(i32),8))
      parameter(idiv=ipar+1_8)
      IF ( int_array(1) .EQ. 0 ) THEN
        i8=int(int_array(2),8)
      ELSE
        i8=int(int_array(1),8)*idiv+int(int_array(2),8)
      ENDIF
      RETURN

mumps_i_am_candidate()

logical function mumps_i_am_candidate	(	integer	myid,
		integer	slavef,
		integer	inode,
		integer	nmb_par2,
		integer, dimension ( k71 )	istep_to_iniv2,
		integer	k71,
		integer, dimension ( n )	step,
		integer	n,
		integer, dimension(slavef+1, max(nmb_par2,1))	candidates,
		integer	keep24 )

Definition at line 250 of file tools_common.F.

      IMPLICIT NONE
      INTEGER MYID, SLAVEF, INODE, NMB_PAR2, KEEP24, I
      INTEGER K71, N
      INTEGER ISTEP_TO_INIV2 ( K71 ), STEP ( N )
      INTEGER CANDIDATES(SLAVEF+1, max(NMB_PAR2,1))
      INTEGER NCAND, POSINODE
      mumps_i_am_candidate = .false.
      IF (keep24 .eq. 0) RETURN
      posinode = istep_to_iniv2( step(inode) )
      ncand = candidates( slavef+1, posinode )
      DO i = 1, ncand
        IF (myid .EQ. candidates( i, posinode ))
     &     mumps_i_am_candidate = .true.
      END DO
      RETURN

mumps_icopy_32to64()

subroutine mumps_icopy_32to64	(	integer, dimension(sizetab), intent(in)	intab,
		integer, intent(in)	sizetab,
		integer(8), dimension(sizetab), intent(out)	outtab8 )

Definition at line 1148 of file tools_common.F.

      INTEGER, intent(in)     ::  SIZETAB
      INTEGER, intent(in)     ::  INTAB(SIZETAB)
      INTEGER(8), intent(out) ::  OUTTAB8(SIZETAB)
      INTEGER :: I
      DO i=1,sizetab
       outtab8(i) = int(intab(i),8)
      ENDDO
      RETURN

mumps_icopy_32to64_64c()

subroutine mumps_icopy_32to64_64c	(	integer, dimension(sizetab8), intent(in)	intab,
		integer(8), intent(in)	sizetab8,
		integer(8), dimension(sizetab8), intent(out)	outtab8 )

Definition at line 1158 of file tools_common.F.

      INTEGER(8), intent(in)  ::  SIZETAB8
      INTEGER, intent(in)     ::  INTAB(SIZETAB8)
      INTEGER(8), intent(out) ::  OUTTAB8(SIZETAB8)
      INTEGER(8) :: I8
      LOGICAL    :: OMP_FLAG
      omp_flag = (sizetab8 .GE.500000_8 )
!$OMP PARALLEL DO PRIVATE(I8)
!$OMP&         IF(OMP_FLAG)
      DO i8=1_8, sizetab8
        outtab8(i8) = int(intab(i8),8)
      ENDDO
!$OMP END PARALLEL DO
      RETURN

mumps_icopy_32to64_64c_ip()

subroutine mumps_icopy_32to64_64c_ip	(	integer, dimension(2*sizetab), intent(inout)	in_out_tab48,
		integer(8), intent(in)	sizetab )

Definition at line 1173 of file tools_common.F.

      INTEGER(8), intent(in) :: SIZETAB
      INTEGER, intent(inout) :: IN_OUT_TAB48(2*SIZETAB)
      CALL mumps_icopy_32to64_64c_ip_rec(in_out_tab48, sizetab)
      RETURN

mumps_icopy_32to64_64c_ip_rec()

recursive subroutine mumps_icopy_32to64_64c_ip_rec	(	integer, dimension(2*sizetab)	in_out_tab48,
		integer(8), intent(in)	sizetab )

Definition at line 1179 of file tools_common.F.

      IMPLICIT NONE
      INTEGER(8), intent(in) :: SIZETAB
      INTEGER :: IN_OUT_TAB48(2*SIZETAB)
      INTEGER(8) :: IBEG24, IBEG28, SIZE1, SIZE2
      IF (sizetab.LE. 1000_8) THEN
        CALL mumps_icopy_32to64_64c_ip_c(in_out_tab48(1),
     &       sizetab)
      ELSE
        size2  = sizetab / 2
        size1  = sizetab - size2
        ibeg24 = size1+1                 
        ibeg28 = 2*size1+1_8             
        CALL mumps_icopy_32to64_64c(in_out_tab48(ibeg24),
     &                           size2, in_out_tab48(ibeg28))
        CALL mumps_icopy_32to64_64c_ip_rec(in_out_tab48,
     &                           size1)
      ENDIF
      RETURN

mumps_icopy_64to32()

subroutine mumps_icopy_64to32	(	integer(8), dimension(sizetab), intent(in)	intab8,
		integer, intent(in)	sizetab,
		integer, dimension(sizetab), intent(out)	outtab )

Definition at line 1200 of file tools_common.F.

      INTEGER, intent(in) ::  SIZETAB
      INTEGER(8), intent(in) ::  INTAB8(SIZETAB)
      INTEGER, intent(out)   ::  OUTTAB(SIZETAB)
      INTEGER :: I
      DO i=1,sizetab
       outtab(i) = int(intab8(i))
      ENDDO
      RETURN

mumps_icopy_64to32_64c()

subroutine mumps_icopy_64to32_64c	(	integer(8), dimension(sizetab), intent(in)	intab8,
		integer(8), intent(in)	sizetab,
		integer, dimension(sizetab), intent(out)	outtab )

Definition at line 1210 of file tools_common.F.

      INTEGER(8), intent(in)    ::  SIZETAB
      INTEGER(8), intent(in) ::  INTAB8(SIZETAB)
      INTEGER, intent(out)   ::  OUTTAB(SIZETAB)
      INTEGER(8) :: I8
      DO i8=1_8,sizetab
       outtab(i8) = int(intab8(i8))
      ENDDO
      RETURN

mumps_icopy_64to32_64c_ip()

subroutine mumps_icopy_64to32_64c_ip	(	integer, dimension(2*sizetab), intent(inout)	in_out_tab48,
		integer(8), intent(in)	sizetab )

Definition at line 1220 of file tools_common.F.

      INTEGER(8), intent(in) :: SIZETAB
      INTEGER, intent(inout) :: IN_OUT_TAB48(2*SIZETAB)
      CALL mumps_icopy_64to32_64c_ip_rec(in_out_tab48, sizetab)
      RETURN

mumps_icopy_64to32_64c_ip_rec()

recursive subroutine mumps_icopy_64to32_64c_ip_rec	(	integer, dimension(2*sizetab)	in_out_tab48,
		integer(8), intent(in)	sizetab )

Definition at line 1226 of file tools_common.F.

      IMPLICIT NONE
      INTEGER(8), intent(in) :: SIZETAB
      INTEGER :: IN_OUT_TAB48(2*SIZETAB)
      INTEGER(8) :: IBEG24, IBEG28, SIZE1, SIZE2
      IF (sizetab.LE. 1000_8) THEN
        CALL mumps_icopy_64to32_64c_ip_c(in_out_tab48(1),
     &       sizetab)
      ELSE
        size2  = sizetab / 2
        size1  = sizetab - size2
        ibeg24 = size1 + 1
        ibeg28 = size1 + size1 + 1_8
        CALL mumps_icopy_64to32_64c_ip_rec(in_out_tab48,
     &                                        size1)
        CALL mumps_icopy_64to32_64c(in_out_tab48(ibeg28),
     &                           size2, in_out_tab48(ibeg24))
      ENDIF
      RETURN

mumps_in_or_root_ssarbr()

logical function mumps_in_or_root_ssarbr	(	integer	procinfo_inode,
		integer	k199 )

Definition at line 212 of file tools_common.F.

      IMPLICIT NONE
      INTEGER K199
      INTEGER TPN, PROCINFO_INODE
      IF (k199 < 0) THEN
        tpn = ishft(procinfo_inode,-24) - 1
      ELSE
        tpn = (procinfo_inode-1+k199+k199)/k199 - 1
      ENDIF
      mumps_in_or_root_ssarbr =
     &           ( tpn .eq. -1 .OR. tpn .eq. 0 )
      RETURN

mumps_init_nroot_dist()

subroutine mumps_init_nroot_dist	(	integer, intent(in)	n,
		integer, intent(out)	nbroot,
		integer, intent(out)	nroot_loc,
		integer, intent(in)	myid_nodes,
		integer, intent(in)	slavef,
		integer, dimension(lna), intent(in)	na,
		integer, intent(in)	lna,
		integer, dimension( 500 ), intent(in)	keep,
		integer, dimension(n), intent(in)	step,
		integer, dimension(keep(28)), intent(in)	procnode_steps )

Definition at line 635 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT( OUT ) :: NROOT_LOC 
      INTEGER, INTENT( OUT ) :: NBROOT 
      INTEGER, INTENT( IN ) :: KEEP( 500 )
      INTEGER, INTENT( IN ) :: SLAVEF
      INTEGER, INTENT( IN ) :: N
      INTEGER, INTENT( IN ) :: STEP(N)
      INTEGER, INTENT( IN ) :: LNA
      INTEGER, INTENT( IN ) :: NA(LNA)
      INTEGER, INTENT( IN ) :: PROCNODE_STEPS(KEEP(28))
      INTEGER, INTENT( IN ) :: MYID_NODES
      INTEGER, EXTERNAL :: MUMPS_PROCNODE
      INTEGER :: INODE, I, NBLEAF
      nbleaf = na(1)
      nbroot = na(2)
      nroot_loc = 0
      DO i = 1, nbroot
        inode = na(i+2+nbleaf)
        IF (mumps_procnode(procnode_steps(step(inode)),
     &    keep(199)).EQ.myid_nodes) THEN
            nroot_loc = nroot_loc + 1
        END IF
      ENDDO
      RETURN

mumps_init_pool_dist()

subroutine mumps_init_pool_dist	(	integer	n,
		integer	leaf,
		integer	myid_nodes,
		integer	k199,
		integer, dimension(lna)	na,
		integer	lna,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(n)	step,
		integer, dimension(keep(28))	procnode_steps,
		integer, dimension(lpool)	ipool,
		integer	lpool )

Definition at line 583 of file tools_common.F.

      IMPLICIT NONE
      INTEGER N, LEAF, MYID_NODES,
     &        K199, LPOOL, LNA
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER STEP(N)
      INTEGER PROCNODE_STEPS(KEEP(28)), NA(LNA),
     &        IPOOL(LPOOL)
      INTEGER NBLEAF, INODE, I
      INTEGER MUMPS_PROCNODE
      EXTERNAL mumps_procnode
      nbleaf = na(1)
      leaf = 1
      DO i = 1, nbleaf
        inode = na(i+2)
        IF (mumps_procnode(procnode_steps(step(inode)),keep(199))
     &   .EQ.myid_nodes) THEN
           ipool(leaf) = inode
           leaf        = leaf + 1
          ENDIF
      ENDDO
      RETURN

mumps_init_pool_dist_bwd()

subroutine mumps_init_pool_dist_bwd	(	integer, intent(in)	n,
		integer, intent(in)	nb_prun_roots,
		integer, dimension(nb_prun_roots), intent(in)	pruned_roots,
		integer, intent(out)	myroot,
		integer, intent(in)	myid_nodes,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(n), intent(in)	step,
		integer, dimension(keep(28)), intent(in)	procnode_steps,
		integer, dimension(lpool), intent(out)	ipool,
		integer, intent(in)	lpool )

Definition at line 438 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN)  :: N, MYID_NODES, LPOOL, nb_prun_roots
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER, INTENT(IN)  :: STEP(N)
      INTEGER, INTENT(IN)  :: PROCNODE_STEPS(KEEP(28))
      INTEGER, INTENT(IN)  :: Pruned_Roots(nb_prun_roots)
      INTEGER, INTENT(OUT) :: MYROOT
      INTEGER, INTENT(OUT) :: IPOOL(LPOOL)
      INTEGER, EXTERNAL :: MUMPS_PROCNODE
      INTEGER :: I, INODE
      myroot = 0
      DO i = nb_prun_roots, 1, -1
        inode = pruned_roots(i)
        IF (mumps_procnode(procnode_steps(step(inode)),
     &      keep(199)) .EQ. myid_nodes) THEN
          myroot = myroot + 1
          ipool(myroot) = inode
        ENDIF
      END DO
      RETURN

mumps_init_pool_dist_bwd_l0()

subroutine mumps_init_pool_dist_bwd_l0	(	integer, intent(in)	n,
		integer, intent(in)	nb_prun_roots,
		integer, dimension(nb_prun_roots), intent(in)	pruned_roots,
		integer, intent(out)	myroot,
		integer, intent(in)	myid_nodes,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(n), intent(in)	step,
		integer, dimension(keep(28)), intent(in)	procnode_steps,
		integer, dimension(lpool), intent(out)	ipool,
		integer, intent(in)	lpool,
		logical, dimension(keep(28)), intent(in)	to_process )

Definition at line 465 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN)  :: N, MYID_NODES, LPOOL, nb_prun_roots
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER, INTENT(IN)  :: STEP(N)
      INTEGER, INTENT(IN)  :: PROCNODE_STEPS(KEEP(28))
      LOGICAL, INTENT(IN)  :: TO_PROCESS(KEEP(28))
      INTEGER, INTENT(IN)  :: Pruned_Roots(nb_prun_roots)
      INTEGER, INTENT(OUT) :: MYROOT
      INTEGER, INTENT(OUT) :: IPOOL(LPOOL)
      INTEGER, EXTERNAL :: MUMPS_PROCNODE
      INTEGER :: I, INODE
      myroot = 0
      DO i = nb_prun_roots, 1, -1
        inode = pruned_roots(i)
        IF (mumps_procnode(procnode_steps(step(inode)),
     &      keep(199)) .EQ. myid_nodes) THEN
          IF ( to_process(step(inode)) ) THEN
            myroot = myroot + 1
            ipool(myroot) = inode
          ENDIF
        ENDIF
      END DO
      RETURN

mumps_init_pool_dist_na_bwd()

subroutine mumps_init_pool_dist_na_bwd	(	integer, intent(in)	n,
		integer, intent(out)	myroot,
		integer, intent(in)	myid_nodes,
		integer, dimension(lna), intent(in)	na,
		integer, intent(in)	lna,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(n), intent(in)	step,
		integer, dimension(keep(28)), intent(in)	procnode_steps,
		integer, dimension(lpool), intent(out)	ipool,
		integer, intent(in)	lpool )

Definition at line 495 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN) :: N, MYID_NODES, LPOOL, LNA
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER, INTENT(IN) :: STEP(N)
      INTEGER, INTENT(IN) :: PROCNODE_STEPS(KEEP(28)), NA(LNA)
      INTEGER, INTENT(OUT) :: IPOOL(LPOOL)
      INTEGER, INTENT(OUT) :: MYROOT
      INTEGER, EXTERNAL :: MUMPS_PROCNODE
      INTEGER :: NBLEAF, NBROOT, I, INODE
      nbleaf = na(1)
      nbroot = na(2)
      myroot = 0
      DO i = nbroot, 1, -1
        inode = na(nbleaf+i+2)
        IF (mumps_procnode(procnode_steps(step(inode)),
     &      keep(199)) .EQ. myid_nodes) THEN
          myroot = myroot + 1
          ipool(myroot) = inode
        ENDIF
      END DO
      RETURN

mumps_init_pool_dist_na_bwd_l0()

subroutine mumps_init_pool_dist_na_bwd_l0	(	integer, intent(in)	n,
		integer, intent(out)	myroot,
		integer, intent(in)	myid_nodes,
		integer, dimension(lna), intent(in)	na,
		integer, intent(in)	lna,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(n), intent(in)	step,
		integer, dimension(keep(28)), intent(in)	procnode_steps,
		integer, dimension(lpool), intent(out)	ipool,
		integer, intent(in)	lpool,
		integer, dimension(keep(28)), intent(in)	l0_omp_mapping )

Definition at line 521 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN) :: N, MYID_NODES, LPOOL, LNA
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER, INTENT(IN) :: STEP(N)
      INTEGER, INTENT(IN) :: PROCNODE_STEPS(KEEP(28)), NA(LNA)
      INTEGER, INTENT(IN) :: L0_OMP_MAPPING(KEEP(28))
      INTEGER, INTENT(OUT) :: IPOOL(LPOOL)
      INTEGER, INTENT(OUT) :: MYROOT
      INTEGER, EXTERNAL :: MUMPS_PROCNODE
      INTEGER :: NBLEAF, NBROOT, I, INODE
      nbleaf = na(1)
      nbroot = na(2)
      myroot = 0
      DO i = nbroot, 1, -1
        inode = na(nbleaf+i+2)
        IF (mumps_procnode(procnode_steps(step(inode)),
     &      keep(199)) .EQ. myid_nodes) THEN
          IF ( l0_omp_mapping(step(inode)).EQ.0 ) THEN
            myroot = myroot + 1
            ipool(myroot) = inode
          ENDIF
        ENDIF
      END DO
      RETURN

mumps_init_pool_dist_na_bwdl0es()

subroutine mumps_init_pool_dist_na_bwdl0es	(	integer, intent(in)	n,
		integer, intent(out)	myroot,
		integer, intent(in)	myid_nodes,
		integer, dimension(lna), intent(in)	na,
		integer, intent(in)	lna,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(n), intent(in)	step,
		integer, dimension(keep(28)), intent(in)	procnode_steps,
		integer, dimension(lpool), intent(out)	ipool,
		integer, intent(in)	lpool,
		integer, dimension(keep(28)), intent(in)	l0_omp_mapping,
		logical, dimension( keep(28) ), intent(in)	to_process )

Definition at line 550 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN) :: N, MYID_NODES, LPOOL, LNA
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER, INTENT(IN)  :: STEP(N)
      INTEGER, INTENT(IN)  :: PROCNODE_STEPS(KEEP(28)), NA(LNA)
      INTEGER, INTENT(IN)  :: L0_OMP_MAPPING(KEEP(28))
      INTEGER, INTENT(OUT) :: IPOOL(LPOOL)
      INTEGER, INTENT(OUT) :: MYROOT
      LOGICAL, INTENT(IN)  :: TO_PROCESS( KEEP(28) )
      INTEGER, EXTERNAL :: MUMPS_PROCNODE
      INTEGER :: NBLEAF, NBROOT, I, INODE
      nbleaf = na(1)
      nbroot = na(2)
      myroot = 0
      DO i = nbroot, 1, -1
        inode = na(nbleaf+i+2)
        IF (mumps_procnode(procnode_steps(step(inode)),
     &      keep(199)) .EQ. myid_nodes) THEN
          IF ( l0_omp_mapping(step(inode)).EQ.0 ) THEN
            IF ( to_process( step(inode) ) ) THEN
              myroot = myroot + 1
              ipool(myroot) = inode
            ENDIF
          ENDIF
        ENDIF
      END DO
      RETURN

mumps_init_pool_dist_nona()

subroutine mumps_init_pool_dist_nona	(	integer	n,
		integer	leaf,
		integer	myid_nodes,
		integer	lleaves,
		integer, dimension(lleaves)	leaves,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(n)	step,
		integer, dimension(keep(28))	procnode_steps,
		integer, dimension(lpool)	ipool,
		integer	lpool )

Definition at line 610 of file tools_common.F.

      IMPLICIT NONE
      INTEGER N, LEAF, MYID_NODES,
     &        LPOOL, LLEAVES
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER STEP(N)
      INTEGER PROCNODE_STEPS(KEEP(28)), LEAVES(LLEAVES),
     &        IPOOL(LPOOL)
      INTEGER I, INODE
      INTEGER, EXTERNAL :: MUMPS_PROCNODE
      leaf = 1
      DO i = 1, lleaves
        inode = leaves(i)
        IF ( mumps_procnode(procnode_steps(step(inode)),keep(199))
     &   .EQ.myid_nodes ) THEN
          ipool( leaf ) = inode
          leaf = leaf + 1
        ENDIF
      ENDDO
      RETURN

mumps_inssarbr()

logical function mumps_inssarbr	(	integer	procinfo_inode,
		integer	k199 )

Definition at line 200 of file tools_common.F.

      IMPLICIT NONE
      INTEGER K199
      INTEGER TPN, PROCINFO_INODE
      IF (k199 < 0) THEN
        tpn = ishft(procinfo_inode,-24) - 1
      ELSE
        tpn = (procinfo_inode-1+k199+k199)/k199 - 1
      ENDIF
      mumps_inssarbr = ( tpn .eq. -1 )
      RETURN 

mumps_ldltpanel_nbtarget()

subroutine mumps_ldltpanel_nbtarget	(	integer, intent(in)	npiv,
		integer, intent(out)	nb_target,
		integer, dimension(500), intent(in)	keep )

Definition at line 1313 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN) :: NPIV
      INTEGER, INTENT(IN) :: KEEP(500)
      INTEGER, INTENT(OUT) :: NB_TARGET
      INTEGER :: NBPANELS, NBCOLMIN, NBPANELSMAX
      IF (npiv .EQ. 0) THEN
        nb_target = 0
      ELSE
        nbcolmin    = keep(460)
        nbpanelsmax = keep(459)
        nbpanels = min( (npiv+nbcolmin-1) / nbcolmin, nbpanelsmax  )
        nb_target = ( npiv+nbpanels-1 ) / nbpanels
      ENDIF
      RETURN

mumps_ldltpanel_panelinfos()

subroutine mumps_ldltpanel_panelinfos	(	integer, intent(in)	npiv,
		integer, dimension(500), intent(in)	keep,
		integer, dimension( npiv ), intent(in)	iw,
		integer, intent(out)	nb_target,
		integer, intent(out)	nbpanels,
		integer, dimension( panel_tabsize ), intent(out)	panel_col,
		integer(8), dimension( panel_tabsize ), intent(out)	panel_pos,
		integer, intent(in)	panel_tabsize,
		logical, intent(in)	ignore_k459 )

Definition at line 1358 of file tools_common.F.

      IMPLICIT NONE
      INTEGER,    INTENT(IN)  :: NPIV
      INTEGER,    INTENT(IN)  :: IW( NPIV )
      INTEGER,    INTENT(IN)  :: KEEP(500)
      INTEGER,    INTENT(IN)  :: PANEL_TABSIZE
      INTEGER,    INTENT(OUT) :: NB_TARGET, NBPANELS
      INTEGER,    INTENT(OUT) :: PANEL_COL( PANEL_TABSIZE )
      INTEGER(8), INTENT(OUT) :: PANEL_POS( PANEL_TABSIZE )
      LOGICAL,    INTENT(IN)  :: IGNORE_K459
      INTEGER :: IPANEL, ICOL_END, NBROWS_PANEL, NBCOLS_PANEL
      IF ( ignore_k459 ) THEN
        nb_target = npiv
      ELSE
        CALL mumps_ldltpanel_nbtarget( npiv, nb_target, keep )
      ENDIF
      panel_pos(1) = 1_8
      panel_col(1) = 1
      nbrows_panel = npiv
      nbpanels     = 1
      IF ( keep(459) .GT. 1 .AND. keep(50) .NE. 0 .AND.
     &   nb_target.NE.npiv ) THEN
        nbpanels = ( npiv + nb_target -1 ) / nb_target
        IF ( panel_tabsize .LT. nbpanels + 1 ) THEN
          WRITE(*,*) " Internal error in MUMPS_LDLTPANEL_PANELINFOS",
     &    panel_tabsize, nbpanels
          CALL mumps_abort()
        ENDIF
        DO ipanel=1, nbpanels
          icol_end = min(ipanel*nb_target, npiv)
          IF ( iw(icol_end) .LT. 0 ) THEN
            icol_end = icol_end + 1
          ENDIF
          nbcols_panel = icol_end - panel_col(ipanel) + 1
          panel_pos(ipanel+1) = panel_pos(ipanel) + 
     &    int(nbrows_panel,8)*int(nbcols_panel,8)
          panel_col(ipanel+1) = panel_col(ipanel) + nbcols_panel
          nbrows_panel = nbrows_panel - nbcols_panel
        ENDDO
      ELSE
          panel_pos(2)  = int(npiv,8)*int(npiv,8)+1_8
          panel_col(2) = npiv+1
      ENDIF

mumps_ldltpanel_sizes()

subroutine mumps_ldltpanel_sizes	(	integer, intent(in)	npiv,
		integer, dimension(500), intent(in)	keep,
		integer, dimension(npiv), intent(in)	iw,
		integer(8), dimension( keep(459) ), intent(out)	panel_sizes,
		integer, intent(out)	nbpanels )

Definition at line 1404 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN) :: NPIV 
      INTEGER, INTENT(IN) :: KEEP(500), IW(NPIV) 
      INTEGER(8), INTENT(OUT) :: PANEL_SIZES( KEEP(459) ) 
      INTEGER, INTENT(OUT) :: NBPANELS
      INTEGER :: NB_TARGET
      INTEGER :: ICOL_BEG, ICOL_END
      nbpanels = 0
      CALL mumps_ldltpanel_nbtarget( npiv, nb_target, keep )
      icol_beg = 1
      nbpanels = 0
      DO WHILE ( icol_beg .LE. npiv )
        nbpanels = nbpanels + 1
        icol_end = min(nb_target * nbpanels, npiv)
        IF ( iw( icol_end ) < 0 ) THEN 
          icol_end = icol_end + 1
        ENDIF
        panel_sizes(nbpanels) = icol_end-icol_beg+1
        icol_beg = icol_end + 1
      ENDDO
      panel_sizes(nbpanels+1:keep(459))=0
      RETURN

mumps_ldltpanel_storage()

subroutine mumps_ldltpanel_storage	(	integer, intent(in)	npiv,
		integer, dimension(500), intent(in)	keep,
		integer, dimension(*), intent(in)	iw,
		integer(8), intent(out)	nb_entries )

Definition at line 1329 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT(IN) :: NPIV 
      INTEGER, INTENT(IN) :: KEEP(500), IW(*) 
      INTEGER(8), INTENT(OUT) :: NB_ENTRIES 
      INTEGER :: NB_TARGET, NBCOLS_PANEL, NBROWS_PANEL
      INTEGER :: ICOL_BEG, ICOL_END, NBPANELS
      CALL mumps_ldltpanel_nbtarget( npiv, nb_target, keep )
      nb_entries = 0_8
      nbrows_panel = npiv
      icol_beg = 1
      nbpanels = 0
      DO WHILE ( icol_beg .LE. npiv )
        nbpanels = nbpanels + 1
        icol_end = min(nb_target * nbpanels, npiv)
        IF (iw(1) .NE. 0) THEN
          IF ( iw( icol_end ) < 0 ) THEN 
            icol_end = icol_end + 1
          ENDIF
        ENDIF
        nbcols_panel = icol_end - icol_beg + 1
        nb_entries = nb_entries + int(nbcols_panel,8) *
     &                            int(nbrows_panel,8)
        nbrows_panel = nbrows_panel - nbcols_panel
        icol_beg = icol_end + 1
      ENDDO
      RETURN

mumps_make1root()

subroutine mumps_make1root	(	integer, intent(in)	n,
		integer, dimension( n ), intent(inout)	frere,
		integer, dimension( n ), intent(inout)	fils,
		integer, dimension( n ), intent(in)	nfsiz,
		integer, intent(out)	theroot )

Definition at line 31 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, intent( in    )  :: N
      INTEGER, intent( in    )  :: NFSIZ( N )
      INTEGER, intent( inout )  :: FRERE( N ), FILS( N )
      INTEGER, intent( out   )  :: THEROOT
      INTEGER INODE, IROOT, IFILS, IN, IROOTLAST, SIZE
      iroot = -9999
      SIZE  = 0
      DO inode = 1, n
        IF ( frere( inode ) .EQ. 0 )  THEN
          IF ( nfsiz( inode ) .GT. SIZE ) THEN
            SIZE  = nfsiz( inode )
            iroot = inode
          END IF
        ENDIF
      END DO
      in = iroot
      DO WHILE ( fils( in ) .GT. 0 )
        in = fils( in )
      END DO
      irootlast = in
      ifils     = - fils( in )
      DO inode = 1, n
        IF ( frere( inode ) .eq. 0 .and. inode .ne. iroot ) THEN
          IF ( ifils .eq. 0 ) THEN
            fils( irootlast ) = - inode
            frere( inode )    = -iroot
            ifils             = inode
          ELSE
            frere( inode ) = -fils( irootlast )
            fils( irootlast ) = - inode
          END IF
        END IF
      END DO
      theroot = iroot
      RETURN

mumps_mem_centralize()

subroutine mumps_mem_centralize	(	integer	myid,
		integer	comm,
		integer	info,
		integer, dimension(2)	infog,
		integer	irank )

Definition at line 399 of file tools_common.F.

      IMPLICIT NONE
      INTEGER MYID, COMM, IRANK, INFO, INFOG(2)
      include 'mpif.h'
      INTEGER IERR_MPI, MASTER
#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
      INTEGER(4) :: TEMP1(2),TEMP2(2)
#else
      INTEGER :: TEMP1(2),TEMP2(2)
#endif
      parameter( master = 0 )
      CALL mpi_reduce( info, infog(1), 1, mpi_integer,
     &                 mpi_max, master, comm, ierr_mpi )
      CALL mpi_reduce( info, infog(2), 1, mpi_integer,
     &                 mpi_sum, master, comm, ierr_mpi )
      temp1(1) = info
      temp1(2) = myid
      CALL mpi_reduce( temp1, temp2, 1, mpi_2integer,
     &                 mpi_maxloc, master, comm, ierr_mpi )
      IF ( myid.eq. master ) THEN
         IF ( infog(1) .ne. temp2(1) ) THEN
          write(*,*) 'Error in MUMPS_MEM_CENTRALIZE'
          CALL mumps_abort()
        END IF
        irank    = temp2(2)
      ELSE
        irank    = -1
      END IF
      RETURN

mumps_nblocal_roots_or_leaves()

subroutine mumps_nblocal_roots_or_leaves	(	integer, intent(in)	n,
		integer, intent(in)	nbrorl,
		integer, dimension(nbrorl), intent(in)	rorl_list,
		integer, intent(out)	nrorl_loc,
		integer, intent(in)	myid_nodes,
		integer, intent(in)	slavef,
		integer, dimension( 500 ), intent(in)	keep,
		integer, dimension(n), intent(in)	step,
		integer, dimension(keep(28)), intent(in)	procnode_steps )

Definition at line 664 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, INTENT( OUT ) :: NRORL_LOC 
      INTEGER, INTENT( IN ) :: NBRORL 
      INTEGER, INTENT( IN ) :: RORL_LIST(NBRORL)
      INTEGER, INTENT( IN ) :: KEEP( 500 )
      INTEGER, INTENT( IN ) :: SLAVEF
      INTEGER, INTENT( IN ) :: N
      INTEGER, INTENT( IN ) :: STEP(N)
      INTEGER, INTENT( IN ) :: PROCNODE_STEPS(KEEP(28))
      INTEGER, INTENT( IN ) :: MYID_NODES
      INTEGER I, INODE
      INTEGER, EXTERNAL :: MUMPS_PROCNODE
      nrorl_loc = 0
      DO i = 1, nbrorl
        inode = rorl_list(i)
        IF (mumps_procnode(procnode_steps(step(inode)),
     &    keep(199)).EQ.myid_nodes) THEN
            nrorl_loc = nrorl_loc + 1
        END IF
      ENDDO
      RETURN

mumps_npiv_critical_path()

subroutine mumps_npiv_critical_path	(	integer, intent(in)	n,
		integer, intent(in)	nsteps,
		integer, dimension(n), intent(in)	step,
		integer, dimension(nsteps), intent(in)	frere,
		integer, dimension(n), intent(in)	fils,
		integer, dimension(lna), intent(in)	na,
		integer, intent(in)	lna,
		integer, dimension(nsteps), intent(in)	ne,
		integer, intent(out)	maxnpivtree )

Definition at line 1257 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, intent(in) :: N, NSTEPS, LNA
      INTEGER, intent(in) :: FRERE(NSTEPS), FILS(N), STEP(N)
      INTEGER, intent(in) :: NA(LNA), NE(NSTEPS)
      INTEGER, intent(out) :: MAXNPIVTREE
      INTEGER :: IFATH,INODE,ISON
      INTEGER :: NPIV,ILEAF,NBLEAF,NBROOT
      INTEGER, DIMENSION(:) , ALLOCATABLE :: MAXNPIV
      INTEGER :: I, allocok
      maxnpivtree = -9999
      ALLOCATE ( maxnpiv(nsteps), stat=allocok)
      IF (allocok .gt.0) THEN
         WRITE(*, *) 'Allocation error in MUMPS_NPIV_CRITICAL_PATH' 
     &           ,nsteps
         CALL mumps_abort()
      ENDIF
      nbleaf = na(1)      
      nbroot = na(2)
      maxnpiv = 0
      nbleaf = na(1)
      nbroot = na(2)
      DO ileaf = 1, nbleaf
        inode = na(2+ileaf)
 95     CONTINUE
        npiv = 0
        ison = inode
 100    npiv = npiv + 1
        ison = fils(ison)
        IF (ison .GT. 0 ) GOTO 100
        ison = -ison
        maxnpiv( step(inode) ) = npiv
        DO i = 1, ne(step(inode))
          maxnpiv(step(inode)) = max( maxnpiv(step(inode)),
     &                                npiv + maxnpiv(step(ison)) )
          ison     = frere(step(ison))
        ENDDO
        ifath = inode
        DO WHILE (ifath .GT. 0)
          ifath = frere(step(ifath))
        ENDDO
        ifath = -ifath
        IF (ifath.EQ.0) THEN 
          maxnpivtree = max(maxnpivtree, maxnpiv(step(inode)))
        ELSE 
          IF (frere(step(inode)) .LT. 0) THEN
            inode = ifath
            GOTO 95
          ENDIF
        ENDIF
      ENDDO
      DEALLOCATE( maxnpiv )
      RETURN

mumps_parana_avail()

logical function mumps_parana_avail

(

character, dimension(*)

which

)

Definition at line 942 of file tools_common.F.

      LOGICAL :: MUMPS_PARANA_AVAIL
      CHARACTER :: WHICH*(*)
      LOGICAL :: PTSCOTCH=.false., parmetis=.false.
#if defined(ptscotch)
      ptscotch = .true.
#endif
#if defined(parmetis) || defined(parmetis3)
      parmetis = .true.
#endif
      SELECT CASE(which)
      CASE('ptscotch','PTSCOTCH')
         mumps_parana_avail = ptscotch
      CASE('parmetis','PARMETIS')
         mumps_parana_avail = parmetis
      CASE('both','BOTH')
         mumps_parana_avail = ptscotch .AND. parmetis
      CASE('any','ANY')
         mumps_parana_avail = ptscotch .OR. parmetis
      CASE default
         write(*,'("Invalid input in MUMPS_PARANA_AVAIL")')
      END SELECT
      RETURN

mumps_procnode()

integer function mumps_procnode	(	integer	procinfo_inode,
		integer	k199 )

Definition at line 150 of file tools_common.F.

      IMPLICIT NONE
      INTEGER K199 
      INTEGER PROCINFO_INODE
      IF ( k199 < 0 ) THEN
        mumps_procnode=iand(procinfo_inode,
#if defined(MUMPS_F2003)
     &         int(b"111111111111111111111111"))
#else
     &          16777215 )
#endif
      ELSE
        IF (k199 == 1) THEN
          mumps_procnode = 0
        ELSE
          mumps_procnode=mod(2*k199+procinfo_inode-1,k199)
        END IF
      ENDIF
      RETURN

mumps_reducei8()

subroutine mumps_reducei8	(	integer(8)	in,
		integer(8)	out,
		integer	mpi_op,
		integer	root,
		integer	comm )

Definition at line 814 of file tools_common.F.

      IMPLICIT NONE
      include 'mpif.h'
      INTEGER ROOT, COMM, MPI_OP
      INTEGER(8) IN, OUT
      INTEGER IERR
      DOUBLE PRECISION DIN, DOUT
      din =dble(in)
      dout=0.0d0
      CALL mpi_reduce(din, dout, 1, mpi_double_precision,
     &                   mpi_op, root, comm, ierr)
      out=int(dout,kind=8)
      RETURN

mumps_rootssarbr()

logical function mumps_rootssarbr	(	integer	procinfo_inode,
		integer	k199 )

Definition at line 188 of file tools_common.F.

      IMPLICIT NONE
      INTEGER K199
      INTEGER TPN, PROCINFO_INODE
      IF (k199 < 0) THEN
        tpn = ishft(procinfo_inode,-24) - 1
      ELSE
        tpn = (procinfo_inode-1+2*k199)/k199 - 1
      ENDIF
      mumps_rootssarbr = ( tpn .eq. 0 )
      RETURN

mumps_secdeb()

subroutine mumps_secdeb

(

double precision

t

)

Definition at line 269 of file tools_common.F.

      DOUBLE PRECISION T
      DOUBLE PRECISION MPI_WTIME
      EXTERNAL mpi_wtime
      t=mpi_wtime()
      RETURN

mumps_secfin()

subroutine mumps_secfin

(

double precision

t

)

Definition at line 276 of file tools_common.F.

      DOUBLE PRECISION T
      DOUBLE PRECISION MPI_WTIME
      EXTERNAL mpi_wtime
      t=mpi_wtime()-t
      RETURN

mumps_seqana_avail()

logical function mumps_seqana_avail

(

integer, intent(in)

icntl7

)

Definition at line 922 of file tools_common.F.

      LOGICAL :: MUMPS_SEQANA_AVAIL
      INTEGER, INTENT(IN) :: ICNTL7
      LOGICAL :: SCOTCH=.false.
      LOGICAL :: METIS =.false.
#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
      metis = .true.
#endif
#if defined(scotch) || defined(ptscotch)
      scotch = .true.
#endif
      IF ( icntl7 .LT. 0 .OR. icntl7 .GT. 7 ) THEN
        mumps_seqana_avail = .false.
      ELSE
        mumps_seqana_avail = .true.
      ENDIF
      IF ( icntl7 .EQ. 5 ) mumps_seqana_avail = metis
      IF ( icntl7 .EQ. 3 ) mumps_seqana_avail = scotch
      RETURN

mumps_set_ierror()

subroutine mumps_set_ierror	(	integer(8), intent(in)	size8,
		integer, intent(out)	ierror )

Definition at line 864 of file tools_common.F.

      INTEGER(8), INTENT(IN) :: SIZE8
      INTEGER, INTENT(OUT) :: IERROR
      CALL mumps_seti8toi4(size8, ierror)
      RETURN

mumps_set_parti_regular()

subroutine mumps_set_parti_regular	(	integer, intent(in)	slavef,
		integer, dimension(500), intent(in)	keep,
		integer(8), dimension(150)	keep8,
		integer, dimension(slavef+1), intent(in)	procs,
		integer, dimension(0:slavef-1), intent(in)	mem_distrib,
		integer, intent(in)	ncb,
		integer, intent(in)	nfront,
		integer, intent(out)	nslaves_node,
		integer, dimension(slavef+2), intent(out)	tab_pos,
		integer, dimension(size_slaves_list), intent(out)	slaves_list,
		integer, intent(in)	size_slaves_list,
		integer, intent(in)	myid,
		integer, intent(in)	inode,
		integer(8), dimension(0:slavef-1), intent(in)	tab_maxs_arg,
		integer, dimension(2), intent(in)	sup_proc_arg,
		integer(8), intent(out)	max_surf,
		integer, intent(out)	nb_row_max )

Definition at line 1558 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST
      INTEGER(8) KEEP8(150)
      INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID
      INTEGER, intent(in) :: PROCS(SLAVEF+1)
      INTEGER(8), intent(in) :: TAB_MAXS_ARG(0:SLAVEF-1)
      INTEGER, intent(in) :: SUP_PROC_ARG(2)
      INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE
      INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
      INTEGER, intent(out):: TAB_POS(SLAVEF+2)
      INTEGER, intent(out):: NSLAVES_NODE,NB_ROW_MAX
      INTEGER(8), intent(out):: MAX_SURF
      LOGICAL :: FORCE_LDLTRegular_NIV2
      INTEGER NSLAVES,ACC
      INTEGER i,J,NELIM,NB_SUP,K50,NB_ROWS(PROCS(SLAVEF+1))
      INTEGER TMP_NROW,X,K
      LOGICAL SUP,MEM_CSTR
      DOUBLE PRECISION MAX_LOAD,TOTAL_LOAD,VAR,TMP,A,B,C,DELTA,
     &     LOAD_CORR
      INTEGER IDWLOAD(SLAVEF)
      INTEGER(8) MEM_CONSTRAINT(2)
      k50=keep(50)
      force_ldltregular_niv2 = .false.
      max_surf=0
      nb_row_max=0
      nelim=nfront-ncb
      nb_sup=0
      total_load=0.0d0
      sup=.false.
      IF(sup_proc_arg(1).NE.
     &     0)THEN
         mem_constraint(1)=tab_maxs_arg(procs(1))
         total_load=total_load+dble(sup_proc_arg(1))/100.0d0
         nb_sup=nb_sup+1
      ENDIF
      IF(sup_proc_arg(2).NE.
     &     0)THEN
         mem_constraint(2)=tab_maxs_arg(procs(procs(slavef+1)))
         total_load=total_load+dble(sup_proc_arg(2))/100.0d0
         nb_sup=nb_sup+1
      ENDIF
      total_load=total_load+(procs(slavef+1)-nb_sup)
      IF(k50.EQ.0)THEN
         max_load=dble( nelim ) * dble( ncb ) +
     *        dble(ncb) * dble(nelim)*dble(2*nfront-nelim-1)
      ELSE
         max_load=dble(nelim) * dble( ncb ) *
     *        dble(nfront+1)
      ENDIF
      tmp=min(max_load,max_load/total_load)
      j=1
      DO i=1,procs(slavef+1)
         IF((nb_sup.GT.0).AND.(i.EQ.1))THEN
            cycle
         ELSEIF((nb_sup.EQ.2).AND.(i.EQ.procs(slavef+1)))THEN
            cycle
         ENDIF
         idwload(j)=procs(i)
         j=j+1
      ENDDO
      DO i=1,nb_sup
         IF(i.EQ.1)THEN
            idwload(j)=procs(1)
         ELSE
            idwload(j)=procs(procs(slavef+1))
         ENDIF
         j=j+1
      ENDDO
      IF ((k50.EQ.0).OR.force_ldltregular_niv2) THEN
         acc=0
         j=procs(slavef+1)-nb_sup+1
         DO i=1,nb_sup
            var=dble(sup_proc_arg(i))/100.0d0
            tmp_nrow=int(dble(mem_constraint(i))/dble(nfront))
            nb_rows(j)=int(max((var*dble(tmp))/
     &           (dble(nelim)*dble(2*nfront-nelim)),
     &           dble(1)))
            IF(nb_rows(j).GT.tmp_nrow)THEN
               nb_rows(j)=tmp_nrow
            ENDIF
            IF(ncb-acc.LT.nb_rows(j)) THEN 
               nb_rows(j)=ncb-acc
               acc=ncb
               EXIT
            ENDIF
            acc=acc+nb_rows(j)
            j=j+1
         ENDDO
         IF(acc.EQ.ncb)THEN
            GOTO 777
         ENDIF
         DO i=1,procs(slavef+1)-nb_sup
            var=1.0d0
            tmp_nrow=int((dble(tab_maxs_arg(idwload(i))))/dble(nfront))
            nb_rows(i)=int((dble(var)*dble(tmp))/
     &           (dble(nelim)*dble(2*nfront-nelim)))
            IF(nb_rows(i).GT.tmp_nrow)THEN
               nb_rows(i)=tmp_nrow
            ENDIF
            IF(ncb-acc.LT.nb_rows(i)) THEN 
               nb_rows(i)=ncb-acc
               acc=ncb
               EXIT
            ENDIF
            acc=acc+nb_rows(i)
         ENDDO
         IF(acc.NE.ncb)THEN
            IF(procs(slavef+1).EQ.nb_sup)THEN
               tmp_nrow=(ncb-acc)/procs(slavef+1)+1
               DO i=1,procs(slavef+1)
                  nb_rows(i)=nb_rows(i)+tmp_nrow
                  IF(acc+tmp_nrow.GT.ncb)THEN
                     nb_rows(i)=nb_rows(i)-tmp_nrow+ncb-acc
                     acc=ncb
                     EXIT
                  ENDIF
                  acc=acc+tmp_nrow
               ENDDO
            ELSE
               tmp_nrow=(ncb-acc)/(procs(slavef+1)-nb_sup)+1
               DO i=1,procs(slavef+1)-nb_sup
                  nb_rows(i)=nb_rows(i)+tmp_nrow
                  acc=acc+tmp_nrow
                  IF(acc.GT.ncb) THEN 
                     nb_rows(i)=nb_rows(i)-tmp_nrow+
     &                    (ncb-(acc-tmp_nrow))
                     EXIT
                  ENDIF
               ENDDO
            ENDIF
         ENDIF
      ELSE
         acc=0
         i=procs(slavef+1)-nb_sup+1
         x=ncb
         load_corr=0.0d0
         mem_cstr=.false.
         DO j=1,nb_sup
            var=dble(sup_proc_arg(j))/dble(100)
            a=1.0d0
            b=dble(x+nelim)
            c=-dble(max(mem_constraint(j),0_8))
            delta=((b*b)-(4*a*c))
            tmp_nrow=int((-b+sqrt(delta))/(2*a))
            a=dble(-nelim)
            b=dble(nelim)*(dble(-nelim)+dble(2*(x+nelim)+1))
            c=-(var*tmp)
            delta=(b*b-(4*a*c))
            nb_rows(i)=int((-b+sqrt(delta))/(2*a))
            IF(nb_rows(i).GT.tmp_nrow)THEN
               nb_rows(i)=tmp_nrow
               mem_cstr=.true.               
            ENDIF
            IF(acc+nb_rows(i).GT.ncb)THEN
               nb_rows(i)=ncb-acc
               acc=ncb
               x=0
               EXIT
            ENDIF
            x=x-nb_rows(i)
            acc=acc+nb_rows(i) 
            load_corr=load_corr+(dble(nelim) * dble(nb_rows(i)) *
     *           dble(2*(x+nelim) - nelim - nb_rows(i) + 1))
            i=i+1
         ENDDO
         IF(acc.EQ.ncb)THEN
            GOTO 777
         ENDIF
            IF((procs(slavef+1).NE.nb_sup).AND.mem_cstr)THEN
               tmp=(max_load-load_corr)/(procs(slavef+1)-nb_sup)
            ENDIF
         x=acc
         acc=0
         DO i=1,procs(slavef+1)-nb_sup
            IF (keep(375) .EQ. 1) THEN 
              var=1.0d0
              a=dble(nelim)
              b=dble(nelim)*(dble(nelim)+dble(2*acc+1))
              c=-(var*tmp)
            ELSE    
              a=1.0d0
              b=dble(acc+nelim)
              c=-tmp
            ENDIF
            delta=((b*b)-(4*a*c))
            nb_rows(i)=int((-b+sqrt(delta))/(2*a))
            IF(ncb-acc-x.LT.nb_rows(i))THEN
               nb_rows(i)=ncb-acc-x
               acc=ncb-x
               EXIT
            ENDIF
            acc=acc+nb_rows(i)
         ENDDO
         acc=acc+x
         IF(acc.NE.ncb)THEN
            IF(procs(slavef+1).EQ.nb_sup)THEN
               tmp_nrow=(ncb-acc)/procs(slavef+1)+1
               DO i=1,procs(slavef+1)
                  nb_rows(i)=nb_rows(i)+tmp_nrow
                  IF(acc+tmp_nrow.GT.ncb)THEN
                     nb_rows(i)=nb_rows(i)-tmp_nrow+ncb-acc
                     acc=ncb
                     EXIT
                  ENDIF
                  acc=acc+tmp_nrow
               ENDDO
            ELSE
               nb_rows(procs(slavef+1)-nb_sup)=
     &              nb_rows(procs(slavef+1)
     &              -nb_sup)+ncb-acc
            ENDIF
         ENDIF
      ENDIF
 777  CONTINUE
      nslaves=0
      acc=1
      j=1
      k=1
      DO i=1,procs(slavef+1)
         IF(nb_rows(i).NE.0)THEN
            slaves_list(j)=idwload(i)
            tab_pos(j)=acc
            acc=acc+nb_rows(i)
            nb_row_max=max(nb_row_max,nb_rows(i))
            IF(k50.EQ.0)THEN
               max_surf=max(int(nb_rows(i),8)*int(ncb,8),int(0,8))
            ELSE
               max_surf=max(int(nb_rows(i),8)*int(acc,8),int(0,8))
            ENDIF
            nslaves=nslaves+1
            j=j+1
         ELSE
            slaves_list(procs(slavef+1)-k+1)=idwload(i)
            k=k+1
         ENDIF
      ENDDO
      tab_pos(slavef+2) = nslaves
      tab_pos(nslaves+1)= ncb+1
      nslaves_node=nslaves

mumps_set_ssarbr_dad()

subroutine mumps_set_ssarbr_dad	(	logical, intent(out)	ssarbr,
		integer, intent(in)	inode,
		integer, dimension(keep28), intent(in)	dad,
		integer, intent(in)	n,
		integer, intent(in)	keep28,
		integer, dimension(n), intent(in)	step,
		integer, dimension(keep28), intent(in)	procnode_steps,
		integer, intent(in)	k199 )

Definition at line 226 of file tools_common.F.

            IMPLICIT NONE
            INTEGER, INTENT(IN) :: N, KEEP28, K199, INODE
            INTEGER, INTENT(IN) :: DAD(KEEP28), PROCNODE_STEPS(KEEP28)
            INTEGER, INTENT(IN) :: STEP(N)
            LOGICAL, INTENT(OUT) :: SSARBR
            INTEGER :: DADINODE, TYPEDAD
            LOGICAL, EXTERNAL :: MUMPS_INSSARBR
            INTEGER, EXTERNAL :: MUMPS_TYPENODE
            ssarbr   = .false.
            dadinode = dad(step(inode))
            IF (dadinode .NE. 0) THEN
              typedad  = mumps_typenode(procnode_steps(step(dadinode)),
     &                                  k199)
              IF (typedad.EQ.1) THEN
                ssarbr=mumps_inssarbr(procnode_steps(step(dadinode)),
     &                                k199)
              ENDIF
            ENDIF
            RETURN

mumps_seti8toi4()

subroutine mumps_seti8toi4	(	integer(8), intent(in)	i8,
		integer, intent(out)	i )

Definition at line 842 of file tools_common.F.

      IMPLICIT NONE
      INTEGER   , INTENT(OUT) :: I
      INTEGER(8), INTENT(IN)  :: I8
      IF ( i8 .GT. int(huge(i),8) ) THEN
        i = -int(i8/1000000_8,kind(i))
      ELSE
        i = int(i8,kind(i))
      ENDIF
      RETURN

mumps_sort_doubles()

subroutine mumps_sort_doubles	(	integer	n,
		double precision, dimension( n )	val,
		integer, dimension( n )	id )

Definition at line 283 of file tools_common.F.

      INTEGER N
      INTEGER ID( N )
      DOUBLE PRECISION VAL( N )
      INTEGER I, ISWAP
      DOUBLE PRECISION SWAP
      LOGICAL DONE
      done = .false.
      DO WHILE ( .NOT. done )
        done = .true.
        DO i = 1, n - 1
          IF ( val( i ) .GT. val( i + 1 ) ) THEN
            done = .false.
            iswap = id( i )
            id( i ) = id( i + 1 )
            id( i + 1 ) = iswap
            swap = val( i )
            val( i ) = val( i + 1 )
            val( i + 1 ) = swap
          END IF
        END DO
      END DO
      RETURN

mumps_sort_doubles_dec()

subroutine mumps_sort_doubles_dec	(	integer	n,
		double precision, dimension( n )	val,
		integer, dimension( n )	id )

Definition at line 307 of file tools_common.F.

      INTEGER N
      INTEGER ID( N )
      DOUBLE PRECISION VAL( N )
      INTEGER I, ISWAP
      DOUBLE PRECISION SWAP
      LOGICAL DONE
      done = .false.
      DO WHILE ( .NOT. done )
        done = .true.
        DO i = 1, n - 1
          IF ( val( i ) .LT. val( i + 1 ) ) THEN
            done = .false.
            iswap = id( i )
            id( i ) = id( i + 1 )
            id( i + 1 ) = iswap
            swap = val( i )
            val( i ) = val( i + 1 )
            val( i + 1 ) = swap
          END IF
        END DO
      END DO
      RETURN

mumps_sort_int()

subroutine mumps_sort_int	(	integer	n,
		integer, dimension( n )	val,
		integer, dimension( n )	id )

Definition at line 708 of file tools_common.F.

      INTEGER N
      INTEGER ID( N )
      INTEGER VAL( N )
      INTEGER I, ISWAP
      INTEGER SWAP
      LOGICAL DONE
      done = .false.
      DO WHILE ( .NOT. done )
        done = .true.
        DO i = 1, n - 1
           IF ( val( i ) .GT. val( i + 1 ) ) THEN
              done = .false.
              iswap = id( i )
              id( i ) = id( i + 1 )
              id( i + 1 ) = iswap
              swap = val( i )
              val( i ) = val( i + 1 )
              val( i + 1 ) = swap
           END IF
        END DO
      END DO
      RETURN

mumps_sort_int8()

subroutine mumps_sort_int8	(	integer	n,
		integer(8), dimension( n )	val,
		integer, dimension( n )	id )

Definition at line 756 of file tools_common.F.

      INTEGER N
      INTEGER ID( N )
      INTEGER(8) :: VAL( N )
      INTEGER I, ISWAP
      INTEGER(8) SWAP
      LOGICAL DONE
      done = .false.
      DO WHILE ( .NOT. done )
        done = .true.
        DO i = 1, n - 1
           IF ( val( i ) .GT. val( i + 1 ) ) THEN
              done = .false.
              iswap = id( i )
              id( i ) = id( i + 1 )
              id( i + 1 ) = iswap
              swap = val( i )
              val( i ) = val( i + 1 )
              val( i + 1 ) = swap
           END IF
        END DO
      END DO
      RETURN

mumps_sort_int_dec()

subroutine mumps_sort_int_dec	(	integer	n,
		integer, dimension( n )	val,
		integer, dimension( n )	id )

Definition at line 732 of file tools_common.F.

      INTEGER N
      INTEGER ID( N )
      INTEGER VAL( N )
      INTEGER I, ISWAP
      INTEGER SWAP
      LOGICAL DONE
      done = .false.
      DO WHILE ( .NOT. done )
        done = .true.
        DO i = 1, n - 1
           IF ( val( i ) .LT. val( i + 1 ) ) THEN
              done = .false.
              iswap = id( i )
              id( i ) = id( i + 1 )
              id( i + 1 ) = iswap
              swap = val( i )
              val( i ) = val( i + 1 )
              val( i + 1 ) = swap
           END IF
        END DO
      END DO
      RETURN

mumps_sort_step()

subroutine mumps_sort_step	(	integer	n,
		integer, dimension(nsteps)	frere,
		integer, dimension(n)	step,
		integer, dimension(n)	fils,
		integer, dimension(lna)	na,
		integer	lna,
		integer, dimension(nsteps)	ne,
		integer, dimension(nsteps)	nd,
		integer, dimension(ldad)	dad,
		integer	ldad,
		logical	use_dad,
		integer	nsteps,
		integer, dimension(80)	info,
		integer	lp,
		integer, dimension(nsteps)	procnode,
		integer	slavef )

Definition at line 966 of file tools_common.F.

      IMPLICIT NONE
      INTEGER N, NSTEPS, LNA, LP,LDAD
      INTEGER FRERE(NSTEPS), FILS(N), STEP(N)
      INTEGER NA(LNA), NE(NSTEPS), ND(NSTEPS)
      INTEGER DAD(LDAD)
      LOGICAL USE_DAD
      INTEGER INFO(80)
      INTEGER SLAVEF,PROCNODE(NSTEPS)
      INTEGER  POSTORDER,TMP_SWAP
      INTEGER, DIMENSION (:), ALLOCATABLE :: STEP_TO_NODE
      INTEGER, DIMENSION (:), ALLOCATABLE :: IPOOL,TNSTK
      INTEGER I,II,allocok
      INTEGER NBLEAF,NBROOT,LEAF,IN,INODE,IFATH
      EXTERNAL mumps_typenode
      INTEGER MUMPS_TYPENODE
      postorder=1
      nbleaf = na(1)
      nbroot = na(2)
      ALLOCATE( ipool(nbleaf), tnstk(nsteps), stat=allocok )
      IF (allocok > 0) THEN
        IF ( lp .GT. 0 )
     &    WRITE(lp,*)'Memory allocation error in MUMPS_SORT_STEP'
        info(1)=-7
        info(2)=nsteps
        RETURN
      ENDIF
      DO i=1,nsteps
         tnstk(i) = ne(i)
      ENDDO
      ALLOCATE(step_to_node(nsteps),stat=allocok)
      IF (allocok > 0) THEN
         IF ( lp .GT. 0 )
     &        WRITE(lp,*)'Memory allocation error in
     &MUMPS_SORT_STEP'
         info(1)=-7
         info(2)=nsteps
         RETURN
      ENDIF
      DO i=1,n
         IF(step(i).GT.0)THEN
            step_to_node(step(i))=i
         ENDIF
      ENDDO
      ipool(1:nbleaf)=na(3:2+nbleaf)
      leaf = nbleaf + 1
 91   CONTINUE
      IF (leaf.NE.1) THEN
         leaf = leaf -1
         inode = ipool(leaf)
      ENDIF
 96   CONTINUE
      IF (use_dad) THEN
         ifath = dad( step(inode) )
      ELSE
         in = inode
 113     in = frere(in)
         IF (in.GT.0) GO TO 113
         ifath = -in
      ENDIF
      tmp_swap=frere(step(inode))
      frere(step(inode))=frere(postorder)
      frere(postorder)=tmp_swap
      tmp_swap=nd(step(inode))
      nd(step(inode))=nd(postorder)
      nd(postorder)=tmp_swap
      tmp_swap=ne(step(inode))
      ne(step(inode))=ne(postorder)
      ne(postorder)=tmp_swap
      tmp_swap=procnode(step(inode))
      procnode(step(inode))=procnode(postorder)
      procnode(postorder)=tmp_swap
      IF(use_dad)THEN
         tmp_swap=dad(step(inode))
         dad(step(inode))=dad(postorder)
         dad(postorder)=tmp_swap
      ENDIF
      tmp_swap=tnstk(step(inode))
      tnstk(step(inode))=tnstk(postorder)
      tnstk(postorder)=tmp_swap
      ii=step_to_node(postorder)
      tmp_swap=step(inode)
      step(step_to_node(postorder))=tmp_swap
      step(inode)=postorder
      step_to_node(postorder)=inode
      step_to_node(tmp_swap)=ii
      in=ii
 101  in = fils(in)
      IF (in .GT. 0 ) THEN
         step(in)=-step(ii)
         GOTO 101
      ENDIF
      in=inode
 102  in = fils(in)
      IF (in .GT. 0 ) THEN
         step(in)=-step(inode)
         GOTO 102
      ENDIF
      postorder = postorder + 1
      IF (ifath.EQ.0) THEN
         nbroot = nbroot - 1
         IF (nbroot.EQ.0) GOTO 116
         GOTO 91
      ENDIF
      tnstk(step(ifath)) = tnstk(step(ifath)) - 1
      IF ( tnstk(step(ifath)) .EQ. 0 ) THEN      
         inode = ifath
         GOTO 96
      ELSE
         GOTO 91
      ENDIF
 116  CONTINUE
      DEALLOCATE(step_to_node)
      DEALLOCATE(ipool,tnstk)
      RETURN

mumps_storei8()

subroutine mumps_storei8	(	integer(8), intent(in)	i8,
		integer, dimension(2), intent(out)	int_array )

Definition at line 870 of file tools_common.F.

      IMPLICIT NONE
      INTEGER(8), intent(in)  :: I8
      INTEGER,    intent(out) :: INT_ARRAY(2)
      INTEGER(kind(0_4)) :: I32
      INTEGER(8) :: IDIV, IPAR
      parameter(ipar=int(huge(i32),8))
      parameter(idiv=ipar+1_8)
      IF ( i8 .LT. idiv ) THEN
        int_array(1) = 0
        int_array(2) = int(i8)
      ELSE
        int_array(1) = int(i8 / idiv)
        int_array(2) = int(mod(i8,idiv))
      ENDIF
      RETURN

mumps_subtri8toarray()

subroutine mumps_subtri8toarray	(	integer, dimension(2), intent(inout)	int_array,
		integer(8), intent(in)	i8 )

Definition at line 912 of file tools_common.F.

      IMPLICIT NONE
      INTEGER(8), intent(in) :: I8
      INTEGER, intent(inout) :: INT_ARRAY(2)
      INTEGER(8) :: I8TMP
      CALL mumps_geti8(i8tmp, int_array)
      i8tmp = i8tmp - i8
      CALL mumps_storei8(i8tmp, int_array)
      RETURN

mumps_typeandprocnode()

subroutine mumps_typeandprocnode	(	integer, intent(out)	tpn,
		integer, intent(out)	mumps_procnode,
		integer, intent(in)	procinfo_inode,
		integer, intent(in)	k199 )

Definition at line 112 of file tools_common.F.

      INTEGER, INTENT(IN) :: K199, PROCINFO_INODE
      INTEGER, intent(out) :: TPN, MUMPS_PROCNODE
      IF (k199 < 0 ) THEN
        mumps_procnode=iand(procinfo_inode,
#if defined(MUMPS_F2003)
     &         int(b"111111111111111111111111"))
#else
     &         16777215)
#endif
        tpn = ishft(procinfo_inode,-24) - 1
        IF (tpn < 1 ) THEN
          tpn = 1
        ELSE IF (tpn.GE.4) THEN
          tpn = 2
        ENDIF
      ELSE
        IF (k199 == 1) THEN
          mumps_procnode = 0
          IF (procinfo_inode <= k199) THEN
            tpn = 1
          ELSE
            tpn = 3
          ENDIF
        ELSE
          tpn = (procinfo_inode-1+2*k199)/k199-1
          mumps_procnode = (procinfo_inode-1+2*k199)-
     &                      (tpn+1)*k199
          IF (tpn .LT. 1) THEN
            tpn = 1
          ELSE IF (tpn .ge. 4) THEN
            tpn = 2
          ENDIF
        ENDIF
      ENDIF
      RETURN

mumps_typenode()

integer function mumps_typenode	(	integer	procinfo_inode,
		integer	k199 )

Definition at line 89 of file tools_common.F.

      IMPLICIT NONE
      INTEGER K199 
      INTEGER PROCINFO_INODE, TPN
      IF (k199 < 0) THEN
        tpn = ishft(procinfo_inode,-24) - 1
        IF (tpn < 1 ) THEN
          tpn = 1
        ELSE IF (tpn.GE.4) THEN
          tpn = 2
        ENDIF
      ELSE
        IF (procinfo_inode <= k199 ) THEN
          tpn = 1
        ELSE
          tpn = (procinfo_inode-1+2*k199)/k199 - 1
          IF ( tpn .LT. 1 ) tpn = 1
          IF (tpn.EQ.4.OR.tpn.EQ.5.OR.tpn.EQ.6) tpn = 2
        END IF
      END IF
      mumps_typenode = tpn
      RETURN 

mumps_typenode_rough()

integer function mumps_typenode_rough	(	integer	procinfo_inode,
		integer	k199 )

Definition at line 78 of file tools_common.F.

      IMPLICIT NONE
      INTEGER K199 
      INTEGER PROCINFO_INODE
      IF (k199 < 0) THEN
        mumps_typenode_rough = ishft(procinfo_inode,-24) - 1
      ELSE
        mumps_typenode_rough = (procinfo_inode-1+2*k199)/k199 - 1
      ENDIF
      RETURN 

mumps_typesplit()

integer function mumps_typesplit	(	integer	procinfo_inode,
		integer, intent(in)	k199 )

Definition at line 170 of file tools_common.F.

      IMPLICIT NONE
      INTEGER, intent(in) ::  K199 
      INTEGER PROCINFO_INODE, TPN
      IF (k199 < 0) THEN
        tpn = ishft(procinfo_inode,-24) - 1
        IF (tpn < 1 ) tpn = 1
      ELSE
        IF (procinfo_inode <= k199 ) THEN
           tpn = 1
        ELSE
          tpn = (procinfo_inode-1+2*k199)/k199 - 1
          IF ( tpn .LT. 1 ) tpn = 1
        ENDIF
      ENDIF
      mumps_typesplit = tpn
      RETURN