cmumps_load.F

Go to the documentation of this file.

C
C  This file is part of MUMPS 5.5.1, released
C  on Tue Jul 12 13:17:24 UTC 2022
C
C
C  Copyright 1991-2022 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 cmumps_load
      implicit none
      PUBLIC :: cmumps_load_set_inicost, cmumps_load_init,
     &  cmumps_load_set_slaves, cmumps_load_update,
     &  cmumps_load_end, cmumps_load_process_message, 
     &  cmumps_load_less, cmumps_load_less_cand,
     &  cmumps_load_set_slaves_cand, cmumps_load_master_2_all,
     &  cmumps_load_recv_msgs, cmumps_load_mem_update,
     &  cmumps_load_set_partition,
     &  cmumps_split_prep_partition, cmumps_split_post_partition,
     &  cmumps_split_propagate_parti, cmumps_load_pool_upd_new_pool,
     &  cmumps_load_sbtr_upd_new_pool, cmumps_load_pool_check_mem,
     &  cmumps_load_set_sbtr_mem,
     &  cmumps_remove_node, cmumps_upper_predict
     &  ,cmumps_load_send_md_info,
     &  cmumps_load_clean_meminfo_pool, cmumps_load_comp_maxmem_pool,
     &  cmumps_load_chk_memcst_pool, cmumps_check_sbtr_cost,
     &  cmumps_find_best_node_for_mem,
     &  cmumps_load_init_sbtr_struct
      DOUBLE PRECISION, DIMENSION(:),
     &       ALLOCATABLE, SAVE, PRIVATE :: load_flops
      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PRIVATE :: buf_load_recv
      INTEGER, SAVE, PRIVATE :: lbuf_load_recv, lbuf_load_recv_bytes
      INTEGER, SAVE, PRIVATE :: k50, k69, k35
      INTEGER(8), SAVE, PRIVATE :: max_surf_master
      LOGICAL, SAVE, PRIVATE :: bdc_mem, bdc_pool, bdc_sbtr, 
     &     bdc_pool_mng,
     &     bdc_m2_mem,bdc_m2_flops,bdc_md,remove_node_flag,
     &     remove_node_flag_mem
      DOUBLE PRECISION, SAVE, PRIVATE :: remove_node_cost,
     &     remove_node_cost_mem
      INTEGER, SAVE, PRIVATE :: sbtr_which_m
      DOUBLE PRECISION, DIMENSION(:),
     &       ALLOCATABLE, TARGET, SAVE, PRIVATE :: wload
      DOUBLE PRECISION, SAVE, PRIVATE :: delta_load, delta_mem
      LOGICAL, SAVE, PRIVATE :: is_mumps_load_enabled
      PUBLIC:: mumps_load_enable, mumps_load_disable
      INTEGER(8), SAVE, PRIVATE :: check_mem
      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, TARGET, PRIVATE :: 
     &          idwload
      DOUBLE PRECISION, SAVE, PRIVATE :: cost_subtree
      DOUBLE PRECISION, SAVE, PRIVATE :: alpha
      DOUBLE PRECISION, SAVE, PRIVATE :: beta
      INTEGER, SAVE, PRIVATE :: myid, nprocs, comm_ld
      INTEGER, SAVE, PRIVATE :: comm_nodes
      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE, 
     &           PRIVATE :: pool_mem
      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, PRIVATE, 
     &           SAVE :: sbtr_mem
      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, 
     &           PRIVATE, SAVE :: sbtr_cur
      INTEGER, DIMENSION(:), ALLOCATABLE, 
     &           PRIVATE, SAVE :: nb_son
      DOUBLE PRECISION, 
     &           PRIVATE, SAVE :: sbtr_cur_local
      DOUBLE PRECISION, 
     &           PRIVATE, SAVE :: peak_sbtr_cur_local
      DOUBLE PRECISION, 
     &           PRIVATE, SAVE :: max_peak_stk
      DOUBLE PRECISION, SAVE, 
     &           PRIVATE :: pool_last_cost_sent
      DOUBLE PRECISION, SAVE, 
     &           PRIVATE :: min_diff
      INTEGER, SAVE :: pos_id,pos_mem
      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: cb_cost_id
      INTEGER(8), DIMENSION(:), ALLOCATABLE, save
     &           :: cb_cost_mem
      PUBLIC :: cb_cost_id, cb_cost_mem,pos_mem,pos_id
      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: lu_usage
      INTEGER(8), DIMENSION(:), ALLOCATABLE, SAVE,
     &        PRIVATE::md_mem, TAB_MAXS
      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE ::mem_subtree
      INTEGER  :: nb_subtrees,niv1_flag
      INTEGER, PRIVATE  :: indice_sbtr,indice_sbtr_array
      INTEGER :: pool_niv2_size
      INTEGER,SAVE :: inside_subtree
      PUBLIC :: nb_subtrees,mem_subtree,inside_subtree,niv1_flag
      DOUBLE PRECISION, SAVE, PRIVATE :: dm_sumlu,
     &                   dm_thres_mem
      DOUBLE PRECISION, DIMENSION(:),
     &   ALLOCATABLE, SAVE , PRIVATE:: dm_mem
      INTEGER, SAVE, PRIVATE :: pool_size,id_max_m2
      DOUBLE PRECISION, SAVE, PRIVATE :: max_m2,tmp_m2
      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE, PRIVATE:: pool_niv2
      DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE,SAVE, 
     &      PRIVATE :: pool_niv2_cost, niv2
      DOUBLE PRECISION, SAVE, PRIVATE  ::      chk_ld
      INTEGER, DIMENSION(:),POINTER, SAVE, PRIVATE  :: 
     &         procnode_load, step_to_niv2_load
      INTEGER, DIMENSION(:),POINTER, SAVE, PRIVATE  :: keep_load
      INTEGER, SAVE, PRIVATE :: n_load
      INTEGER(8), DIMENSION(:), POINTER, SAVE, PRIVATE:: keep8_load
      INTEGER, DIMENSION(:),POINTER, SAVE :: 
     &         fils_load, step_load,
     &         frere_load, nd_load,
     &         ne_load,dad_load
      INTEGER, DIMENSION(:,:),POINTER, SAVE, PRIVATE :: cand_load
      INTEGER, DIMENSION(:),POINTER, SAVE, 
     &         PRIVATE :: my_first_leaf,my_nb_leaf, my_root_sbtr
      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE, 
     &         PRIVATE ::sbtr_first_pos_in_pool
      DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE,SAVE, 
     &         PRIVATE ::sbtr_peak_array,
     &     sbtr_cur_array
      DOUBLE PRECISION,DIMENSION(:),POINTER, SAVE :: cost_trav
      INTEGER, DIMENSION(:),POINTER, SAVE :: depth_first_load,
     &     depth_first_seq_load,sbtr_id_load
      PUBLIC :: depth_first_load,cost_trav, fils_load,step_load,
     &     frere_load, nd_load,ne_load,dad_load,
     &     depth_first_seq_load,sbtr_id_load
      INTEGER, SAVE     :: root_current_subtree,current_best,
     &     second_current_best
      PUBLIC :: root_current_subtree,current_best,
     &     second_current_best
      CONTAINS
      SUBROUTINE mumps_load_enable()
      IMPLICIT NONE
      is_mumps_load_enabled = .true.
      RETURN
      END SUBROUTINE mumps_load_enable
      SUBROUTINE mumps_load_disable()
      IMPLICIT NONE
      is_mumps_load_enabled = .false.
      RETURN
      END SUBROUTINE mumps_load_disable
      SUBROUTINE cmumps_load_set_inicost( COST_SUBTREE_ARG, K64, DK15,
     &     K375, MAXS )
      IMPLICIT NONE
      DOUBLE PRECISION cost_subtree_arg
      INTEGER, INTENT(IN) :: k64, k375
      REAL, INTENT(IN) :: dk15
      INTEGER(8)::maxs
      DOUBLE PRECISION :: t64, t66
      LOGICAL :: avoid_load_messages
      t64 = max( dble(k64), dble(1) )
      t64 = min( t64, dble(1000)  )
      t66 = max(dble(dk15), dble(100))
      min_diff     =  ( t64 / dble(1000)  )* 
     &                  t66 * dble(1000000)
      dm_thres_mem = dble(maxs/300_8)
      cost_subtree = cost_subtree_arg
      avoid_load_messages = .false.
      IF (k375.EQ.1) THEN
        avoid_load_messages = .true.
      ENDIF
      IF (avoid_load_messages) THEN
        min_diff = min_diff * 1000.d0
        dm_thres_mem = dm_thres_mem * 1000_8
      ENDIF
      RETURN
      END SUBROUTINE cmumps_load_set_inicost
      SUBROUTINE cmumps_split_prep_partition ( 
     &      INODE, STEP, N, SLAVEF,
     &      PROCNODE_STEPS, KEEP, DAD, FILS,
     &      CAND, ICNTL, COPY_CAND,
     &      NBSPLIT, NUMORG_SPLIT, SLAVES_LIST,
     &      SIZE_SLAVES_LIST 
     &                                    )
      IMPLICIT NONE
       INTEGER, intent(in) :: inode, n, size_slaves_list, slavef, 
     &                        keep(500)
       INTEGER, intent(in) :: step(n), DAD (keep(28)), icntl(60),
     &                        procnode_steps(keep(28)), cand(slavef+1),
     &                        fils(n)
       INTEGER, intent(out)   :: nbsplit, numorg_split
       INTEGER, intent(inout) :: slaves_list(size_slaves_list),
     &                           copy_cand(slavef+1)
       INTEGER :: in, lp, ii
       INTEGER  mumps_typesplit
       EXTERNAL mumps_typesplit
       lp = icntl(1) 
       in = inode
       nbsplit = 0
       numorg_split = 0    
       DO WHILE 
     &      (
     &        ( mumps_typesplit 
     &           (procnode_steps(step(dad(step(in)))),keep(199))
     &           .EQ.5 
     &        ) 
     &        .OR.
     &        ( mumps_typesplit 
     &           (procnode_steps(step(dad(step(in)))),keep(199))
     &           .EQ.6  
     &        ) 
     &      )  
           nbsplit = nbsplit + 1
           in = dad(step(in))
           ii = in
           DO WHILE (ii.GT.0)
             numorg_split = numorg_split + 1
             ii = fils(ii)
           ENDDO
       END DO
      slaves_list(1:nbsplit) = cand(1:nbsplit)
      copy_cand(1:size_slaves_list-nbsplit) = 
     &                   cand(1+nbsplit:size_slaves_list)
      copy_cand(size_slaves_list-nbsplit+1:slavef) = -1
      copy_cand(slavef+1) = size_slaves_list-nbsplit
      RETURN
      END SUBROUTINE cmumps_split_prep_partition
      SUBROUTINE cmumps_split_post_partition ( 
     &      INODE, STEP, N, SLAVEF, NBSPLIT, NCB, 
     &      PROCNODE_STEPS, KEEP, DAD, FILS, ICNTL,
     &      TAB_POS, NSLAVES_NODE
     &                                    )
      IMPLICIT NONE
       INTEGER, intent(in) :: inode, n, slavef, ncb, 
     &                        keep(500), nbsplit
       INTEGER, intent(in) :: step(n), dad (keep(28)), icntl(60),
     &                        procnode_steps(keep(28)), 
     &                        fils(n)
       INTEGER, intent(inout) :: tab_pos ( slavef+2 ), nslaves_node
       INTEGER :: in, lp, ii, numorg, nbsplit_loc, i
       INTEGER  mumps_typesplit
       EXTERNAL mumps_typesplit
       do i= nslaves_node+1, 1, -1
          tab_pos(i+nbsplit) = tab_pos(i) 
       END DO
       lp = icntl(1) 
       in = inode
       nbsplit_loc = 0
       numorg = 0
       tab_pos(1) = 1
       DO WHILE 
     &      (
     &        ( mumps_typesplit 
     &           (procnode_steps(step(dad(step(in)))),keep(199))
     &           .EQ.5 
     &        ) 
     &        .OR.
     &        ( mumps_typesplit 
     &           (procnode_steps(step(dad(step(in)))),keep(199))
     &           .EQ.6  
     &        ) 
     &      )  
           nbsplit_loc = nbsplit_loc + 1
           in = dad(step(in))
           ii = in
           DO WHILE (ii.GT.0)
             numorg = numorg + 1
             ii = fils(ii)
           ENDDO
           tab_pos(nbsplit_loc+1) = numorg + 1
       END DO
       DO i = nbsplit+2, nbsplit+nslaves_node+1
         tab_pos(i) = tab_pos(i) + numorg
       ENDDO
      nslaves_node = nslaves_node + nbsplit
      tab_pos(nslaves_node+2:slavef+1) = -9999
      tab_pos( slavef+2 ) =  nslaves_node
      RETURN
      END SUBROUTINE cmumps_split_post_partition
      SUBROUTINE cmumps_split_propagate_parti (
     &      INODE, TYPESPLIT, IFSON, 
     &      CAND, SIZE_CAND,
     &      SON_SLAVE_LIST, NSLSON,
     &      STEP, N, SLAVEF, 
     &      PROCNODE_STEPS, KEEP, DAD, FILS, ICNTL,
     &      ISTEP_TO_INIV2, INIV2,
     &      TAB_POS_IN_PERE, NSLAVES_NODE,
     &      SLAVES_LIST, SIZE_SLAVES_LIST
     &                                    )
      IMPLICIT NONE
       INTEGER, intent(in) :: INODE, typesplit, ifson, n, slavef, 
     &                        keep(500), 
     &                        nslson, size_slaves_list, size_cand
       INTEGER, intent(in) :: step(n), dad (keep(28)), icntl(60),
     &                        procnode_steps(keep(28)), 
     &                        fils(n), iniv2,
     &                        son_slave_list(nslson),
     &                        istep_to_iniv2(keep(71)),
     &                        cand(size_cand)
       INTEGER, intent(out)   ::  nslaves_node
       INTEGER, intent(inout) ::
     &                   tab_pos_in_pere(slavef+2,max(1,keep(56)))
       INTEGER, intent(out)   :: slaves_list (size_slaves_list)
       INTEGER :: in, lp, i, nslaves_sons,
     &            iniv2_fils, ishift
       lp = icntl(1) 
       in = inode
      iniv2_fils = istep_to_iniv2( step( ifson ))
      nslaves_sons = tab_pos_in_pere(slavef+2, iniv2_fils)
      tab_pos_in_pere(1,iniv2) = 1
      ishift  = tab_pos_in_pere(2, iniv2_fils) -1 
      DO i = 2, nslaves_sons
         tab_pos_in_pere(i,iniv2) = 
     &            tab_pos_in_pere(i+1,iniv2_fils) - ishift
         slaves_list(i-1) =  son_slave_list(i)
      END DO
      tab_pos_in_pere(nslaves_sons+1:slavef+1,iniv2) = -9999
      nslaves_node = nslaves_sons - 1
      tab_pos_in_pere(slavef+2, iniv2) = nslaves_node
      RETURN
      END SUBROUTINE cmumps_split_propagate_parti 
      SUBROUTINE cmumps_load_set_partition(
     &  NCBSON_MAX, SLAVEF,
     &  KEEP,KEEP8,ICNTL,
     &  CAND_OF_NODE,
     &  MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE,
     &  TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST,INODE
     &)
       IMPLICIT NONE
      INTEGER, intent(in) :: keep(500),size_slaves_list
      INTEGER(8) keep8(150)
      INTEGER, intent(in) :: icntl(60)
      INTEGER, intent(in) :: slavef, nfront
      INTEGER, intent (inout) ::ncb   
      INTEGER, intent(in) :: cand_of_node(slavef+1)
      INTEGER, intent(in) :: mem_distrib(0:slavef-1),inode
      INTEGER, intent(in) :: ncbson_max
      INTEGER, intent(out):: slaves_list(size_slaves_list)
      INTEGER, intent(out):: tab_pos(slavef+2)
      INTEGER, intent(out):: nslaves_node
      INTEGER i
      INTEGER lp,mp
      INTEGER(8) dummy1
      INTEGER dummy2
      INTEGER tmp_array(2)
      lp=icntl(4)
      mp=icntl(2)
      IF ( keep(48) == 0 .OR. keep(48) .EQ. 3 ) THEN
         CALL cmumps_load_parti_regular(
     &        slavef,
     &        keep,keep8,
     &        cand_of_node,
     &        mem_distrib, ncb, nfront, nslaves_node,
     &        tab_pos, slaves_list, size_slaves_list)
      ELSE IF ( keep(48) == 4 ) THEN
         CALL cmumps_set_parti_actv_mem(
     &        slavef,
     &        keep,keep8,
     &        cand_of_node,
     &        mem_distrib, ncb, nfront, nslaves_node,
     &        tab_pos, slaves_list, size_slaves_list,myid)
         DO i=1,nslaves_node
            IF(tab_pos(i+1)-tab_pos(i).LE.0)THEN
               WRITE(*,*)'probleme de partition dans 
     &CMUMPS_LOAD_SET_PARTI_ACTV_MEM'
               CALL mumps_abort()
            ENDIF
         ENDDO
      ELSE IF ( keep(48) == 5 ) THEN
         IF (keep(375).EQ.1) THEN 
           GOTO 458
         ENDIF
         CALL cmumps_set_parti_flop_irr(
     &        ncbson_max,
     &        slavef,
     &        keep,keep8,
     &        cand_of_node,
     &        mem_distrib, ncb, nfront, nslaves_node,
     &        tab_pos, slaves_list, size_slaves_list,myid,inode,
     &        mp,lp)
         DO i=1,nslaves_node
            IF(tab_pos(i+1)-tab_pos(i).LE.0)THEN
               WRITE(*,*)'problem with partition in
     &CMUMPS_SET_PARTI_FLOP_IRR'
               CALL mumps_abort()
            ENDIF
         ENDDO
         GOTO 457
 458     CONTINUE
         IF ( keep(375).EQ.1 )THEN 
           tmp_array(1)=0
           tmp_array(2)=0
         ENDIF
         CALL mumps_set_parti_regular(
     &        slavef,
     &        keep,keep8,
     &        cand_of_node,
     &        mem_distrib, ncb, nfront, nslaves_node,
     &        tab_pos, slaves_list, size_slaves_list,myid,inode,
     &        tab_maxs,tmp_array,dummy1,dummy2
     &        )
      ELSE
        WRITE(*,*) "Strategy 6 not implemented"
        CALL mumps_abort()
      ENDIF
 457  CONTINUE
      RETURN
      END SUBROUTINE cmumps_load_set_partition
      SUBROUTINE cmumps_load_parti_regular(
     &  SLAVEF,
     &  KEEP,KEEP8,
     &  CAND_OF_NODE,
     &  MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE,
     &  TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST)
      IMPLICIT NONE
      INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST
      INTEGER(8) KEEP8(150)
      INTEGER, intent(in) :: SLAVEF, NFRONT, NCB
      INTEGER, intent(in) :: CAND_OF_NODE(SLAVEF+1)
      INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1)
      INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
      INTEGER, intent(out):: TAB_POS(SLAVEF+2)
      INTEGER, intent(out):: NSLAVES_NODE
      INTEGER ITEMP, NMB_OF_CAND, NSLAVES_LESS
      DOUBLE PRECISION MSG_SIZE
      LOGICAL FORCE_CAND
      INTEGER  MUMPS_REG_GET_NSLAVES
      EXTERNAL MUMPS_REG_GET_NSLAVES
      IF ( KEEP(48) == 0 .AND. keep(50) .NE. 0) THEN
      write(*,*) "Internal error 2 in CMUMPS_LOAD_PARTI_REGULAR."
      CALL mumps_abort()
      END IF
      IF ( keep(48) == 3 .AND. keep(50) .EQ. 0) THEN
      write(*,*) "Internal error 3 in CMUMPS_LOAD_PARTI_REGULAR."
      CALL mumps_abort()
      END IF
      msg_size = dble( nfront - ncb ) * dble(ncb)
      IF ( keep(24) == 0 .OR. keep(24) == 1 ) THEN
        force_cand = .false.
      ELSE
        force_cand = (mod(keep(24),2).eq.0)
      END IF
      IF (force_cand) THEN
        itemp=cmumps_load_less_cand
     &       (mem_distrib,
     &        cand_of_node,
     &
     &        keep(69), slavef, msg_size,
     &        nmb_of_cand )
      ELSE
        itemp=cmumps_load_less(keep(69),mem_distrib,msg_size)
        nmb_of_cand = slavef - 1
      END IF
      nslaves_less = max(itemp,1)
      nslaves_node = mumps_reg_get_nslaves(keep8(21), keep(48),
     &          keep(50),slavef,
     &          ncb, nfront, nslaves_less, nmb_of_cand,
     &          keep(375), keep(119))
      CALL mumps_bloc2_setpartition(
     &            keep,keep8, slavef,
     &            tab_pos,
     &            nslaves_node, nfront, ncb
     &             )
      IF (force_cand) THEN
        CALL cmumps_load_set_slaves_cand(mem_distrib(0),
     &       cand_of_node, slavef, nslaves_node,
     &       slaves_list)
      ELSE
        CALL cmumps_load_set_slaves(mem_distrib(0),
     &       msg_size, slaves_list, nslaves_node)
      ENDIF
      RETURN
      END SUBROUTINE cmumps_load_parti_regular
      SUBROUTINE cmumps_load_init( id, MEMORY_MD_ARG, MAXS )
      USE cmumps_buf
      USE cmumps_struc_def
      USE mumps_future_niv2
      IMPLICIT NONE
      TYPE(cmumps_struc), TARGET :: id
      INTEGER(8), intent(in) :: memory_md_arg
      INTEGER(8), intent(in) :: maxs
      INTEGER k34_loc
      INTEGER(8) :: i8size
      INTEGER allocok, ierr, ierr_mpi, i, buf_load_size
      DOUBLE PRECISION :: max_sbtr
      DOUBLE PRECISION zero
      DOUBLE PRECISION memory_sent
      PARAMETER( zero=0.0d0 )
      DOUBLE PRECISION size_dble(2) 
      INTEGER what
      INTEGER(8) memory_md, la
      call mumps_load_enable()
      step_to_niv2_load=>id%ISTEP_TO_INIV2
      cand_load=>id%CANDIDATES
      nd_load=>id%ND_STEPS
      keep_load=>id%KEEP
      keep8_load=>id%KEEP8
      fils_load=>id%FILS
      frere_load=>id%FRERE_STEPS
      dad_load=>id%DAD_STEPS
      procnode_load=>id%PROCNODE_STEPS
      step_load=>id%STEP
      ne_load=>id%NE_STEPS
      n_load=id%N
      root_current_subtree=-9999
      memory_md=memory_md_arg
      la=maxs
      max_surf_master=id%MAX_SURF_MASTER+
     & (int(id%KEEP(12),8)*int(id%MAX_SURF_MASTER,8)/int(100,8))
      comm_ld    = id%COMM_LOAD
      comm_nodes = id%COMM_NODES
      max_peak_stk = 0.0d0
      k69  = id%KEEP(69)
      IF ( id%KEEP(47) .le. 0 .OR. id%KEEP(47) .gt. 4 ) THEN
        write(*,*) "Internal error 1 in CMUMPS_LOAD_INIT"
        CALL mumps_abort()
      END IF
      chk_ld=dble(0)
      bdc_mem      = ( id%KEEP(47) >= 2 )
      bdc_pool     = ( id%KEEP(47) >= 3 )
      bdc_sbtr     = ( id%KEEP(47) >= 4 )
      bdc_m2_mem   = ( ( id%KEEP(80) == 2 .OR. id%KEEP(80) == 3 )
     &             .AND. id%KEEP(47) == 4 )
      bdc_m2_flops   = ( id%KEEP(80) == 1 
     &             .AND. id%KEEP(47) .GE. 1 )
      bdc_md       = (id%KEEP(86)==1)
      sbtr_which_m       = id%KEEP(90)
      remove_node_flag=.false.
      remove_node_flag_mem=.false.
      remove_node_cost_mem=dble(0)
      remove_node_cost=dble(0)
      IF (id%KEEP(80) .LT. 0 .OR. id%KEEP(80)>3) THEN
        WRITE(*,*) "Unimplemented KEEP(80) Strategy"
        CALL mumps_abort()
      ENDIF
      IF ((id%KEEP(80) == 2 .OR. id%KEEP(80)==3).AND. id%KEEP(47).NE.4)
     &  THEN
        WRITE(*,*) "Internal error 3 in CMUMPS_LOAD_INIT"
        CALL mumps_abort()
      END IF
      IF (id%KEEP(81) == 1 .AND. id%KEEP(47) < 2) THEN
        WRITE(*,*) "Internal error 2 in CMUMPS_LOAD_INIT"
        CALL mumps_abort()
      ENDIF
      bdc_pool_mng = ((id%KEEP(81) == 1).AND.(id%KEEP(47) >= 2))
      IF(id%KEEP(76).EQ.4)THEN
         depth_first_load=>id%DEPTH_FIRST
      ENDIF
      IF(id%KEEP(76).EQ.5)THEN
         cost_trav=>id%COST_TRAV
      ENDIF
      IF(id%KEEP(76).EQ.6)THEN
         depth_first_load=>id%DEPTH_FIRST
         depth_first_seq_load=>id%DEPTH_FIRST_SEQ
         sbtr_id_load=>id%SBTR_ID
      ENDIF
      IF (bdc_m2_mem.OR.bdc_m2_flops) THEN
         pool_niv2_size=max(1,min(id%NBSA+id%KEEP(262),id%NA(1)))
         ALLOCATE(niv2(id%NSLAVES), nb_son(id%KEEP(28)),
     &            pool_niv2(pool_niv2_size),
     &        pool_niv2_cost(pool_niv2_size),
     &            stat=allocok)
         DO i = 1, id%KEEP(28)
           nb_son(i)=id%NE_STEPS(i)
         ENDDO
         niv2=dble(0)
         IF (allocok > 0) THEN
           WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
           id%INFO(1) = -13
           id%INFO(2) = id%NSLAVES + id%KEEP(28) + 200
           RETURN
         ENDIF
      ENDIF
      k50      = id%KEEP(50)
      CALL mpi_comm_rank( comm_ld, myid, ierr_mpi )
      nprocs = id%NSLAVES
      dm_sumlu=zero
      pool_size=0
      IF(bdc_md)THEN
         IF ( allocated(md_mem) ) DEALLOCATE(md_mem)
         ALLOCATE( md_mem( 0: nprocs - 1 ), stat=allocok )
         IF ( allocok .gt. 0 ) THEN
            WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
            id%INFO(1) = -13
            id%INFO(2) = nprocs
            RETURN
         END IF
         IF ( allocated(tab_maxs) ) DEALLOCATE(tab_maxs)
         ALLOCATE( tab_maxs( 0: nprocs - 1 ), stat=allocok )
         IF ( allocok .gt. 0 ) THEN
            WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
            id%INFO(1) = -13
            id%INFO(2) = nprocs
            RETURN
         END IF
         tab_maxs=0_8
         IF ( allocated(lu_usage) ) DEALLOCATE(lu_usage)
         ALLOCATE( lu_usage( 0: nprocs - 1 ), stat=allocok )
         IF ( allocok .gt. 0 ) THEN
            WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
            id%INFO(1) = -13
            id%INFO(2) = nprocs
            RETURN
         END IF
         lu_usage=dble(0)
         md_mem=int(0,8)
      ENDIF
      IF((id%KEEP(81).EQ.2).OR.(id%KEEP(81).EQ.3))THEN
         ALLOCATE(cb_cost_mem(2*2000*id%NSLAVES), 
     &            stat=allocok)
         IF (allocok > 0) THEN
           WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
           id%INFO(1) = -13
           id%INFO(2) = id%NSLAVES 
           RETURN
         ENDIF
         cb_cost_mem=int(0,8)
         ALLOCATE(cb_cost_id(2000*3), 
     &            stat=allocok)
         IF (allocok > 0) THEN
           WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
           id%INFO(1) = -13
           id%INFO(2) = id%NSLAVES 
           RETURN
         ENDIF
         cb_cost_id=0
         pos_mem=1
         pos_id=1
      ENDIF
      ALLOCATE(future_niv2(nprocs), stat=allocok)
      IF (allocok > 0 ) THEN
         WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
         id%INFO(1) = -13
         id%INFO(2) = nprocs
         RETURN
      ENDIF
      DO i = 1, nprocs
        future_niv2(i) = id%FUTURE_NIV2(i)
        IF(bdc_md)THEN
           IF(future_niv2(i).EQ.0)THEN
              md_mem(i-1)=999999999_8
           ENDIF
        ENDIF
      ENDDO
      delta_mem=zero
      delta_load=zero
      check_mem=0_8
      IF(bdc_sbtr.OR.bdc_pool_mng)THEN
         nb_subtrees=id%NBSA_LOCAL
         IF (allocated(mem_subtree)) DEALLOCATE(mem_subtree)
         ALLOCATE(mem_subtree(id%NBSA_LOCAL),stat=allocok)
         IF (allocok > 0 ) THEN
            WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
            id%INFO(1) = -13
            id%INFO(2) = id%NBSA_LOCAL
            RETURN
         ENDIF
         DO i=1,id%NBSA_LOCAL
            mem_subtree(i)=id%MEM_SUBTREE(i)
         ENDDO
         my_first_leaf=>id%MY_FIRST_LEAF
         my_nb_leaf=>id%MY_NB_LEAF
         my_root_sbtr=>id%MY_ROOT_SBTR
         IF (allocated(sbtr_first_pos_in_pool))
     &        DEALLOCATE(sbtr_first_pos_in_pool)
         ALLOCATE(sbtr_first_pos_in_pool(id%NBSA_LOCAL),stat=allocok)
         IF (allocok > 0 ) THEN
            WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
            id%INFO(1) = -13
            id%INFO(2) = id%NBSA_LOCAL
            RETURN
         ENDIF
         inside_subtree=0
         peak_sbtr_cur_local = dble(0)
         sbtr_cur_local      = dble(0)
         IF (allocated(sbtr_peak_array)) DEALLOCATE(sbtr_peak_array)
         ALLOCATE(sbtr_peak_array(id%NBSA_LOCAL),stat=allocok)
         IF (allocok > 0 ) THEN
            WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
            id%INFO(1) = -13
            id%INFO(2) = id%NBSA_LOCAL
            RETURN
         ENDIF
         sbtr_peak_array=dble(0)
         IF (allocated(sbtr_cur_array)) DEALLOCATE(sbtr_cur_array)
         ALLOCATE(sbtr_cur_array(id%NBSA_LOCAL),stat=allocok)
         IF (allocok > 0 ) THEN
            WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
            id%INFO(1) = -13
            id%INFO(2) = id%NBSA_LOCAL
            RETURN
         ENDIF
         sbtr_cur_array=dble(0)
         indice_sbtr_array=1
         niv1_flag=0
         indice_sbtr=1
      ENDIF
      IF ( allocated(load_flops) ) DEALLOCATE( load_flops )
      ALLOCATE( load_flops( 0: nprocs - 1 ), stat=allocok )
      IF ( allocok .gt. 0 ) THEN
         WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
         id%INFO(1) = -13
         id%INFO(2) = nprocs
         RETURN
      END IF
      IF ( allocated(wload) ) DEALLOCATE( wload )
      ALLOCATE( wload( nprocs ), stat=allocok )
      IF ( allocok .gt. 0 ) THEN
         WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
         id%INFO(1) = -13
         id%INFO(2) = nprocs
         RETURN
      END IF
      IF ( allocated(idwload) ) DEALLOCATE( idwload )
      ALLOCATE( idwload( nprocs ), stat=allocok )
      IF ( allocok .gt. 0 ) THEN
         WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
         id%INFO(1) = -13
         id%INFO(2) = nprocs
         RETURN
      END IF
      IF ( bdc_mem ) THEN
        IF ( allocated(dm_mem) ) DEALLOCATE( dm_mem )
        ALLOCATE( dm_mem( 0:nprocs-1 ), stat=allocok )
        IF ( allocok .gt. 0 ) THEN
           WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
           id%INFO(1) = -13
           id%INFO(2) = nprocs
           RETURN
        END IF
      END IF
      IF ( bdc_pool ) THEN
        IF ( allocated(pool_mem) ) DEALLOCATE(pool_mem)
        ALLOCATE( pool_mem(0: nprocs -1), stat=allocok)
        IF ( allocok .gt. 0 ) THEN
           WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
           id%INFO(1) = -13
           id%INFO(2) = nprocs
           RETURN
        END IF
        pool_mem = dble(0) 
        pool_last_cost_sent = dble(0)
      END IF
      IF ( bdc_sbtr ) THEN
        IF ( allocated(sbtr_mem) ) DEALLOCATE(sbtr_mem)
        ALLOCATE( sbtr_mem(0: nprocs -1), stat=allocok)
        IF ( allocok .gt. 0 ) THEN
           WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
           id%INFO(1) = -13
           id%INFO(2) = nprocs
           RETURN
        END IF
        IF ( allocated(sbtr_cur) ) DEALLOCATE(sbtr_cur)
        ALLOCATE( sbtr_cur(0: nprocs -1), stat=allocok)
        IF ( allocok .gt. 0 ) THEN
           WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
           id%INFO(1) = -13
           id%INFO(2) = nprocs
           RETURN
        END IF
        sbtr_cur = dble(0) 
        sbtr_mem = dble(0) 
      END IF
      k34_loc=id%KEEP(34)
      CALL mumps_size_c(size_dble(1),size_dble(2),i8size)
      k35  = int(i8size)
      buf_load_size = k34_loc * 2 * ( nprocs - 1 ) +
     &                nprocs * ( k35 + k34_loc )
      IF (bdc_mem) THEN
        buf_load_size = buf_load_size + nprocs * k35
      END IF
      IF (bdc_sbtr)THEN
        buf_load_size = buf_load_size + nprocs * k35
      ENDIF
      lbuf_load_recv = (buf_load_size+k34_loc)/k34_loc
      lbuf_load_recv_bytes = lbuf_load_recv * k34_loc
      IF ( allocated(buf_load_recv) ) DEALLOCATE(buf_load_recv)
      ALLOCATE( buf_load_recv( lbuf_load_recv), stat=allocok)
      IF ( allocok > 0 ) THEN
        WRITE(*,*) 'PB allocation in CMUMPS_LOAD_INIT'
        id%INFO(1) = -13
        id%INFO(2) = lbuf_load_recv
        RETURN
      ENDIF 
      buf_load_size = buf_load_size * 20
      CALL cmumps_buf_alloc_load_buffer( buf_load_size, ierr )
      IF ( ierr .LT. 0 ) THEN
         id%INFO(1) = -13
         id%INFO(2) = buf_load_size
         RETURN
      END IF
      DO i = 0, nprocs - 1
         load_flops( i ) = zero
      END DO
      IF ( bdc_mem ) THEN
        DO i = 0, nprocs - 1
          dm_mem( i )=zero
        END DO
      ENDIF
      CALL cmumps_init_alpha_beta(id%KEEP(69))
      IF(bdc_md)THEN
         max_sbtr=0.0d0
         IF(bdc_sbtr)THEN
            DO i=1,id%NBSA_LOCAL
               max_sbtr=max(id%MEM_SUBTREE(i),max_sbtr)
            ENDDO
         ENDIF
         md_mem(myid)=memory_md
         what=8
         CALL cmumps_buf_broadcast( what,
     &        comm_ld, nprocs,
     &        future_niv2,
     &        dble(memory_md),dble(0) ,myid, id%KEEP, ierr  )
         what=9
         memory_sent = dble(la-max_surf_master)-max_sbtr
     &      - max( dble(la) * dble(3) / dble(100),
     &      dble(2) *
     &      dble(max(id%KEEP(5),id%KEEP(6))) * dble(id%KEEP(127)))
         IF (id%KEEP(12) > 25) THEN
           memory_sent = memory_sent -
     &                   dble(id%KEEP(12))*0.2d0*dble(la)/100.0d0
         ENDIF
         IF (id%KEEP(375).EQ.1) THEN  
           memory_sent=dble(la)
         ENDIF
         tab_maxs(myid)=int(memory_sent,8)
         CALL cmumps_buf_broadcast( what,
     &        comm_ld, nprocs,
     &        future_niv2,
     &        memory_sent,
     &        dble(0),myid, id%KEEP, ierr  )
      ENDIF
      RETURN
      END SUBROUTINE cmumps_load_init
      SUBROUTINE cmumps_load_update( CHECK_FLOPS,PROCESS_BANDE,
     &     INC_LOAD, KEEP,KEEP8 )
      USE cmumps_buf
      USE mumps_future_niv2
      IMPLICIT NONE
      DOUBLE PRECISION inc_load
      INTEGER keep(500)
      INTEGER(8) keep8(150)
      LOGICAL process_bande
      LOGICAL :: exit_flag
      INTEGER check_flops
      INTEGER ierr
      DOUBLE PRECISION zero, send_mem, send_load,sbtr_tmp
      PARAMETER( zero=0.0d0 )
      INTRINSIC max
      IF (.NOT. is_mumps_load_enabled) RETURN
      IF (inc_load == 0.0d0) THEN
         IF(remove_node_flag)THEN
            remove_node_flag=.false.
         ENDIF
         RETURN
      ENDIF
      IF((check_flops.NE.0).AND.
     &     (check_flops.NE.1).AND.(check_flops.NE.2))THEN
         WRITE(*,*)myid,': Bad value for CHECK_FLOPS'
         CALL mumps_abort()
      ENDIF
      IF(check_flops.EQ.1)THEN
         chk_ld=chk_ld+inc_load
      ELSE 
         IF(check_flops.EQ.2)THEN
            RETURN
         ENDIF
      ENDIF
      IF ( process_bande ) THEN
         RETURN                 
      ENDIF
      load_flops( myid ) = max( load_flops( myid ) + inc_load, zero)
      IF(bdc_m2_flops.AND.remove_node_flag)THEN
         IF(inc_load.NE.remove_node_cost)THEN
            IF(inc_load.GT.remove_node_cost)THEN
               delta_load = delta_load +
     &              (inc_load-remove_node_cost)
               GOTO 888
            ELSE
               delta_load = delta_load -
     &              (remove_node_cost-inc_load)
               GOTO 888
            ENDIF
         ENDIF
         GOTO 333
      ENDIF
      delta_load = delta_load + inc_load
 888  CONTINUE
      IF ( delta_load > min_diff .OR. delta_load < -min_diff) THEN
         send_load = delta_load
         IF (bdc_mem) THEN
           send_mem = delta_mem
         ELSE
           send_mem = zero
         END IF
         IF(bdc_sbtr)THEN
           sbtr_tmp=sbtr_cur(myid)
         ELSE
           sbtr_tmp=dble(0)
         ENDIF
 111     CONTINUE
         CALL cmumps_buf_send_update_load( bdc_sbtr,bdc_mem,
     &        bdc_md,comm_ld, nprocs,
     &        send_load,
     &        send_mem,sbtr_tmp,
     &        dm_sumlu,
     &        future_niv2,
     &        myid, keep, ierr )
         IF ( ierr == -1 )THEN
             CALL cmumps_load_recv_msgs(comm_ld)
             CALL mumps_check_comm_nodes(comm_nodes, exit_flag)
             IF (exit_flag) THEN
               GOTO 333
             ELSE
               GOTO 111
             ENDIF
         ELSE IF ( ierr .NE.0 ) THEN
             WRITE(*,*) "Internal Error in CMUMPS_LOAD_UPDATE",ierr
             CALL mumps_abort()
         ENDIF
         delta_load = zero
         IF (bdc_mem) delta_mem  = zero
      ENDIF
 333  CONTINUE
      IF(remove_node_flag)THEN
         remove_node_flag=.false.
      ENDIF
      RETURN
      END SUBROUTINE cmumps_load_update
      SUBROUTINE cmumps_load_mem_update( SSARBR,
     &           PROCESS_BANDE_ARG, MEM_VALUE, NEW_LU, INC_MEM_ARG,
     &           KEEP,KEEP8,LRLUS)
      USE cmumps_buf
      USE mumps_future_niv2
      IMPLICIT NONE
      INTEGER(8), INTENT(IN) :: mem_value, inc_mem_arg, new_lu,lrlus
      LOGICAL, INTENT(IN) :: process_bande_arg, ssarbr
      INTEGER ierr, KEEP(500)
      INTEGER(8) keep8(150)
      DOUBLE PRECISION zero, send_mem, sbtr_tmp
      PARAMETER( zero=0.0d0 )
      INTRINSIC max, abs
      INTEGER(8) :: inc_mem
      LOGICAL PROCESS_BANDE
      LOGICAL :: exit_flag
      IF (.NOT. is_mumps_load_enabled) RETURN
      process_bande=process_bande_arg
      inc_mem = inc_mem_arg
      IF ( process_bande .AND. new_lu .NE. 0_8) THEN
        WRITE(*,*) " Internal Error in CMUMPS_LOAD_MEM_UPDATE."
        WRITE(*,*) " NEW_LU must be zero if called from PROCESS_BANDE"
        CALL mumps_abort()
      ENDIF
      dm_sumlu = dm_sumlu + dble(new_lu)
      IF(keep_load(201).EQ.0)THEN
         check_mem = check_mem + inc_mem
      ELSE 
         check_mem = check_mem + inc_mem - new_lu
      ENDIF
      IF ( mem_value .NE. check_mem ) THEN
         WRITE(*,*)myid,
     &   ':Problem with increments in CMUMPS_LOAD_MEM_UPDATE',
     &   check_mem, mem_value, inc_mem,new_lu
         CALL mumps_abort()
      ENDIF
      IF (process_bande) THEN
         RETURN
      ENDIF
      IF(bdc_pool_mng) THEN
         IF(sbtr_which_m.EQ.0)THEN
            IF (ssarbr) sbtr_cur_local = sbtr_cur_local+
     &                                   dble(inc_mem-new_lu)
         ELSE
            IF (ssarbr) sbtr_cur_local = sbtr_cur_local+
     &                                   dble(inc_mem)
         ENDIF
      ENDIF
      IF ( .NOT. bdc_mem ) THEN
         RETURN
      ENDIF
      IF (bdc_sbtr .AND. ssarbr) THEN
         IF((sbtr_which_m.EQ.0).AND.(keep(201).NE.0))THEN
            sbtr_cur(myid) = sbtr_cur(myid)+dble(inc_mem-new_lu)
         ELSE
            sbtr_cur(myid) = sbtr_cur(myid)+dble(inc_mem)
         ENDIF
         sbtr_tmp = sbtr_cur(myid)
      ELSE
        sbtr_tmp=dble(0)
      ENDIF
      IF ( new_lu > 0_8 ) THEN
        inc_mem = inc_mem - new_lu
      ENDIF
      dm_mem( myid ) = dm_mem(myid) + dble(inc_mem)
      max_peak_stk=max(max_peak_stk,dm_mem(myid))
      IF(bdc_m2_mem.AND.remove_node_flag_mem)THEN
         IF(dble(inc_mem).NE.remove_node_cost_mem)THEN
            IF(dble(inc_mem).GT.remove_node_cost_mem)THEN
               delta_mem = delta_mem +
     &              (dble(inc_mem)-remove_node_cost_mem)
               GOTO 888               
            ELSE
               delta_mem = delta_mem -
     &              (remove_node_cost_mem-dble(inc_mem))
               GOTO 888
            ENDIF
         ENDIF
         GOTO 333
      ENDIF
      delta_mem = delta_mem + dble(inc_mem)
 888  CONTINUE
      IF ((keep(48).NE.5).OR.
     &     ((keep(48).EQ.5).AND.(abs(delta_mem)
     &      .GE.0.2d0*dble(lrlus))))THEN
         IF ( abs(delta_mem) > dm_thres_mem ) THEN
            send_mem = delta_mem
 111        CONTINUE
            CALL cmumps_buf_send_update_load( 
     &           bdc_sbtr,
     &           bdc_mem,bdc_md, comm_ld,
     &           nprocs,
     &           delta_load,
     &           send_mem,sbtr_tmp,
     &           dm_sumlu,
     &           future_niv2,
     &           myid, keep, ierr )
            IF ( ierr == -1 )THEN
              CALL cmumps_load_recv_msgs(comm_ld)
              CALL mumps_check_comm_nodes(comm_nodes, exit_flag)
              IF (exit_flag) THEN
                GOTO 333
              ELSE
                GOTO 111
              ENDIF
            ELSE IF ( ierr .NE. 0 ) THEN
              WRITE(*,*) "Internal Error in CMUMPS_LOAD_MEM_UPDATE",ierr
              CALL mumps_abort()
            ENDIF
            delta_load = zero
            delta_mem  = zero
         ENDIF
      ENDIF
 333  CONTINUE
      IF(remove_node_flag_mem)THEN
         remove_node_flag_mem=.false.
      ENDIF
      END SUBROUTINE cmumps_load_mem_update
      INTEGER FUNCTION cmumps_load_less( K69, MEM_DISTRIB,MSG_SIZE )
      IMPLICIT NONE
      INTEGER i, nless, k69 
      INTEGER, DIMENSION(0:NPROCS-1) :: mem_distrib
      DOUBLE PRECISION lref
      DOUBLE PRECISION msg_size
      nless = 0
      do i=1,nprocs
         idwload(i) = i - 1
      ENDDO
      wload(1:nprocs) = load_flops(0:nprocs-1)
      IF(bdc_m2_flops)THEN
         DO i=1,nprocs
            wload(i)=wload(i)+niv2(i)
         ENDDO
      ENDIF
      IF(k69 .gt. 1) THEN
         CALL cmumps_archgenwload(mem_distrib,msg_size,idwload,nprocs)
      ENDIF
      lref = load_flops(myid)
      DO i=1, nprocs
         IF (wload(i).LT.lref) nless=nless+1
      ENDDO
      cmumps_load_less = nless
      RETURN
      END FUNCTION cmumps_load_less
      SUBROUTINE cmumps_load_set_slaves(MEM_DISTRIB,MSG_SIZE,DEST,
     &     NSLAVES)
      IMPLICIT NONE
      INTEGER nslaves
      INTEGER dest(nslaves)
      INTEGER, DIMENSION(0:NPROCS - 1) :: mem_distrib
      INTEGER i,j,nbdest
      DOUBLE PRECISION msg_size
      IF ( nslaves.eq.nprocs-1 ) THEN
        j = myid+1
        DO i=1,nslaves
           j=j+1
           IF (j.GT.nprocs) j=1
           dest(i) = j - 1
        ENDDO
      ELSE
        DO i=1,nprocs
           idwload(i) = i - 1
        ENDDO
        CALL mumps_sort_doubles(nprocs, wload, idwload)
         nbdest = 0
         DO i=1, nslaves
            j = idwload(i)
            IF (j.NE.myid) THEN
               nbdest = nbdest+1
               dest(nbdest) = j
            ENDIF
         ENDDO
         IF (nbdest.NE.nslaves) THEN
            dest(nslaves) = idwload(nslaves+1)
         ENDIF
         IF(bdc_md)THEN
            j=nslaves+1
            do i=nslaves+1,nprocs
               IF(idwload(i).NE.myid)THEN
                  dest(j)= idwload(i)
                  j=j+1
               ENDIF
            end do
         ENDIF
      ENDIF
      RETURN
      END SUBROUTINE cmumps_load_set_slaves
      SUBROUTINE cmumps_load_end( INFO1, NSLAVES, IERR )
      USE cmumps_buf
      USE mumps_future_niv2
      IMPLICIT NONE
      INTEGER, INTENT(IN)  :: INFO1
      INTEGER, INTENT(IN)  :: nslaves
      INTEGER, INTENT(OUT) :: ierr
      INTEGER :: dummy_communicator
      ierr=0
      dummy_communicator = -999 
      CALL cmumps_clean_pending( info1, keep_load(1), buf_load_recv(1),
     &     lbuf_load_recv,
     &     lbuf_load_recv_bytes, dummy_communicator, comm_ld,
     &     nslaves,
     &     .false.,  
     &     .true.    
     &     )
      DEALLOCATE( load_flops )
      DEALLOCATE( wload )
      DEALLOCATE( idwload )
      DEALLOCATE(future_niv2)
      IF(bdc_md)THEN
         DEALLOCATE(md_mem)
         DEALLOCATE(lu_usage)
         DEALLOCATE(tab_maxs)
      ENDIF
      IF ( bdc_mem ) DEALLOCATE( dm_mem )
      IF ( bdc_pool) DEALLOCATE( pool_mem )
      IF ( bdc_sbtr) THEN
         DEALLOCATE( sbtr_mem )
         DEALLOCATE( sbtr_cur )
         DEALLOCATE(sbtr_first_pos_in_pool)
         NULLIFY(my_first_leaf)
         NULLIFY(my_nb_leaf)
         NULLIFY(my_root_sbtr)
      ENDIF
      IF(keep_load(76).EQ.4)THEN
         NULLIFY(depth_first_load)
      ENDIF
      IF(keep_load(76).EQ.5)THEN
         NULLIFY(cost_trav)
      ENDIF
      IF((keep_load(76).EQ.4).OR.(keep_load(76).EQ.6))THEN
         NULLIFY(depth_first_load)
         NULLIFY(depth_first_seq_load)
         NULLIFY(sbtr_id_load)
      ENDIF
      IF (bdc_m2_mem.OR.bdc_m2_flops) THEN
        DEALLOCATE(nb_son,pool_niv2,pool_niv2_cost, niv2)
      END IF
      IF((keep_load(81).EQ.2).OR.(keep_load(81).EQ.3))THEN
         DEALLOCATE(cb_cost_mem)
         DEALLOCATE(cb_cost_id)
      ENDIF
      NULLIFY(nd_load)
      NULLIFY(keep_load)
      NULLIFY(keep8_load)
      NULLIFY(fils_load)
      NULLIFY(frere_load)
      NULLIFY(procnode_load)
      NULLIFY(step_load)
      NULLIFY(ne_load)
      NULLIFY(cand_load)
      NULLIFY(step_to_niv2_load)
      NULLIFY(dad_load)
      IF (bdc_sbtr.OR.bdc_pool_mng) THEN
         DEALLOCATE(mem_subtree)
         DEALLOCATE(sbtr_peak_array)
         DEALLOCATE(sbtr_cur_array)
      ENDIF
      CALL cmumps_buf_deall_load_buffer( ierr )
      DEALLOCATE(buf_load_recv)
      RETURN
      END SUBROUTINE cmumps_load_end
      RECURSIVE SUBROUTINE cmumps_load_recv_msgs(COMM)
      IMPLICIT NONE
      include 'mpif.h'
      include 'mumps_tags.h'
      INTEGER msgtag, msglen, msgsou,comm
      INTEGER ierr_mpi
      INTEGER :: status(mpi_status_size)
      LOGICAL flag
 10   CONTINUE
      CALL mpi_iprobe( mpi_any_source, mpi_any_tag, comm,
     &     flag, status, ierr_mpi )
      IF (flag) THEN
        keep_load(65)=keep_load(65)+1
        keep_load(267)=keep_load(267)-1
        msgtag = status( mpi_tag )
        msgsou = status( mpi_source )
        IF ( msgtag .NE. update_load) THEN
          write(*,*) "Internal error 1 in CMUMPS_LOAD_RECV_MSGS",
     &    msgtag
          CALL mumps_abort()
        ENDIF
        CALL mpi_get_count(status, mpi_packed, msglen, ierr_mpi)
        IF ( msglen > lbuf_load_recv_bytes ) THEN
          write(*,*) "Internal error 2 in CMUMPS_LOAD_RECV_MSGS",
     &    msglen, lbuf_load_recv_bytes
          CALL mumps_abort()
        ENDIF
        CALL mpi_recv( buf_load_recv, lbuf_load_recv_bytes,
     &    mpi_packed, msgsou, msgtag, comm_ld, status, ierr_mpi)
        CALL cmumps_load_process_message( msgsou, buf_load_recv,
     &  lbuf_load_recv, lbuf_load_recv_bytes )
        GOTO 10
      ENDIF
      RETURN
      END SUBROUTINE cmumps_load_recv_msgs
      RECURSIVE SUBROUTINE cmumps_load_process_message
     &   ( msgsou, bufr, lbufr, lbufr_bytes )
      USE mumps_future_niv2
      IMPLICIT NONE
      INTEGER msgsou, lbufr, lbufr_bytes
      INTEGER bufr( lbufr )
      include 'mpif.h'
      INTEGER position, what, nslaves, i
      INTEGER ierr_mpi
      DOUBLE PRECISION load_received
      INTEGER inode_received,ncb_received
      DOUBLE PRECISION surf
      INTEGER, POINTER, DIMENSION (:) :: list_slaves
      DOUBLE PRECISION, POINTER, DIMENSION (:) :: load_incr
      EXTERNAL mumps_typenode
      INTEGER mumps_typenode
      position = 0
      CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     what, 1, mpi_integer,
     &     comm_ld, ierr_mpi )
      IF ( what == 0 ) THEN
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     load_received, 1,
     &     mpi_double_precision,
     &     comm_ld, ierr_mpi )
      load_flops( msgsou ) = load_flops(msgsou) + load_received
        IF ( bdc_mem ) THEN
          CALL mpi_unpack( bufr, lbufr_bytes, position,
     &       load_received, 1, mpi_double_precision,
     &       comm_ld, ierr_mpi )
          dm_mem(msgsou)  = dm_mem(msgsou) + load_received
          max_peak_stk=max(max_peak_stk,dm_mem(msgsou))
        END IF
        IF(bdc_sbtr)THEN
          CALL mpi_unpack( bufr, lbufr_bytes, position,
     &       load_received, 1, mpi_double_precision,
     &       comm_ld, ierr_mpi )
          sbtr_cur(msgsou)=load_received
        ENDIF
        IF(bdc_md)THEN
           CALL mpi_unpack( bufr, lbufr_bytes, position,
     &          load_received, 1, mpi_double_precision,
     &          comm_ld, ierr_mpi )
           IF(keep_load(201).EQ.0)THEN
              lu_usage(msgsou)=load_received
           ENDIF
        ENDIF
      ELSEIF (( what == 1).OR.(what.EQ.19)) THEN
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     nslaves, 1, mpi_integer,
     &     comm_ld, ierr_mpi )
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     inode_received, 1, mpi_integer,
     &     comm_ld, ierr_mpi )
        list_slaves => idwload
        load_incr => wload
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     list_slaves(1), nslaves, mpi_integer,
     &     comm_ld, ierr_mpi)
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     load_incr(1), nslaves, mpi_double_precision,
     &     comm_ld, ierr_mpi)
        DO i = 1, nslaves
            load_flops(list_slaves(i)) =
     &      load_flops(list_slaves(i)) + 
     &      load_incr(i)
        END DO
        IF ( bdc_mem ) THEN
          CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     load_incr(1), nslaves, mpi_double_precision,
     &     comm_ld, ierr_mpi)
          DO i = 1, nslaves
              dm_mem(list_slaves(i)) = dm_mem(list_slaves(i)) + 
     &        load_incr(i)
              max_peak_stk=max(max_peak_stk,dm_mem(list_slaves(i)))
          END DO
        END IF
        IF(what.EQ.19)THEN
           CALL mpi_unpack( bufr, lbufr_bytes, position,
     &          load_incr(1), nslaves, mpi_double_precision,
     &          comm_ld, ierr_mpi)
           CALL cmumps_load_clean_meminfo_pool(inode_received)
           cb_cost_id(pos_id)=inode_received
           cb_cost_id(pos_id+1)=nslaves
           cb_cost_id(pos_id+2)=pos_mem
           pos_id=pos_id+3
           DO i=1,nslaves
              WRITE(*,*)myid,':',list_slaves(i),'->',load_incr(i)
              cb_cost_mem(pos_mem)=int(list_slaves(i),8)
              pos_mem=pos_mem+1
              cb_cost_mem(pos_mem)=int(load_incr(i),8)
              pos_mem=pos_mem+1
           ENDDO
        ENDIF
        NULLIFY( list_slaves )
        NULLIFY( load_incr )
      ELSE IF (what == 2 ) THEN
         IF ( .not. bdc_pool ) THEN
          WRITE(*,*) "Internal error 2 in CMUMPS_LOAD_PROCESS_MESSAGE"
          CALL mumps_abort()
        END IF
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     load_received, 1,
     &     mpi_double_precision,
     &     comm_ld, ierr_mpi )
        pool_mem(msgsou)=load_received
      ELSE IF ( what == 3 ) THEN
         IF ( .NOT. bdc_sbtr) THEN
          WRITE(*,*) "Internal error 3 in CMUMPS_LOAD_PROCESS_MESSAGE"
          CALL mumps_abort()
        ENDIF
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     load_received, 1,
     &     mpi_double_precision,
     &     comm_ld, ierr_mpi )
        sbtr_mem(msgsou)=sbtr_mem(msgsou)+load_received
      ELSE IF (what == 4) THEN
        future_niv2(msgsou+1)=0
        IF(bdc_md)THEN
           CALL mpi_unpack( bufr, lbufr_bytes, position,
     &          surf, 1, mpi_double_precision,
     &          comm_ld, ierr_mpi )
          md_mem(msgsou)=999999999_8
          tab_maxs(msgsou)=tab_maxs(msgsou)+int(surf,8)
        ENDIF
        IF(bdc_m2_mem.OR.bdc_m2_flops)THEN
        ENDIF
      ELSE IF (what == 5) THEN
         IF((.NOT.bdc_m2_mem).AND.(.NOT.bdc_m2_flops))THEN
            WRITE(*,*) "Internal error 7 in CMUMPS_LOAD_PROCESS_MESSAGE"
            CALL mumps_abort()
         ENDIF
         CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     inode_received, 1,
     &     mpi_integer,
     &     comm_ld, ierr_mpi )
         IF(bdc_m2_mem) THEN
            CALL cmumps_process_niv2_mem_msg(inode_received)
         ELSEIF(bdc_m2_flops) THEN
            CALL cmumps_process_niv2_flops_msg(inode_received)
         ENDIF
         IF((keep_load(81).EQ.2).OR.(keep_load(81).EQ.3))THEN
            CALL mpi_unpack( bufr, lbufr_bytes, position,
     &           inode_received, 1,
     &           mpi_integer,
     &           comm_ld, ierr_mpi )   
               CALL mpi_unpack( bufr, lbufr_bytes, position,
     &              ncb_received, 1,
     &              mpi_integer,
     &              comm_ld, ierr_mpi )   
            IF(
     &          mumps_typenode(procnode_load(step_load(inode_received)),
     &                         keep_load(199)).EQ.1
     &        )THEN
               cb_cost_id(pos_id)=inode_received
               cb_cost_id(pos_id+1)=1
               cb_cost_id(pos_id+2)=pos_mem
               pos_id=pos_id+3
               cb_cost_mem(pos_mem)=int(msgsou,8)
               pos_mem=pos_mem+1
               cb_cost_mem(pos_mem)=int(ncb_received,8)*
     &              int(ncb_received,8)
               pos_mem=pos_mem+1
            ENDIF
         ENDIF
      ELSE IF ( what == 6 ) THEN
         IF((.NOT.bdc_m2_mem).AND.(.NOT.bdc_m2_flops))THEN
            WRITE(*,*) "Internal error 8 in CMUMPS_LOAD_PROCESS_MESSAGE"
            CALL mumps_abort()
         ENDIF
         CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     load_received, 1,
     &     mpi_double_precision,
     &     comm_ld, ierr_mpi )
         IF(bdc_m2_mem) THEN
            niv2(msgsou+1) = load_received
         ELSEIF(bdc_m2_flops) THEN
            niv2(msgsou+1) = niv2(msgsou+1) + load_received
            IF(niv2(msgsou+1).LT.0.0d0)THEN
               IF(abs(niv2(msgsou+1)) .LE. 1.0d-3) THEN
                  niv2(msgsou+1)=0.0d0
               ELSE
                  WRITE(*,*)'problem with NIV2_FLOPS message',
     &                 niv2(msgsou+1),msgsou,load_received
                  CALL mumps_abort()
               ENDIF
            ENDIF
         ENDIF
      ELSEIF(what == 17)THEN
         CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     load_received, 1,
     &     mpi_double_precision,
     &     comm_ld, ierr_mpi )
         IF(bdc_m2_mem) THEN
            niv2(msgsou+1) = load_received
            CALL mpi_unpack( bufr, lbufr_bytes, position,
     &           load_received, 1,
     &           mpi_double_precision,
     &           comm_ld, ierr_mpi )
            IF(bdc_md)THEN
               dm_mem(myid)=dm_mem(myid)+load_received
            ELSEIF(bdc_pool)THEN
               pool_mem(msgsou)=load_received
            ENDIF
         ELSEIF(bdc_m2_flops) THEN
            niv2(msgsou+1) = niv2(msgsou+1) + load_received            
            IF(niv2(msgsou+1).LT.0.0d0)THEN
               IF(abs(niv2(msgsou+1)) .LE. 1.0d-3) THEN
                  niv2(msgsou+1)=0.0d0
               ELSE
                  WRITE(*,*)'problem with NIV2_FLOPS message',
     &                 niv2(msgsou+1),msgsou,load_received
                  CALL mumps_abort()
               ENDIF
            ENDIF
            CALL mpi_unpack( bufr, lbufr_bytes, position,
     &           load_received, 1,
     &           mpi_double_precision,
     &           comm_ld, ierr_mpi )
            load_flops( msgsou ) = load_flops(msgsou) + load_received
         ENDIF
      ELSEIF ( what == 7 ) THEN
         IF(.NOT.bdc_md)THEN
            WRITE(*,*)myid,': Internal error 4
     &in CMUMPS_LOAD_PROCESS_MESSAGE'
            CALL mumps_abort()
         ENDIF
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     nslaves, 1, mpi_integer,
     &     comm_ld, ierr_mpi )
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     inode_received, 1, mpi_integer,
     &     comm_ld, ierr_mpi )
        list_slaves => idwload
        load_incr => wload
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     list_slaves(1), nslaves, mpi_integer,
     &     comm_ld, ierr_mpi )
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     load_incr(1), nslaves, mpi_double_precision,
     &     comm_ld, ierr_mpi )
        DO i = 1, nslaves
            md_mem(list_slaves(i)) =
     &      md_mem(list_slaves(i)) + 
     &      int(load_incr(i),8)
            IF(future_niv2(list_slaves(i)+1).EQ.0)THEN
               md_mem(list_slaves(i))=999999999_8
            ENDIF
        END DO
      ELSEIF ( what == 8 ) THEN
         IF(.NOT.bdc_md)THEN
            WRITE(*,*)myid,': Internal error 5
     &in CMUMPS_LOAD_PROCESS_MESSAGE'
            CALL mumps_abort()
         ENDIF
        CALL mpi_unpack( bufr, lbufr_bytes, position,
     &     load_received, 1,
     &     mpi_double_precision,
     &     comm_ld, ierr_mpi )
        md_mem(msgsou)=md_mem(msgsou)+int(load_received,8)
        IF(future_niv2(msgsou+1).EQ.0)THEN
           md_mem(msgsou)=999999999_8
        ENDIF
      ELSEIF ( what == 9 ) THEN
         IF(.NOT.bdc_md)THEN
            WRITE(*,*)myid,': internal error 6
     &in cmumps_load_process_message'
            CALL MUMPS_ABORT()
         ENDIF
        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
     &     LOAD_RECEIVED, 1,
     &     MPI_DOUBLE_PRECISION,
     &     COMM_LD, IERR_MPI )
        TAB_MAXS(MSGSOU)=int(LOAD_RECEIVED,8)
      ELSE
          WRITE(*,*) "Internal error 1 in CMUMPS_LOAD_PROCESS_MESSAGE"
          CALL MUMPS_ABORT()
      END IF
      RETURN
      END SUBROUTINE CMUMPS_LOAD_PROCESS_MESSAGE
      integer function CMUMPS_LOAD_LESS_CAND
     &                 (MEM_DISTRIB,CAND,
     &                  K69,
     &                  SLAVEF,MSG_SIZE,
     &                  NMB_OF_CAND )
      implicit none      
      integer, intent(in) :: K69, SLAVEF
      INTEGER, intent(in) :: CAND(SLAVEF+1)
      INTEGER, DIMENSION(0:NPROCS - 1), intent(in) :: MEM_DISTRIB
      INTEGER, intent(out) :: NMB_OF_CAND
      integer i,nless
      DOUBLE PRECISION lref
      DOUBLE PRECISION MSG_SIZE
      nless = 0 
      NMB_OF_CAND=CAND(SLAVEF+1)
      do i=1,NMB_OF_CAND
         WLOAD(i)=LOAD_FLOPS(CAND(i))
         IF(BDC_M2_FLOPS)THEN
            WLOAD(i)=WLOAD(i)+NIV2(CAND(i)+1)
         ENDIF
      end do
.gt.      IF(K69  1) THEN
         CALL CMUMPS_ARCHGENWLOAD(MEM_DISTRIB,MSG_SIZE,
     &        CAND,NMB_OF_CAND)
      ENDIF
      lref = LOAD_FLOPS(MYID)
      do i=1, NMB_OF_CAND
.lt.         if (WLOAD(i)lref) nless=nless+1
      end do 
      CMUMPS_LOAD_LESS_CAND = nless
      return
      end function CMUMPS_LOAD_LESS_CAND
      subroutine CMUMPS_LOAD_SET_SLAVES_CAND
     &           (MEM_DISTRIB,CAND, 
     &
     &            SLAVEF,
     &            nslaves_inode, DEST)
      implicit none
      integer, intent(in) :: nslaves_inode, SLAVEF
      integer, intent(in) :: CAND(SLAVEF+1)
      integer, dimension(0:NPROCS - 1), intent(in) :: MEM_DISTRIB
      integer, intent(out) :: DEST(CAND(SLAVEF+1))
      integer i,j,NMB_OF_CAND
      external MUMPS_SORT_DOUBLES
      NMB_OF_CAND = CAND(SLAVEF+1)
.ge..or.      if(nslaves_inodeNPROCS 
.gt.     &     nslaves_inodeNMB_OF_CAND) then
         write(*,*)'internal error in cmumps_load_set_slaves_cand',
     &   nslaves_inode, NPROCS, NMB_OF_CAND
         CALL MUMPS_ABORT()
      end if
.eq.      if (nslaves_inodeNPROCS-1) then
         j=MYID+1
         do i=1,nslaves_inode
.ge.            if(jNPROCS) j=0
            DEST(i)=j
            j=j+1
         end do
      else
        do i=1,NMB_OF_CAND
               IDWLOAD(i)=i
        end do
        call MUMPS_SORT_DOUBLES(NMB_OF_CAND,
     &       WLOAD(1),IDWLOAD(1) )
        do i=1,nslaves_inode
           DEST(i)= CAND(IDWLOAD(i))
        end do
        IF(BDC_MD)THEN
           do i=nslaves_inode+1,NMB_OF_CAND
              DEST(i)= CAND(IDWLOAD(i))
           end do
        ENDIF
      end if   
      return
      end subroutine CMUMPS_LOAD_SET_SLAVES_CAND
      SUBROUTINE CMUMPS_INIT_ALPHA_BETA(K69)
      IMPLICIT NONE
      INTEGER K69
.LE.      IF (K69  4) THEN
         ALPHA = 0.0d0
         BETA = 0.0d0
         RETURN
      ENDIF
.EQ.      IF (K69  5) THEN
         ALPHA = 0.5d0
         BETA = 50000.0d0
         RETURN
      ENDIF
.EQ.      IF (K69  6) THEN
         ALPHA = 0.5d0
         BETA = 100000.0d0
         RETURN
      ENDIF
.EQ.      IF (K69  7) THEN
         ALPHA = 0.5d0
         BETA = 150000.0d0
         RETURN
      ENDIF
.EQ.      IF (K69  8) THEN
         ALPHA = 1.0d0
         BETA = 50000.0d0
         RETURN
      ENDIF
.EQ.      IF (K69  9) THEN
         ALPHA = 1.0d0
         BETA = 100000.0d0
         RETURN
      ENDIF
.EQ.      IF (K69  10) THEN
         ALPHA = 1.0d0
         BETA = 150000.0d0
         RETURN
      ENDIF
.EQ.      IF (K69  11) THEN
         ALPHA = 1.5d0
         BETA = 50000.0d0
         RETURN
      ENDIF
.EQ.      IF (K69  12) THEN
         ALPHA = 1.5d0
         BETA = 100000.0d0
         RETURN
      ENDIF
      ALPHA = 1.5d0
      BETA = 150000.0d0
      RETURN
      END SUBROUTINE CMUMPS_INIT_ALPHA_BETA
      SUBROUTINE CMUMPS_ARCHGENWLOAD(MEM_DISTRIB,MSG_SIZE,ARRAY_ADM,LEN)
      IMPLICIT NONE
      INTEGER i,LEN
      INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB
      DOUBLE PRECISION MSG_SIZE,FORBIGMSG
      INTEGER ARRAY_ADM(LEN)
      DOUBLE PRECISION MY_LOAD
      FORBIGMSG = 1.0d0
.lt.      IF (K69 2) THEN
         RETURN
      ENDIF
      IF(BDC_M2_FLOPS)THEN
         MY_LOAD=LOAD_FLOPS(MYID)+NIV2(MYID+1)
      ELSE
         MY_LOAD=LOAD_FLOPS(MYID)
      ENDIF
.gt.      IF((MSG_SIZE * dble(K35) )  3200000.0d0) THEN
         FORBIGMSG = 2.0d0
      ENDIF
.le.      IF (K69  4) THEN
         DO i = 1,LEN
.EQ..AND.            IF ((MEM_DISTRIB(ARRAY_ADM(i))  1) 
.LT.     &      WLOAD(i)  MY_LOAD ) THEN
               WLOAD(i) = WLOAD(i)/MY_LOAD
            ELSE
.NE.              IF ( MEM_DISTRIB(ARRAY_ADM(i))  1 ) THEN
                WLOAD(i) = WLOAD(i) *
     &              dble(MEM_DISTRIB(ARRAY_ADM(i)))
     &              * FORBIGMSG
     &              + dble(2)
              ENDIF
            ENDIF
         ENDDO
         RETURN
      ENDIF
      DO i = 1,LEN
.EQ..AND.         IF ((MEM_DISTRIB(ARRAY_ADM(i))  1) 
.LT.     &        WLOAD(i)  MY_LOAD ) THEN
            WLOAD(i) = WLOAD(i) /  MY_LOAD
         ELSE
.NE.            IF(MEM_DISTRIB(ARRAY_ADM(i))  1) THEN     
               WLOAD(i) = (WLOAD(i) +
     &              ALPHA * MSG_SIZE * dble(K35)  +
     &              BETA) * FORBIGMSG
            ENDIF
         ENDIF
      ENDDO  
      RETURN
      END SUBROUTINE CMUMPS_ARCHGENWLOAD
      SUBROUTINE CMUMPS_LOAD_MASTER_2_ALL(MYID, SLAVEF, COMM,
     &     TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, NSLAVES,INODE)
      USE CMUMPS_BUF
      USE MUMPS_FUTURE_NIV2
      IMPLICIT NONE
      INTEGER, INTENT (IN) :: MYID, SLAVEF, COMM, NASS, NSLAVES
      INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2)
      INTEGER, INTENT (IN) :: LIST_SLAVES( NSLAVES )
      INTEGER KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER NCB, NFRONT, NBROWS_SLAVE
      INTEGER i, IERR,WHAT,INODE, allocok
      LOGICAL :: EXIT_FLAG
      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: MEM_INCREMENT
      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: FLOPS_INCREMENT
      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: CB_BAND
      ALLOCATE(MEM_INCREMENT(NSLAVES), stat=allocok)
.ne.      if(allocok0) then
         WRITE(6,*) ' allocation error of mem_increment '
     &        //  'in routine cmumps_load_master_2_all'
         CALL MUMPS_ABORT()
      endif
      ALLOCATE(FLOPS_INCREMENT(NSLAVES), stat=allocok)
.ne.      if(allocok0) then
         WRITE(6,*) ' allocation error of flops_increment '
     &        //    'in routine cmumps_load_master_2_all'
         CALL MUMPS_ABORT()
      endif
      ALLOCATE(CB_BAND(NSLAVES), stat=allocok)
.ne.      if(allocok0) then
         WRITE(6,*) ' allocation error of cb_band '
     &        //    'in routine cmumps_load_master_2_all'
         CALL MUMPS_ABORT()
      endif
.NE..AND..NE.      IF((KEEP(81)2)(KEEP(81)3))THEN
         WHAT=1
      ELSE
         WHAT=19
      ENDIF
      FUTURE_NIV2(MYID+1) = FUTURE_NIV2(MYID+1) - 1
      IF ( FUTURE_NIV2(MYID+1) < 0 ) THEN
        WRITE(*,*) "Internal error in CMUMPS_LOAD_MASTER_2_ALL"
        CALL MUMPS_ABORT()
      ENDIF
      IF ( FUTURE_NIV2(MYID + 1) == 0 ) THEN
 112    CONTINUE
        CALL CMUMPS_BUF_SEND_NOT_MSTR(COMM,MYID,SLAVEF,
     &       dble(MAX_SURF_MASTER),KEEP,IERR)
        IF (IERR == -1 ) THEN
          CALL CMUMPS_LOAD_RECV_MSGS(COMM_LD)
          CALL MUMPS_CHECK_COMM_NODES(COMM_NODES, EXIT_FLAG)
          IF (EXIT_FLAG) THEN
             GOTO 100 
          ELSE
             GOTO 112
          ENDIF
.NE.       ELSE IF ( IERR  0 ) THEN
          WRITE(*,*) "Internal Error in CMUMPS_LOAD_MASTER_2_ALL",
     &    IERR
          CALL MUMPS_ABORT()
        ENDIF
      TAB_MAXS(MYID) = TAB_MAXS(MYID) + int(MAX_SURF_MASTER,8)
      ENDIF
      IF ( NSLAVES /= TAB_POS(SLAVEF + 2) ) THEN
        write(*,*) "Error 1 in CMUMPS_LOAD_MASTER_2_ALL",
     &             NSLAVES, TAB_POS(SLAVEF+2)
        CALL MUMPS_ABORT()
      ENDIF
      NCB = TAB_POS(NSLAVES+1) - 1
      NFRONT = NCB + NASS
      DO i = 1, NSLAVES
         NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i)
         IF ( KEEP(50) == 0 ) THEN
            FLOPS_INCREMENT( i ) = (dble(NBROWS_SLAVE)*dble( NASS ))+
     &           dble(NBROWS_SLAVE) * dble(NASS) *
     &           dble(2*NFRONT-NASS-1)
         ELSE
            FLOPS_INCREMENT( i ) = dble(NBROWS_SLAVE) * dble(NASS ) *
     &           dble( 2 * ( NASS + TAB_POS(i+1) - 1 ) 
     &           - NBROWS_SLAVE - NASS + 1 )
         ENDIF
         IF ( BDC_MEM ) THEN
            IF ( KEEP(50) == 0 ) THEN
               MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) *
     &              dble(NFRONT)
            ELSE
               MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) *
     &              dble( NASS + TAB_POS(i+1) - 1 )
            END IF
         ENDIF
.NE..AND..NE.         IF((KEEP(81)2)(KEEP(81)3))THEN
            CB_BAND(i)=dble(-999999)
         ELSE
            IF ( KEEP(50) == 0 ) THEN
               CB_BAND( i ) = dble(NBROWS_SLAVE) *
     &              dble(NFRONT-NASS)
            ELSE
               CB_BAND( i ) = dble(NBROWS_SLAVE) *
     &              dble(TAB_POS(i+1)-1)
            END IF
         ENDIF
      END DO
.EQ..OR..EQ.      IF((KEEP(81)2)(KEEP(81)3))THEN
         CB_COST_ID(POS_ID)=INODE
         CB_COST_ID(POS_ID+1)=NSLAVES
         CB_COST_ID(POS_ID+2)=POS_MEM
         POS_ID=POS_ID+3
         DO i=1,NSLAVES
            CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8)
            POS_MEM=POS_MEM+1
            CB_COST_MEM(POS_MEM)=int(CB_BAND(i),8)
            POS_MEM=POS_MEM+1
         ENDDO
      ENDIF
 111  CONTINUE
      CALL CMUMPS_BUF_BCAST_ARRAY(BDC_MEM, COMM, MYID, SLAVEF,
     &     FUTURE_NIV2,
     &     NSLAVES, LIST_SLAVES,INODE,
     &     MEM_INCREMENT,
     &     FLOPS_INCREMENT,CB_BAND, WHAT, KEEP, IERR)
        IF ( IERR == -1 ) THEN
          CALL CMUMPS_LOAD_RECV_MSGS(COMM_LD)
          CALL MUMPS_CHECK_COMM_NODES(COMM_NODES, EXIT_FLAG)
          IF (EXIT_FLAG) THEN
             GOTO 100
           ELSE
             GOTO 111
           ENDIF
.NE.       ELSE IF ( IERR  0 ) THEN
          WRITE(*,*) "Internal Error in CMUMPS_LOAD_MASTER_2_ALL",
     &    IERR
          CALL MUMPS_ABORT()
        ENDIF
.NE.      IF (FUTURE_NIV2(MYID+1)  0) THEN
        DO i = 1, NSLAVES
          LOAD_FLOPS(LIST_SLAVES(i)) = LOAD_FLOPS(LIST_SLAVES(i))
     &       +  FLOPS_INCREMENT(i)
          IF ( BDC_MEM ) THEN
            DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i))
     &       +  MEM_INCREMENT(i)
          END IF
        ENDDO
      ENDIF
 100  CONTINUE
      DEALLOCATE(MEM_INCREMENT,FLOPS_INCREMENT,CB_BAND)
      RETURN
      END SUBROUTINE CMUMPS_LOAD_MASTER_2_ALL
      SUBROUTINE CMUMPS_LOAD_POOL_UPD_NEW_POOL(
     &     POOL, LPOOL,
     &     PROCNODE, KEEP,KEEP8, SLAVEF, COMM, MYID, STEP, N,
     &     ND, FILS )
      USE CMUMPS_BUF
      USE MUMPS_FUTURE_NIV2
      IMPLICIT NONE
      INTEGER LPOOL, SLAVEF, COMM, MYID 
      INTEGER N, KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER POOL( LPOOL ), PROCNODE( KEEP(28) ), STEP( N )
      INTEGER ND( KEEP(28) ), FILS( N )
      INTEGER i, INODE, NELIM, NFR, LEVEL, IERR, WHAT
      DOUBLE PRECISION COST
      LOGICAL :: EXIT_FLAG
      INTEGER NBINSUBTREE,NBTOP,INSUBTREE
      INTEGER MUMPS_TYPENODE
      EXTERNAL MUMPS_TYPENODE
      NBINSUBTREE = POOL(LPOOL)
      NBTOP       = POOL(LPOOL - 1)
      INSUBTREE   = POOL(LPOOL - 2)
      IF(BDC_MD)THEN
         RETURN
      ENDIF
.EQ..OR..EQ.      IF((KEEP(76)0)(KEEP(76)2))THEN
.NE.         IF(NBTOP0)THEN
            DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3)
               INODE = POOL( i )
.LE..AND..GE.               IF (INODE  N  INODE  1 ) THEN
                  GOTO 20
               END IF
            END DO
            COST=dble(0) 
            GOTO 30
         ELSE
            DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1
               INODE = POOL( i )
.LE..AND..GE.               IF (INODE  N  INODE  1 ) THEN
                  GOTO 20
               END IF
            END DO
            COST=dble(0) 
            GOTO 30
         ENDIF
      ELSE
.EQ.         IF(KEEP(76)1)THEN
.EQ.            IF(INSUBTREE1)THEN
               DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1
                  INODE = POOL( i )
.LE..AND..GE.                  IF (INODE  N  INODE  1 ) THEN
                     GOTO 20
                  END IF
               END DO
               COST=dble(0) 
               GOTO 30
            ELSE
               DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3)
                  INODE = POOL( i )
.LE..AND..GE.                  IF (INODE  N  INODE  1 ) THEN
                     GOTO 20
                  END IF
               END DO
               COST=dble(0) 
               GOTO 30
            ENDIF
         ELSE
            WRITE(*,*)
     &      'internal error: unknown pool management strategy'
            CALL MUMPS_ABORT()
         ENDIF
      ENDIF
 20   CONTINUE
        i = INODE
        NELIM = 0
 10     CONTINUE
        IF ( i > 0 ) THEN
          NELIM = NELIM + 1
          i = FILS(i)
          GOTO 10
        ENDIF
        NFR = ND( STEP(INODE) )
        LEVEL = MUMPS_TYPENODE( PROCNODE(STEP(INODE)), KEEP(199) )
.EQ.        IF (LEVEL  1) THEN
          COST = dble( NFR ) * dble( NFR )
        ELSE
          IF ( KEEP(50) == 0 ) THEN
            COST = dble( NFR ) * dble( NELIM )
          ELSE
            COST = dble( NELIM ) * dble( NELIM )
          ENDIF
        ENDIF
 30   CONTINUE
.GT.      IF ( abs(POOL_LAST_COST_SENT-COST)DM_THRES_MEM ) THEN
        WHAT = 2
 111    CONTINUE
        CALL CMUMPS_BUF_BROADCAST( WHAT,
     &         COMM, SLAVEF,
     &               FUTURE_NIV2,
     &         COST, dble(0), MYID, KEEP, IERR  )
        POOL_LAST_COST_SENT = COST
        POOL_MEM(MYID)=COST
        IF ( IERR == -1 )THEN
          CALL CMUMPS_LOAD_RECV_MSGS(COMM_LD)
          CALL MUMPS_CHECK_COMM_NODES(COMM_NODES, EXIT_FLAG)
          IF (EXIT_FLAG) THEN
          ELSE
             GOTO 111
          ENDIF
.NE.       ELSE IF ( IERR  0 ) THEN
          WRITE(*,*) "Internal Error in CMUMPS_LOAD_POOL_UPD_NEW_POOL",
     &    IERR
          CALL MUMPS_ABORT()
        ENDIF
      ENDIF
      RETURN
      END SUBROUTINE CMUMPS_LOAD_POOL_UPD_NEW_POOL
      SUBROUTINE CMUMPS_LOAD_SBTR_UPD_NEW_POOL(
     &     OK,INODE,POOL,LPOOL,MYID,SLAVEF,COMM,KEEP,KEEP8)
      USE CMUMPS_BUF
      USE MUMPS_FUTURE_NIV2
      IMPLICIT NONE
      INTEGER LPOOL,MYID,SLAVEF,COMM,INODE
      INTEGER POOL(LPOOL),KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER WHAT,IERR
      LOGICAL OK
      DOUBLE PRECISION COST
      LOGICAL FLAG, EXIT_FLAG
      EXTERNAL MUMPS_ROOTSSARBR,MUMPS_IN_OR_ROOT_SSARBR
      LOGICAL MUMPS_ROOTSSARBR,MUMPS_IN_OR_ROOT_SSARBR
.LE..OR..GT.      IF((INODE0)(INODEN_LOAD)) THEN
         RETURN
      ENDIF
.NOT.      IF (MUMPS_IN_OR_ROOT_SSARBR(
     &     PROCNODE_LOAD(STEP_LOAD(INODE)), KEEP(199))
     &   ) THEN
         RETURN         
      ENDIF
      IF(MUMPS_ROOTSSARBR(PROCNODE_LOAD(STEP_LOAD(INODE)),
     &         KEEP(199)))THEN
.EQ.         IF(NE_LOAD(STEP_LOAD(INODE))0)THEN
            RETURN
         ENDIF
      ENDIF
      FLAG=.FALSE.
.LE.      IF(INDICE_SBTRNB_SUBTREES)THEN
.EQ.         IF(INODEMY_FIRST_LEAF(INDICE_SBTR))THEN
            FLAG=.TRUE.
         ENDIF
      ENDIF
      IF(FLAG)THEN
         SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY)=MEM_SUBTREE(INDICE_SBTR)
         SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY)=SBTR_CUR(MYID)
         INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY+1
         WHAT = 3
.GE.         IF(dble(MEM_SUBTREE(INDICE_SBTR))DM_THRES_MEM)THEN
 111        CONTINUE
            CALL CMUMPS_BUF_BROADCAST(
     &           WHAT, COMM, SLAVEF,
     &           FUTURE_NIV2,
     &           dble(MEM_SUBTREE(INDICE_SBTR)), dble(0),
     &           MYID, KEEP, IERR  )
            IF ( IERR == -1 )THEN
               CALL CMUMPS_LOAD_RECV_MSGS(COMM_LD)
               CALL MUMPS_CHECK_COMM_NODES(COMM_NODES, EXIT_FLAG)
               IF (EXIT_FLAG) THEN
               ELSE
                  GOTO 111
               ENDIF
.NE.            ELSE IF ( IERR  0 ) THEN
               WRITE(*,*)
     &         "Internal Error 1 in CMUMPS_LOAD_SBTR_UPD_NEW_POOL",
     &         IERR
               CALL MUMPS_ABORT()
            ENDIF
         ENDIF
         SBTR_MEM(MYID)=SBTR_MEM(MYID)+
     &        dble(MEM_SUBTREE(INDICE_SBTR))
         INDICE_SBTR=INDICE_SBTR+1
.EQ.         IF(INSIDE_SUBTREE0)THEN
            INSIDE_SUBTREE=1
         ENDIF
      ELSE 
.EQ.         IF(INODEMY_ROOT_SBTR(INDICE_SBTR-1))THEN
            WHAT = 3
            COST=-SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY-1)
.GE.            IF(abs(COST)DM_THRES_MEM)THEN
 112           CONTINUE
               CALL CMUMPS_BUF_BROADCAST(
     &              WHAT, COMM, SLAVEF,
     &              FUTURE_NIV2,
     &              COST, dble(0), MYID, KEEP, IERR  )
               IF ( IERR == -1 )THEN
                  CALL CMUMPS_LOAD_RECV_MSGS(COMM_LD)
                  CALL MUMPS_CHECK_COMM_NODES(COMM_NODES, EXIT_FLAG)
                  IF (EXIT_FLAG) THEN
                  ELSE
                     GOTO 112
                  ENDIF
.NE.               ELSE IF ( IERR  0 ) THEN
                  WRITE(*,*)
     &        "Internal Error 3 in CMUMPS_LOAD_SBTR_UPD_NEW_POOL",
     &        IERR
                  CALL MUMPS_ABORT()
               ENDIF
            ENDIF
            INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY-1            
            SBTR_MEM(MYID)=SBTR_MEM(MYID)-
     &           SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY)
            SBTR_CUR(MYID)=SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY)
.EQ.            IF(INDICE_SBTR_ARRAY1)THEN
               SBTR_CUR(MYID)=dble(0)
               INSIDE_SUBTREE=0
            ENDIF
         ENDIF
         ENDIF 
      RETURN
      END SUBROUTINE CMUMPS_LOAD_SBTR_UPD_NEW_POOL
      SUBROUTINE CMUMPS_SET_PARTI_ACTV_MEM
     &      (SLAVEF,KEEP,KEEP8,PROCS,MEM_DISTRIB,NCB,NFRONT,
     &       NSLAVES_NODE,TAB_POS,
     &       SLAVES_LIST,SIZE_SLAVES_LIST,MYID)
      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, intent(in) :: MEM_DISTRIB(0:SLAVEF-1)
      INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
      INTEGER, intent(out):: TAB_POS(SLAVEF+2)
      INTEGER, intent(out):: NSLAVES_NODE
      INTEGER NUMBER_OF_PROCS,K47, K48, K50
      INTEGER(8) :: K821
      DOUBLE PRECISION DK821
      INTEGER J
      INTEGER KMIN, KMAX
      INTEGER OTHERS,CHOSEN,SMALL_SET,ACC
      DOUBLE PRECISION SOMME,TMP_SUM
      INTEGER AFFECTED
      INTEGER ADDITIONNAL_ROWS,i,X,REF,POS
      INTEGER(8)::TOTAL_MEM
      LOGICAL FORCE_CAND
      DOUBLE PRECISION TEMP(SLAVEF),PEAK
      INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF)
      EXTERNAL MPI_WTIME
      DOUBLE PRECISION MPI_WTIME
.GT.      IF (KEEP8(21)  0_8) THEN
      write(*,*)MYID,
     & ": Internal Error 1 in CMUMPS_SET_PARTI_ACTV_MEM"
      CALL MUMPS_ABORT()
      ENDIF
      K821=abs(KEEP8(21))
      DK821=dble(K821)
      K50=KEEP(50)
      K48=KEEP(48)
      K47=KEEP(47)
.OR.      IF ( KEEP(24) == 0  KEEP(24) == 1 ) THEN
        FORCE_CAND = .FALSE.
      ELSE
.eq.        FORCE_CAND = (mod(KEEP(24),2)0)
      END IF
.NE.      IF(K484)THEN
         WRITE(*,*)'cmumps_compute_parti_actv_mem_k821
     &      should be called with keep(48) different from 4'
         CALL MUMPS_ABORT()
      ENDIF
         KMIN=1
         KMAX=int(K821/int(NFRONT,8))
         IF(FORCE_CAND)THEN
            DO i=1,PROCS(SLAVEF+1)
               WLOAD(i)=DM_MEM(PROCS(i))
               IDWLOAD(i)=PROCS(i)
            ENDDO
            NUMBER_OF_PROCS=PROCS(SLAVEF+1)
            OTHERS=NUMBER_OF_PROCS
         ELSE
            NUMBER_OF_PROCS=SLAVEF
            WLOAD(1:SLAVEF) = DM_MEM(0:NUMBER_OF_PROCS-1)
            DO i=1,NUMBER_OF_PROCS
               IDWLOAD(i) = i - 1
            ENDDO
            OTHERS=NUMBER_OF_PROCS-1
         ENDIF
         NB_ROWS=0
         CALL MUMPS_SORT_DOUBLES(NUMBER_OF_PROCS, WLOAD, IDWLOAD)
         TOTAL_MEM=int(NCB,8)*int(NFRONT,8)
         SOMME=dble(0)
         J=1
         PEAK=dble(0)
         DO i=1,NUMBER_OF_PROCS
.NE.            IF((IDWLOAD(i)MYID))THEN
               PEAK=max(PEAK,WLOAD(i))
               TEMP_ID(J)=IDWLOAD(i)
               TEMP(J)=WLOAD(i)
                IF(BDC_SBTR)THEN
                   TEMP(J)=TEMP(J)+SBTR_MEM(IDWLOAD(i))-
     &                  SBTR_CUR(IDWLOAD(i))
                ENDIF
                IF(BDC_POOL)THEN
                   TEMP(J)=TEMP(J)+POOL_MEM(TEMP_ID(J))
                ENDIF
                IF(BDC_M2_MEM)THEN
                   TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1)
                ENDIF
                J=J+1
            ENDIF
         ENDDO
         NUMBER_OF_PROCS=J-1
         CALL MUMPS_SORT_DOUBLES(NUMBER_OF_PROCS, TEMP, TEMP_ID)
.EQ.         IF(K500)THEN
           PEAK=max(PEAK,
     &       DM_MEM(MYID)+dble(NFRONT)*dble(NFRONT-NCB))
         ELSE
           PEAK=max(PEAK,
     &       DM_MEM(MYID)+dble(NFRONT-NCB)*dble(NFRONT-NCB))
         ENDIF
         PEAK=max(PEAK,TEMP(OTHERS))
         SOMME=dble(0)
         DO i=1,NUMBER_OF_PROCS
           SOMME=SOMME+TEMP(OTHERS)-TEMP(i)
         ENDDO               
.LE.         IF(SOMMEdble(TOTAL_MEM)) THEN
            GOTO 096
         ENDIF
 096     CONTINUE
         SOMME=dble(0)
         DO i=1,OTHERS
            SOMME=SOMME+TEMP(OTHERS)-TEMP(i)
         ENDDO
.GE.         IF(dble(TOTAL_MEM)SOMME) THEN
            AFFECTED=0
            CHOSEN=0
            ACC=0
            DO i=1,OTHERS
.EQ.               IF(K500)THEN
.GT.                  IF((TEMP(OTHERS)-TEMP(i))DK821)THEN
                     TMP_SUM=DK821
                  ELSE
                     TMP_SUM=TEMP(OTHERS)-TEMP(i)
                  ENDIF
                  X=int(TMP_SUM/dble(NFRONT))
.GT.                  IF((ACC+X)NCB) X=NCB-ACC
               ENDIF
.NE.               IF(K500)THEN
.GT.                  IF((TEMP(OTHERS)-TEMP(i))DK821)THEN
                     TMP_SUM=DK821
                  ELSE
                     TMP_SUM=TEMP(OTHERS)-TEMP(i)
                  ENDIF
                  X=int((-dble(NFRONT-NCB+ACC)
     &                 +sqrt(((dble(NFRONT-NCB+ACC)*
     &                 dble(NFRONT-NCB+ACC))+dble(4)*
     &                 (TMP_SUM))))/
     &                 dble(2))
.GT.                  IF((ACC+X)NCB) X=NCB-ACC
.LE.                  IF(X0) THEN
                     WRITE(*,*)"Internal Error 2 in
     &                    CMUMPS_SET_PARTI_ACTV_MEM"
                    CALL MUMPS_ABORT()
                  ENDIF
               ENDIF
               NB_ROWS(i)=X
               CHOSEN=CHOSEN+1
               ACC=ACC+X
.LT.               IF(NCB-ACCKMIN) GOTO 111
.EQ.               IF(NCBACC) GOTO 111
               ENDDO
 111           CONTINUE
.GT.               IF((ACCNCB))THEN
                  X=0
                  DO i=1,OTHERS
                     X=X+NB_ROWS(i)
                  ENDDO
                  WRITE(*,*)'ncb=',NCB,',somme=',x
                  WRITE(*,*)myid,
     &               ": Internal Error 3 in CMUMPS_SET_PARTI_ACTV_MEM"
                  CALL mumps_abort()
               ENDIF
               IF((ncb.NE.acc))THEN
                  IF(k50.NE.0)THEN
                     IF(chosen.NE.0)THEN
                        additionnal_rows=ncb-acc
                        nb_rows(chosen)=nb_rows(chosen)+additionnal_rows
                     ELSE
                        tmp_sum=dble(total_mem)/dble(number_of_procs)
                        chosen=0
                        acc=0
                        DO i=1,others
                           x=int((-dble(nfront-ncb+acc)
     &                          +sqrt(((dble(nfront-ncb+acc)*
     &                          dble(nfront-ncb+acc))+dble(4)*
     &                          (tmp_sum))))/
     &                          dble(2))
                           IF((acc+x).GT.ncb) x=ncb-acc
                           nb_rows(i)=x
                           chosen=chosen+1
                           acc=acc+x
                           IF(ncb-acc.LT.kmin) GOTO 002
                           IF(ncb.EQ.acc) GOTO 002
                        ENDDO
 002                    CONTINUE
                        IF(acc.LT.ncb)THEN
                           nb_rows(chosen)=nb_rows(chosen)+(ncb-acc)
                        ENDIF
                     ENDIF
                     GOTO 333
                  ENDIF
                  additionnal_rows=ncb-acc
                  DO i=chosen,1,-1
                     IF(int(dble(additionnal_rows)/
     &                    dble(i)).NE.0)THEN
                        GOTO 222 
                     ENDIF
                  ENDDO
 222              CONTINUE
                  x=int(dble(additionnal_rows)/dble(i))
                  DO j=1,i
                     nb_rows(j)=nb_rows(j)+x
                     additionnal_rows=additionnal_rows-x
                  ENDDO 
                  IF(additionnal_rows.NE.0) THEN
                     nb_rows(1)=nb_rows(1)+additionnal_rows
                  ENDIF    
               ENDIF
 333           CONTINUE
               IF(nb_rows(chosen).EQ.0) chosen=chosen-1
               GOTO 889
            ELSE
               DO i=others,1,-1
                  somme=dble(0)
                  DO j=1,i
                     somme=somme+temp(j)
                  ENDDO
                  somme=(dble(i)*temp(i))-somme
                  IF(dble(total_mem).GE.somme) GOTO 444
               ENDDO
 444           CONTINUE
               ref=i
               DO j=1,i
                  IF(temp(j).EQ.temp(i)) THEN
                     small_set=j
                     GOTO 123
                  ENDIF
               ENDDO
 123           CONTINUE
               IF(i.EQ.1)THEN 
                  nb_rows(i)=ncb
                  chosen=1
                  GOTO 666
               ENDIF
 323           CONTINUE
               affected=0
               chosen=0
               acc=0
               DO i=1,small_set
                  IF(k50.EQ.0)THEN
                     IF((temp(small_set)-temp(i)).GT.dk821)THEN
                        tmp_sum=dk821
                     ELSE
                        tmp_sum=temp(small_set)-temp(i)
                     ENDIF
                     x=int(tmp_sum/dble(nfront))
                     IF((acc+x).GT.ncb) x=ncb-acc
                  ENDIF
                  IF(k50.NE.0)THEN
                     IF((temp(small_set)-temp(i)).GT.dk821)THEN
                        tmp_sum=dk821
                     ELSE
                        tmp_sum=temp(small_set)-temp(i)
                     ENDIF
                      x=int((-dble(nfront-ncb+acc)
     &                  +sqrt(((dble(nfront-ncb+acc)*
     &                  dble(nfront-ncb+acc))+dble(4)*
     &                  (tmp_sum))))/
     &                  dble(2))
                      IF(x.LT.0)THEN
                        WRITE(*,*)myid,
     &             ': Internal error 4 in CMUMPS_SET_PARTI_ACTV_MEM'
                        CALL mumps_abort()
                     ENDIF
                     IF((acc+x).GT.ncb) x=ncb-acc
                  ENDIF
                  nb_rows(i)=x
                  acc=acc+x
                  chosen=chosen+1
                  IF(ncb-acc.LT.kmin) GOTO 888
                  IF(ncb.EQ.acc) GOTO 888
                  IF(acc.GT.ncb) THEN
                    WRITE(*,*)myid,
     &            ': Internal error 5 in CMUMPS_SET_PARTI_ACTV_MEM'
                    CALL mumps_abort()
                  ENDIF
               ENDDO
 888           CONTINUE
               somme=dble(0)
               x=nfront-ncb
               IF((acc.GT.ncb))THEN
                  WRITE(*,*)myid,
     &           ':Internal error 6 in CMUMPS_SET_PARTI_ACTV_MEM'
                  CALL mumps_abort()
               ENDIF
               IF((acc.LT.ncb))THEN
                  IF(k50.NE.0)THEN
                     IF(small_set.LT.others)THEN
                       small_set=ref+1
                       ref=small_set
                       GOTO 323
                     ELSE
                       nb_rows(chosen)=nb_rows(chosen)+ncb-acc
                       GOTO 666
                     ENDIF
                 ENDIF
                 additionnal_rows=ncb-acc
                 i=chosen+1
                 DO WHILE ((additionnal_rows.NE.0)
     &                .AND.(i.LE.number_of_procs))
                    j=1
                    x=int(additionnal_rows/(i-1))
                    IF((x.EQ.0).AND.(additionnal_rows.NE.0))THEN
                       DO WHILE ((j.LT.i).AND.(additionnal_rows.GT.0))
                         nb_rows(j)=nb_rows(j)+1
                         additionnal_rows=additionnal_rows-1
                         j=j+1
                       ENDDO
                       IF(additionnal_rows.NE.0)THEN
                          WRITE(*,*)myid,
     &             ':Internal error 7 in CMUMPS_SET_PARTI_ACTV_MEM'
                          CALL mumps_abort()
                      ENDIF
                      GOTO 047
                    ENDIF
                    IF((temp(1)+dble((nb_rows(1)+x)*nfront)).LE.
     &                   temp(i))THEN
                       DO WHILE ((additionnal_rows.NE.0)
     &                      .AND.(j.LT.i))
                          affected=x
                          IF((affected+nb_rows(j)).GT.
     &                         kmax)THEN
                             affected=kmax-nb_rows(j)
                          ENDIF
                          nb_rows(j)=nb_rows(j)+affected
                          additionnal_rows=additionnal_rows-
     &                         affected
                          j=j+1
                       ENDDO
                    ELSE
                       DO WHILE ((additionnal_rows.NE.0)
     &                      .AND.(j.LE.i))
                          affected=int((temp(i)-(temp(j)+
     &                         (dble(nb_rows(j))*dble(nfront))))
     &                         /dble(nfront))
                          IF((affected+nb_rows(j)).GT.kmax)THEN
                             affected=kmax-nb_rows(j)
                          ENDIF
                          IF(affected.GT.additionnal_rows)THEN
                             affected=additionnal_rows
                          ENDIF
                          nb_rows(j)=nb_rows(j)+affected
                          additionnal_rows=additionnal_rows-affected
                          j=j+1
                       ENDDO
                    ENDIF
                    i=i+1
                 ENDDO
 047             CONTINUE
                 IF((additionnal_rows.EQ.0).AND.
     &                (i.LT.number_of_procs))THEN
                    chosen=i-1
                 ELSE
                    chosen=i-2
                 ENDIF
                 IF((chosen.EQ.number_of_procs-1).AND.
     &                 (additionnal_rows.NE.0))THEN
                    DO i=1,chosen
                       nb_rows(i)=nb_rows(i)+1
                       additionnal_rows=additionnal_rows-1
                       IF(additionnal_rows.EQ.0) GOTO 048
                    ENDDO
 048                CONTINUE
                 ENDIF
                 IF((chosen.EQ.number_of_procs-1).AND.
     &                (additionnal_rows.NE.0))THEN
                    i=chosen+1
                    DO WHILE ((additionnal_rows.NE.0)
     &                   .AND.(i.LE.number_of_procs))
                       j=1
                       DO WHILE ((additionnal_rows.NE.0)
     &                      .AND.(j.LE.i))
                          affected=int((temp(i)-(temp(j)+
     &                         (dble(nb_rows(j))*
     &                         dble(nfront))))/dble(nfront))
                          IF(affected.GT.additionnal_rows)THEN
                             affected=additionnal_rows
                          ENDIF
                          nb_rows(j)=nb_rows(j)+affected
                          additionnal_rows=additionnal_rows-affected
                          j=j+1
                       ENDDO
                       i=i+1
                    ENDDO
                    chosen=i-2
                 ENDIF
                 CONTINUE
              ENDIF
 666          CONTINUE
              somme=dble(0)
              x=0
              pos=0
              DO i=1,chosen
                 IF(k50.NE.0) THEN
                    IF((temp(i)+dble(nb_rows(i))
     &                   *dble(x+nb_rows(i)+nfront-ncb))
     &                   .GT.peak)THEN
                       small_set=small_set+1
                    ENDIF
                 ENDIF
                 IF(k50.EQ.0) THEN
                    IF((temp(i)+dble(nb_rows(i))*dble(nfront))
     &                   .GT.peak)THEN
                       small_set=small_set+1
                    ENDIF
                 ENDIF
                 x=x+nb_rows(i)
                 somme=somme+ dble(nb_rows(i))
              ENDDO
           ENDIF
 889       CONTINUE
           j=chosen
           x=0
           DO i=j,1,-1
             IF(nb_rows(i).EQ.0)THEN
                IF(x.EQ.1)THEN
                  WRITE(*,*)myid,
     &         ':Internal error 12 in CMUMPS_SET_PARTI_ACTV_MEM'
                  CALL mumps_abort()
                ENDIF
                chosen=chosen-1
             ELSE 
                  IF(nb_rows(i).GT.0)THEN
                    x=1
                 ELSE
                    WRITE(*,*)
     &            'Internal error 13 in CMUMPS_SET_PARTI_ACTV_MEM'
                    CALL mumps_abort()
                  ENDIF
             ENDIF
          ENDDO
           nslaves_node=chosen
           tab_pos(nslaves_node+1)= ncb+1
           tab_pos(slavef+2) = chosen
           pos=1
           DO i=1,chosen
              slaves_list(i)=temp_id(i)
              tab_pos(i)=pos
              pos=pos+nb_rows(i) 
              IF(nb_rows(i).LE.0)THEN
                WRITE(*,*)
     &          'Internal error 14 in CMUMPS_SET_PARTI_ACTV_MEM'
                CALL mumps_abort()
              ENDIF
           ENDDO
           DO i=chosen+1,number_of_procs
              slaves_list(i)=temp_id(i)
           ENDDO
           IF(pos.NE.(ncb+1))THEN
              WRITE(*,*)
     &        'Internal error 15 in CMUMPS_SET_PARTI_ACTV_MEM'
              CALL mumps_abort()
           ENDIF
      END SUBROUTINE cmumps_set_parti_actv_mem
      SUBROUTINE cmumps_set_parti_flop_irr
     &      (ncbson_max,slavef,keep,keep8,
     &       procs,mem_distrib,ncb,nfront,
     &       nslaves_node,tab_pos,
     &       slaves_list,size_slaves_list,myid,inode,mp,lp)
      IMPLICIT NONE
      INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST
      INTEGER(8) KEEP8(150)
      INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID
      INTEGER, intent(in) :: NCBSON_MAX
      INTEGER, intent(in) :: PROCS(SLAVEF+1)
      INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE
      INTEGER, intent(in) :: MP,LP
      INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
      INTEGER, intent(out):: TAB_POS(SLAVEF+2)
      INTEGER, intent(out):: NSLAVES_NODE
      INTEGER NUMBER_OF_PROCS,K47,K48, K50,K83,K69
      INTEGER(8) :: K821
      INTEGER J
      INTEGER KMIN, KMAX
      INTEGER OTHERS,CHOSEN,SMALL_SET,ACC
      DOUBLE PRECISION SOMME,TMP_SUM,DELTA,A,B,C,MASTER_WORK
      INTEGER AFFECTED
      INTEGER ADDITIONNAL_ROWS,i,X,REF,POS,NELIM
      INTEGER(8) X8
      LOGICAL FORCE_CAND,SMP
      DOUBLE PRECISION BANDE_K821
      INTEGER NB_SAT,NB_ZERO
      DOUBLE PRECISION TEMP(SLAVEF),TOTAL_COST, MAX_MEM_ALLOW
      INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF)
      INTEGER NSLAVES_REF,NCB_FILS
      EXTERNAL MPI_WTIME,MUMPS_GETKMIN
      INTEGER MUMPS_GETKMIN
      INTEGER POS_MIN_LOAD,SIZE_MY_SMP,WHAT
      LOGICAL HAVE_TYPE1_SON
      DOUBLE PRECISION MIN_LOAD,MAX_LOAD,TEMP_MAX_LOAD
      DOUBLE PRECISION MPI_WTIME
      DOUBLE PRECISION BUF_SIZE,NELIM_MEM_SIZE
      DOUBLE PRECISION MEM_SIZE_STRONG(SLAVEF),MEM_SIZE_WEAK(SLAVEF)
      K821=abs(keep8(21))
      temp_max_load=dble(0)
      k50=keep(50)
      k48=keep(48)
      k47=keep(47)
      k83=keep(83)
      k69=0
      ncb_fils=ncbson_max
      IF(int(ncb_fils,8)*int(min(ncb,ncb_fils),8).GT.k821)THEN
         have_type1_son=.true.
      ELSE
         have_type1_son=.false.
      ENDIF
      smp=(k69.NE.0)
      IF ( keep(24) == 0 .OR. keep(24) == 1 ) THEN
        force_cand = .false.
      ELSE
        force_cand = (mod(keep(24),2).eq.0)
      END IF
      nelim=nfront-ncb
         kmax=int(k821/int(ncb,8))
         IF(force_cand)THEN
           DO i=1,procs(slavef+1)
              wload(i)=load_flops(procs(i))
              idwload(i)=procs(i)
              wload(i)=max(wload(i),0.0d0)
           ENDDO
           number_of_procs=procs(slavef+1)
            others=number_of_procs
         ELSE
            number_of_procs=slavef
            wload(1:slavef) = load_flops(0:number_of_procs-1)
            DO i=1,number_of_procs
               idwload(i) = i - 1
               IF (wload(i) < -0.5d0 ) THEN
                  IF((mp.GT.0).AND.(lp.GE.2))THEN
                     WRITE(mp,*)myid,': Negative load ',
     &                    wload(i)
                  ENDIF
               ENDIF 
               wload(i)=max(wload(i),0.0d0)
            ENDDO
            others=number_of_procs-1
         ENDIF
         kmax=int(ncb/others)
         kmin=mumps_getkmin(int(ncb,8)*int(kmax,8),k50,kmax,ncb)
         nb_rows=0
         CALL mumps_sort_doubles(number_of_procs, wload, idwload)
         IF(k50.EQ.0)THEN
            total_cost=dble( nelim ) * dble( ncb ) +
     &           dble(ncb) * dble(nelim)*dble(2*nfront-nelim-1)
         ELSE
            total_cost=dble(nelim) * dble( ncb ) *
     &           dble(nfront+1)
         ENDIF
         CALL mumps_get_flops_cost(nfront,nelim,nelim,k50,
     &        2,master_work)
         somme=dble(0)
         j=1
         IF(force_cand.AND.(number_of_procs.GT.k83))THEN
            master_work=dble(keep(88))*master_work/dble(100)
         ENDIF
         IF(force_cand.AND.(number_of_procs.LE.k83))THEN
            master_work=dble(keep(87))*master_work/dble(100)
         ENDIF
         IF(master_work.LT.dble(1))THEN
            master_work=dble(1)
         ENDIF
         nslaves_ref=int(total_cost/master_work)+1
         IF(force_cand)THEN
            nslaves_ref=min(nslaves_ref,number_of_procs)
         ELSE
            nslaves_ref=min(nslaves_ref,number_of_procs-1)
         ENDIF
        DO i=1,number_of_procs
           IF((idwload(i).NE.myid))THEN
              temp_id(j)=idwload(i)
              temp(j)=wload(i)
              IF(bdc_m2_flops)THEN
                 temp(j)=temp(j)+niv2(temp_id(j)+1)
              ENDIF
              j=j+1
           ENDIF
        ENDDO               
        number_of_procs=j-1
        CALL mumps_sort_doubles(number_of_procs, temp, temp_id)
        somme=dble(0)
        tmp_sum=dble(0)
        DO i=1,others
            somme=somme+temp(others)-temp(i)
            tmp_sum=tmp_sum+temp(i)
        ENDDO
         tmp_sum=(tmp_sum/dble(others))+
     &        (total_cost/dble(others))
         size_my_smp=others
         min_load=temp(1)
         pos_min_load=1
         IF(.NOT.smp) max_load=temp(others)
         IF(smp)THEN
            j=1
            DO i=1,others
               IF(mem_distrib(temp_id(i)).EQ.1)THEN
                  IF(temp(i).LE.tmp_sum)THEN
                     wload(j)=temp(i)
                     idwload(j)=temp_id(i)
                     j=j+1
                  ELSE
                  ENDIF
               ENDIF
            ENDDO
            max_load=wload(j-1)
            size_my_smp=j-1
            DO i=1,others
               IF((mem_distrib(temp_id(i)).NE.1).OR.
     &              ((mem_distrib(temp_id(i)).EQ.1).AND.
     &              (temp(i).GE.tmp_sum)))THEN
                  wload(j)=temp(i)
                  idwload(j)=temp_id(i)
                  j=j+1
               ENDIF
            ENDDO
            temp=wload
            temp_id=idwload
         ENDIF
        IF(bdc_md)THEN
           buf_size=dble(k821)
           IF (keep(201).EQ.2) THEN
              a=dble(int((dble(keep(100))/dble(2))/dble(nelim)))
              IF(k50.EQ.0)THEN
                 buf_size=min(buf_size,a*dble(ncb))
              ELSE
                 buf_size=min(buf_size,a*a)
              ENDIF
           ENDIF
           buf_size=dble(k821)
           DO i=1,number_of_procs
              a=dble(md_mem(temp_id(i)))/
     &             dble(nelim)
              a=a*dble(nfront)
              IF(k50.EQ.0)THEN
                 b=dble(int(dble(ncb)/dble(number_of_procs))+1)*
     &                dble(nfront)
              ELSE
                 what = 5 
                 CALL mumps_max_surfcb_nbrows(what, keep,keep8, ncb,
     &                nfront, min(ncb,others), j, x8)
                 b=dble(x8)+(dble(j)*dble(nelim))
              ENDIF
              nelim_mem_size=a+b
              mem_size_weak(i)=nelim_mem_size
            IF((sbtr_which_m.EQ.0).OR.(.NOT.bdc_sbtr))THEN
               IF(bdc_m2_mem)THEN
                  mem_size_strong(i)=
     &                 dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
     &                 lu_usage(temp_id(i))-niv2(temp_id(i)+1)
               ELSE
                  mem_size_strong(i)=
     &                 dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
     &                 lu_usage(temp_id(i))
               ENDIF
            ELSE
               IF(bdc_sbtr)THEN
                  IF(bdc_m2_mem)THEN
                     mem_size_strong(i)=
     &                    dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
     &                    lu_usage(temp_id(i))-niv2(temp_id(i)+1)-
     &                    (sbtr_mem(temp_id(i))-sbtr_cur(temp_id(i)))
                  ELSE
                     mem_size_strong(i)=
     &                    dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
     &                    lu_usage(temp_id(i))-
     &                    (sbtr_mem(temp_id(i))-sbtr_cur(temp_id(i)))
                  ENDIF
               ENDIF
            ENDIF
            IF(min(mem_size_strong(i),mem_size_weak(i)).LT.dble(0))THEN
                IF(mem_size_strong(i).LT.0.0d0)THEN
                   mem_size_strong(i)=dble(0)
                ELSE
                   mem_size_weak(i)=dble(0)
                ENDIF
             ENDIF
          ENDDO
       ELSE
          buf_size=dble(k821)
          DO i=1,number_of_procs
            IF((sbtr_which_m.EQ.0).OR.(.NOT.bdc_sbtr))THEN
               IF(bdc_m2_mem)THEN
                  mem_size_strong(i)=
     &                 dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
     &                 lu_usage(temp_id(i))-niv2(temp_id(i)+1)
               ELSE
                  mem_size_strong(i)=
     &                 dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
     &                 lu_usage(temp_id(i))
               ENDIF
            ELSE
               IF(bdc_sbtr)THEN
                  IF(bdc_m2_mem)THEN
                     mem_size_strong(i)=
     &                    dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
     &                    lu_usage(temp_id(i))-niv2(temp_id(i)+1)-
     &                    (sbtr_mem(temp_id(i))-sbtr_cur(temp_id(i)))
                  ELSE
                     mem_size_strong(i)=
     &                    dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
     &                    lu_usage(temp_id(i))-
     &                    (sbtr_mem(temp_id(i))-sbtr_cur(temp_id(i)))
                  ENDIF
               ENDIF
            ENDIF
            mem_size_strong(i)=max(dble(0),mem_size_strong(i))
            mem_size_weak(i)=huge(mem_size_weak(i))
          ENDDO
       ENDIF
       IF((((number_of_procs.LE.k83).AND.force_cand).AND.
     &      (total_cost.GE.somme)).OR.
     &      (.NOT.force_cand).OR.
     &      (((number_of_procs+1).GT.k83).AND.force_cand))THEN
               ref=nslaves_ref
               small_set=nslaves_ref
               IF(.NOT.smp)THEN
                  DO i=nslaves_ref,1,-1
                     somme=dble(0)
                     DO j=1,i
                        somme=somme+temp(j)
                     ENDDO
                     somme=(dble(i)*temp(i))-somme
                     IF(total_cost.GE.somme) GOTO 444
                  ENDDO
 444              CONTINUE
                  ref=i
                  small_set=ref
                  max_load=temp(small_set)
               ELSE
                  x=min(size_my_smp,nslaves_ref)
 450              CONTINUE
                  somme=dble(0)
                  DO j=1,x
                     somme=somme+(temp(x)-temp(j))
                  ENDDO
                  IF(somme.GT.total_cost)THEN
                     x=x-1
                     GOTO 450
                  ELSE
                     IF(x.LT.size_my_smp) THEN
                        ref=x
                        small_set=ref
                        max_load=temp(small_set)
                     ELSE
                        x=min(size_my_smp,nslaves_ref)
                        j=x+1
                        max_load=temp(x)
                        tmp_sum=max_load
                        DO i=x+1,others
                           IF(temp(i).GT.max_load)THEN
                              somme=somme+(dble(i-1)*(temp(i)-max_load))
                              tmp_sum=max_load
                              max_load=temp(i)
                           ELSE
                              somme=somme+(max_load-temp(i))
                           ENDIF
                           IF(i.EQ.nslaves_ref)THEN
                              small_set=nslaves_ref
                              ref=small_set
                              GOTO 323
                           ENDIF
                           IF(somme.GT.total_cost)THEN
                              ref=i-1
                              small_set=i-1
                              max_load=tmp_sum
                              GOTO 323
                           ENDIF
                        ENDDO
                     ENDIF
                  ENDIF
               ENDIF
 323           CONTINUE
               max_load=dble(0)
               DO i=1,small_set
                  max_load=max(max_load,temp(i))
               ENDDO
               temp_max_load=max_load
               nb_rows=0
               tmp_sum=dble(0)
               chosen=0
               acc=0
               nb_sat=0
               nb_zero=0
               DO i=1,small_set
                  IF(k50.EQ.0)THEN
                     x=int(buf_size/dble(ncb+1))-1
                     bande_k821=dble(x)*dble(nfront)
                  ELSE
                     a=dble(1)
                     b=dble(acc+2)
                     c=-buf_size+dble(acc+nelim)
                     delta=(b*b)-(dble(4)*a*c)
                     x=int((-b+sqrt(delta))/(dble(2)*a))
                     IF(x.GT.ncb-acc) x=ncb-acc
                     bande_k821=dble(x)*dble(nelim+acc+x)
                  ENDIF
                  IF(have_type1_son)THEN
                     IF(k50.EQ.0)THEN
                        x=int((buf_size-dble(nfront))/dble(nfront+1))
                        bande_k821=dble(x)*dble(nfront)
                     ELSE
                        a=dble(1)
                        b=dble(acc+2+nelim)
                        c=-buf_size+dble(acc+nelim)
                        delta=(b*b)-(dble(4)*a*c)
                        x=int((-b+sqrt(delta))/(dble(2)*a))
                        IF(x.GT.ncb-acc) x=ncb-acc
                        bande_k821=dble(x)*dble(nelim+acc+x)
                     ENDIF
                  ENDIF
                  max_mem_allow=bande_k821
                  IF(bdc_md)THEN
                     max_mem_allow=min(
     &                    min(mem_size_weak(i),mem_size_strong(i)),
     &                    bande_k821)
                     max_mem_allow=max(dble(0),max_mem_allow)
                  ENDIF
                  IF(k50.EQ.0)THEN
                     kmax=int(max_mem_allow/dble(nfront))
                     x=int((max_load-temp(i))/
     &                    (dble(nelim)*dble(2*nfront-nelim)))
                     IF(x.GE.kmax)THEN
                        IF(kmax.GE.kmin)THEN
                           x=kmax
                           nb_sat=nb_sat+1
                        ELSE
                           x=0
                        ENDIF
                     ELSE
                        IF(x.LT.kmin)THEN
                           x=0
                        ENDIF                        
                     ENDIF
                     IF((acc+x).GT.ncb) x=ncb-acc
                  ENDIF
                  IF(k50.NE.0)THEN
                        a=dble(1)
                        b=dble(acc+nelim)
                        c=dble(-max_mem_allow)
                        delta=((b*b)-(dble(4)*a*c))
                        kmax=int((-b+sqrt(delta))/(dble(2)*a))
                     a=dble(nelim)
                     b=dble(nelim)*(dble(nelim)+dble(2*acc+1))
                     c=-(max_load-temp(i))
                     delta=(b*b-(dble(4)*a*c))
                     x=int((-b+sqrt(delta))/(dble(2)*a))
                     IF(x.LT.0) THEN
                        WRITE(*,*)myid,
     &    ': Internal error 1 in CMUMPS_SET_PARTI_FLOP_IRR'
                        CALL mumps_abort()
                     ENDIF
                     IF(x.GE.kmax)THEN
                        IF(kmax.GE.kmin)THEN
                           x=kmax
                           nb_sat=nb_sat+1
                        ELSE
                           x=0
                        ENDIF
                     ELSE
                        IF(x.LT.kmin)THEN
                           x=0
                        ENDIF
                     ENDIF
                     IF((acc+x).GT.ncb) x=ncb-acc
                  ENDIF                  
                  nb_rows(i)=x
                  acc=acc+x
                  chosen=chosen+1
                  IF(smp)THEN
                     IF(min_load.GT.temp(i))THEN
                        min_load=temp(i)
                        pos_min_load=i
                     ENDIF
                  ENDIF
                  tmp_sum=max_load
                  IF(k50.EQ.0)THEN
                     max_load=max(max_load,
     &                    (temp(i)+(dble(nelim) *
     &                    dble(nb_rows(i)))+
     &                    (dble(nb_rows(i))*dble(nelim)*
     &                    dble(2*nfront-nelim-1))))
                  ELSE
                     max_load=max(max_load,
     &               temp(i)+(dble(nelim) * dble(nb_rows(i)))*
     &                    dble(2*(nelim+acc)-nb_rows(i)
     &                    -nelim+1))
                  ENDIF
                  IF(tmp_sum.LT.max_load)THEN
                  ENDIF
                  IF(ncb-acc.LT.kmin) GOTO 888
                  IF(ncb.EQ.acc) GOTO 888
                  IF(acc.GT.ncb) THEN
                    WRITE(*,*)myid,
     &      ': Internal error 2 in CMUMPS_SET_PARTI_FLOP_IRR'
                    CALL mumps_abort()
                  ENDIF
               ENDDO
 888           CONTINUE
               somme=dble(0)
               x=nfront-ncb
               IF((acc.GT.ncb))THEN
                  WRITE(*,*)myid,
     &          ': Internal error 3 in CMUMPS_SET_PARTI_FLOP_IRR'
                  CALL mumps_abort()
               ENDIF
               IF((acc.LT.ncb))THEN
                  IF(k50.NE.0)THEN
                     IF(small_set.LE.others)THEN
                       IF((nb_sat.EQ.small_set).AND.(small_set.LT.
     &                      nslaves_ref))THEN
                          small_set=ref+1
                          ref=ref+1
                          nb_rows=0
                          GOTO 323
                       ENDIF
                       DO i=1,small_set
                          max_load=temp_max_load
                          additionnal_rows=ncb-acc
                          somme=dble(nelim)*
     &                         dble(additionnal_rows)*
     &                         dble(2*nfront-additionnal_rows-nelim
     &                         +1)
                          somme=somme/dble(small_set-nb_sat)
                          nb_rows=0
                          nb_zero=0
                          acc=0
                          chosen=0
                          nb_sat=0
                          IF(smp)THEN
                             min_load=temp(1)
                             pos_min_load=1
                          ENDIF
                          DO j=1,small_set
                             a=dble(1)
                             b=dble(acc+2)
                             c=-buf_size+dble(acc+nelim)
                             delta=(b*b)-(dble(4)*a*c)
                             x=int((-b+sqrt(delta))/(dble(2)*a))
                             IF(x.GT.ncb-acc) x=ncb-acc
                             bande_k821=dble(x)*dble(nelim+acc+x)
                             IF(have_type1_son)THEN
                                a=dble(1)
                                b=dble(acc+2+nelim)
                                c=-buf_size+dble(acc+nelim)
                                delta=(b*b)-(dble(4)*a*c)
                                x=int((-b+sqrt(delta))/(dble(2)*a))
                                IF(x.GT.ncb-acc) x=ncb-acc
                                bande_k821=dble(x)*dble(nelim+acc+x)
                             ENDIF
                             max_mem_allow=bande_k821
                             IF(bdc_md)THEN
                                max_mem_allow=min(
     &                        min(mem_size_weak(j),mem_size_strong(j)),
     &                               bande_k821)
                                max_mem_allow=max(dble(0),
     &                               max_mem_allow)
                             ENDIF
                             a=dble(1)
                             b=dble(acc+nelim)
                             c=dble(-max_mem_allow)
                             delta=((b*b)-(dble(4)*a*c))
                             kmax=int((-b+sqrt(delta))/(dble(2)*a))
                             a=dble(nelim)
                             b=(dble(nelim)*dble(nelim+2*acc+1))
                             c=-(max_load-temp(j)+somme)
                             delta=(b*b-(dble(4)*a*c))
                             x=int((-b+sqrt(delta))/(dble(2)*a))
                             x=x+1
                             IF(x.LT.0) THEN
                                WRITE(*,*)myid,
     &    ': Internal error 4 in CMUMPS_SET_PARTI_FLOP_IRR'
                                CALL mumps_abort()
                             ENDIF
                             IF(x.GE.kmax)THEN
                                IF(kmax.GE.kmin)THEN
                                   x=kmax
                                   nb_sat=nb_sat+1
                                ELSE
                                   nb_zero=nb_zero+1
                                   x=0
                                ENDIF
                             ELSE
                                IF(x.LT.min(kmin,kmax))THEN
                                   nb_zero=nb_zero+1
                                   x=0
                                ENDIF
                             ENDIF
                             IF((acc+x).GT.ncb) x=ncb-acc
                             nb_rows(j)=x
                             IF(smp)THEN
                                IF(min_load.GT.temp(j))THEN
                                   min_load=temp(j)
                                   pos_min_load=i
                                ENDIF
                             ENDIF
                             chosen=chosen+1
                             acc=acc+x
                             tmp_sum=max_load
                             temp_max_load=max(temp_max_load,
     &                            temp(j)+(dble(nelim) *
     &                            dble(nb_rows(j)))*
     &                            dble(2*(nelim+
     &                            acc)-nb_rows(j)
     &                            -nelim+1))
                             IF(ref.LE.number_of_procs-1)THEN
                                IF(temp_max_load.GT.temp(ref+1))THEN
                                   IF(small_set.LT.nslaves_ref)THEN
                                      small_set=ref+1
                                      ref=ref+1
                                      nb_rows=0
                                      GOTO 323
                                   ENDIF
                                ENDIF
                             ENDIF
                             IF(ncb.EQ.acc) GOTO 666
                          ENDDO
                          IF(nb_sat.EQ.small_set)THEN
                             IF(small_set.LT.nslaves_ref)THEN
                                small_set=ref+1
                                ref=ref+1
                                nb_rows=0
                                GOTO 323
                             ELSE
                                GOTO 434
                             ENDIF
                          ENDIF
                          IF(nb_zero.EQ.small_set)THEN
                             IF(small_set.LT.nslaves_ref)THEN
                                small_set=ref+1
                                ref=ref+1
                                nb_rows=0
                                GOTO 323
                             ELSE
                                GOTO 434
                             ENDIF
                          ENDIF
                          IF((nb_sat+nb_zero).EQ.small_set)THEN
                             IF(small_set.LT.nslaves_ref)THEN
                                small_set=ref+1
                                ref=ref+1
                                nb_rows=0
                                GOTO 323
                             ELSE
                                GOTO 434
                             ENDIF
                          ENDIF
                       ENDDO
 434                   CONTINUE
                       additionnal_rows=ncb-acc
                       IF(additionnal_rows.NE.0)THEN
                          IF(additionnal_rows.LT.kmin)THEN
                             i=chosen
                             j=acc
 436                         CONTINUE
                             IF(nb_rows(i).NE.0)THEN
                                j=j-nb_rows(i)
                                a=dble(1)
                                b=dble(j+2)
                                c=-buf_size+dble(j+nelim)
                                delta=(b*b)-(dble(4)*a*c)
                                x=int((-b+sqrt(delta))/(dble(2)*a))
                                IF(x.GT.ncb-j) x=ncb-j
                                bande_k821=dble(x)*dble(nelim+j+x)
                                IF(have_type1_son)THEN
                                   a=dble(1)
                                   b=dble(j+2+nelim)
                                   c=-buf_size+dble(j+nelim)
                                   delta=(b*b)-(dble(4)*a*c)
                                   x=int((-b+sqrt(delta))/(dble(2)*a))
                                   IF(x.GT.ncb-j) x=ncb-j
                                   bande_k821=dble(x)*dble(nelim+j+x)
                                ENDIF
                                max_mem_allow=bande_k821
                                IF(bdc_md)THEN
                                   max_mem_allow=min(
     &                         min(mem_size_weak(i),mem_size_strong(i)),
     &                                  bande_k821)
                                   max_mem_allow=max(dble(0),
     &                                  max_mem_allow)
                                ENDIF
                                a=dble(1)
                                b=dble(j+nelim)
                                c=dble(-max_mem_allow)
                                delta=((b*b)-(dble(4)*a*c))
                                kmax=int((-b+sqrt(delta))/(dble(2)*a))
                                IF(nb_rows(i).NE.kmax)THEN
                                   IF(ncb-j.LE.kmax)THEN
                                      nb_rows(i)=+ncb-j
                                      additionnal_rows=0
                                   ENDIF
                                ENDIF
                                temp_max_load=max(temp_max_load,
     &                               temp(i)+
     &                               (dble(nelim) * dble(nb_rows(i)))*
     &                               dble(2*(nelim+
     &                               acc)-nb_rows(i)
     &                               -nelim+1))
                                IF(ref.LE.number_of_procs-1)THEN
                                   IF(temp_max_load.GT.temp(ref+1))THEN
                                      IF(small_set.LT.nslaves_ref)THEN
                                         small_set=ref+1
                                         ref=ref+1
                                         nb_rows=0
                                         GOTO 323
                                      ENDIF
                                   ENDIF
                                ENDIF
                             ELSE
                                i=i-1
                                IF(i.NE.0)GOTO 436
                             ENDIF
                             IF(additionnal_rows.NE.0)THEN
                                i=chosen
                                IF(i.NE.small_set)THEN
                                   i=i+1
                                   IF(nb_rows(i).NE.0)THEN
                                      WRITE(*,*)myid,
     &    ': Internal error 5 in CMUMPS_SET_PARTI_FLOP_IRR'
                                      CALL mumps_abort()
                                   ENDIF
                                ENDIF
                                nb_rows(i)=nb_rows(i)+additionnal_rows
                                additionnal_rows=0
                             ENDIF
                             chosen=i
                          ENDIF
                       ENDIF
                       i=chosen+1
                       DO WHILE ((additionnal_rows.NE.0)
     &                      .AND.(i.LE.number_of_procs))
                          IF((temp(i).LE.max_load))THEN
                             a=dble(1)
                             b=dble(acc+2)
                             c=-buf_size+dble(acc+nelim)
                             delta=(b*b)-(dble(4)*a*c)
                             x=int((-b+sqrt(delta))/(dble(2)*a))
                             IF(x.GT.ncb-acc) x=ncb-acc
                             bande_k821=dble(x)*dble(nelim+acc+x)
                             IF(have_type1_son)THEN
                                a=dble(1)
                                b=dble(acc+2+nelim)
                                c=-buf_size+dble(acc+nelim)
                                delta=(b*b)-(dble(4)*a*c)
                                x=int((-b+sqrt(delta))/(dble(2)*a))
                                IF(x.GT.ncb-acc) x=ncb-acc
                                bande_k821=dble(x)*dble(nelim+acc+x)
                             ENDIF
                             max_mem_allow=bande_k821
                             IF(bdc_md)THEN
                                max_mem_allow=min(
     &                    min(mem_size_weak(i),mem_size_strong(i)),
     &                               bande_k821)
                                max_mem_allow=max(dble(0),
     &                               max_mem_allow)
                             ENDIF
                             a=dble(1)
                             b=dble(acc+nelim)
                             c=dble(-max_mem_allow)
                             delta=((b*b)-(dble(4)*a*c))
                             kmax=int((-b+sqrt(delta))/(dble(2)*a))
                             a=dble(nelim)
                             b=dble(nelim)*dble(nelim+2*acc+1)
                             c=-(max_load-temp(i))
                             delta=(b*b-(dble(4)*a*c))
                             x=int((-b+sqrt(delta))/(dble(2)*a))
                             IF(x.GE.kmax)THEN
                                IF(kmax.GE.kmin)THEN
                                   x=kmax
                                ELSE
                                   x=0
                                ENDIF
                             ELSE
                                IF(x.LT.kmin)THEN
                                   x=0
                                ENDIF
                             ENDIF
                             IF((acc+x).GT.ncb) x=ncb-acc
                             nb_rows(i)=x
                             acc=acc+x
                             additionnal_rows=ncb-acc
                          ELSE IF((temp(i).GT.max_load))THEN
                             max_load=temp(i)
                             nb_sat=0
                             acc=0
                             nb_rows=0
                             DO j=1,i
                                a=dble(1)
                                b=dble(acc+2)
                                c=-buf_size+dble(acc+nelim)
                                delta=(b*b)-(dble(4)*a*c)
                                x=int((-b+sqrt(delta))/(dble(2)*a))
                                IF(x.GT.ncb-acc) x=ncb-acc
                                bande_k821=dble(x)*dble(nelim+acc+x)
                                IF(have_type1_son)THEN
                                   a=dble(1)
                                   b=dble(acc+2+nelim)
                                   c=-buf_size+dble(acc+nelim)
                                   delta=(b*b)-(dble(4)*a*c)
                                   x=int((-b+sqrt(delta))/(dble(2)*a))
                                   IF(x.GT.ncb-acc) x=ncb-acc
                                   bande_k821=dble(x)*dble(nelim+acc+x)
                                ENDIF
                                max_mem_allow=bande_k821
                                IF(bdc_md)THEN
                                   max_mem_allow=min(
     &                    min(mem_size_weak(j),mem_size_strong(j)),
     &                                  bande_k821)
                                   max_mem_allow=max(dble(0),
     &                                  max_mem_allow)
                                ENDIF
                                a=dble(1)
                                b=dble(acc+nelim)
                                c=dble(-max_mem_allow)
                                delta=((b*b)-(dble(4)*a*c))
                                kmax=int((-b+sqrt(delta))/(dble(2)*a))
                                a=dble(nelim)
                                b=dble(nelim)*dble(nelim+2*acc+1)
                                c=-(max_load-temp(j))
                                delta=(b*b-(dble(4)*a*c))
                                x=int((-b+sqrt(delta))/(dble(2)*a))
                                IF(x.LT.0) THEN
                                   WRITE(*,*)myid,
     &    ': Internal error 6 in CMUMPS_SET_PARTI_FLOP_IRR'
                                   CALL mumps_abort()
                                ENDIF
                                IF(x.GE.kmax)THEN
                                   IF(kmax.GE.kmin)THEN
                                      x=kmax
                                      nb_sat=nb_sat+1
                                   ELSE
                                      x=0
                                   ENDIF
                                ELSE
                                   IF(x.LT.min(kmin,kmax))THEN
                                      x=0
                                   ENDIF
                                ENDIF
                                IF((acc+x).GT.ncb) x=ncb-acc
                                nb_rows(j)=x
                                IF(smp)THEN
                                   IF(min_load.GT.temp(j))THEN
                                      min_load=temp(j)
                                      pos_min_load=i
                                   ENDIF
                                ENDIF
                                acc=acc+x
                                max_load=max(max_load,
     &                               temp(j)+
     &                               (dble(nelim)*dble(nb_rows(j)))*
     &                               dble(2*(nelim+
     &                               acc)-nb_rows(j)
     &                               -nelim+1))
                                IF(ncb.EQ.acc) GOTO 741
                                IF(ncb-acc.LT.kmin) GOTO 210
                             ENDDO
 210                         CONTINUE
                          ENDIF
 741                      CONTINUE
                          i=i+1
                          additionnal_rows=ncb-acc
                       ENDDO
                       chosen=i-1
                       IF(additionnal_rows.NE.0)THEN
                          additionnal_rows=ncb-acc
                          somme=dble(nelim)*dble(additionnal_rows)*
     &                         dble(2*nfront-additionnal_rows-
     &                         nelim+1)
                          somme=somme/dble(number_of_procs)
                          nb_rows=0
                          acc=0
                          chosen=0
                          IF(smp)THEN
                             min_load=temp(1)
                             pos_min_load=1
                          ENDIF
                          DO i=1,others
                             a=dble(1)
                             b=dble(acc+2)
                             c=-buf_size+dble(acc+nelim)
                             delta=(b*b)-(dble(4)*a*c)
                             x=int((-b+sqrt(delta))/(dble(2)*a))
                             IF(x.GT.ncb-acc) x=ncb-acc
                             bande_k821=dble(x)*dble(nelim+acc+x)
                             IF(have_type1_son)THEN
                                a=dble(1)
                                b=dble(acc+2+nelim)
                                c=-buf_size+dble(acc+nelim)
                                delta=(b*b)-(dble(4)*a*c)
                                x=int((-b+sqrt(delta))/(dble(2)*a))
                                IF(x.GT.ncb-acc) x=ncb-acc
                                bande_k821=dble(x)*dble(nelim+acc+x)
                             ENDIF
                             max_mem_allow=bande_k821
                             IF(bdc_md)THEN
                                max_mem_allow=min(
     &                    min(mem_size_weak(i),mem_size_strong(i)),
     &                               bande_k821)
                                max_mem_allow=max(dble(0),
     &                               max_mem_allow)
                             ENDIF
                             a=dble(1)
                             b=dble(acc+nelim)
                             c=dble(-max_mem_allow)
                             delta=((b*b)-(dble(4)*a*c))
                             kmax=int((-b+sqrt(delta))/(dble(2)*a))
                             a=dble(nelim)
                             b=dble(nelim)*dble(nelim+2*acc+1)
                             c=-(max_load-temp(i)+somme)
                             delta=(b*b-(dble(4)*a*c))
                             x=int((-b+sqrt(delta))/(dble(2)*a))
                             IF(x.LT.0) THEN
                                WRITE(*,*)myid,
     &    ': Internal error 7 in CMUMPS_SET_PARTI_FLOP_IRR'
                                CALL mumps_abort()
                             ENDIF
                             IF(x.GE.kmax)THEN
                                IF(kmax.GE.kmin)THEN
                                   x=kmax
                                ELSE
                                   x=0
                                ENDIF
                             ELSE
                                IF(x.LT.min(kmin,kmax))THEN
                                   x=min(kmax,kmin)
                                ENDIF
                             ENDIF
                             IF((acc+x).GT.ncb) x=ncb-acc
                             nb_rows(i)=x
                             IF(smp)THEN
                                IF(min_load.GT.temp(i))THEN
                                   min_load=temp(i)
                                   pos_min_load=i
                                ENDIF
                             ENDIF
                             chosen=chosen+1
                             acc=acc+x
                             IF(ncb.EQ.acc) GOTO 666
                             IF(ncb-acc.LT.kmin) GOTO 488
                          ENDDO
 488                      CONTINUE
                          additionnal_rows=ncb-acc
                          somme=dble(nelim)*
     &                         dble(additionnal_rows)*
     &                         dble(2*nfront-additionnal_rows-
     &                         nelim+1)
                          somme=somme/dble(number_of_procs)
                          nb_rows=0
                          acc=0
                          chosen=0
                          IF(smp)THEN
                             min_load=temp(1)
                             pos_min_load=1
                          ENDIF
                          DO i=1,others
                             a=dble(1)
                             b=dble(acc+2)
                             c=-buf_size+dble(acc+nelim)
                             delta=(b*b)-(dble(4)*a*c)
                             x=int((-b+sqrt(delta))/(dble(2)*a))
                             IF(x.GT.ncb-acc) x=ncb-acc
                             bande_k821=dble(x)*dble(nelim+acc+x)
                             IF(have_type1_son)THEN
                                a=dble(1)
                                b=dble(acc+2+nelim)
                                c=-buf_size+dble(acc+nelim)
                                delta=(b*b)-(dble(4)*a*c)
                                x=int((-b+sqrt(delta))/(dble(2)*a))
                                IF(x.GT.ncb-acc) x=ncb-acc
                                bande_k821=dble(x)*dble(nelim+acc+x)
                             ENDIF
                             max_mem_allow=bande_k821
                             IF(bdc_md)THEN
                                max_mem_allow=min(bande_k821,
     &                               mem_size_strong(i))
                                max_mem_allow=max(dble(0),
     &                               max_mem_allow)
                             ENDIF
                             a=dble(1)
                             b=dble(acc+nelim)
                             c=dble(-max_mem_allow)
                             delta=((b*b)-(dble(4)*a*c))
                             kmax=int((-b+sqrt(delta))/(dble(2)*a))
                             a=dble(nelim)
                             b=dble(nelim)*dble(nelim+2*acc+1)
                             c=-(max_load-temp(i)+somme)
                             delta=(b*b-(dble(4)*a*c))
                             x=int((-b+sqrt(delta))/(dble(2)*a))
                             IF(x.LT.0) THEN
                                WRITE(*,*)myid,
     &    ': Internal error 8 in CMUMPS_SET_PARTI_FLOP_IRR'
                                CALL mumps_abort()
                             ENDIF
                             IF(x.GE.kmax)THEN
                                x=kmax
                             ELSE
                                IF(x.LT.kmin)THEN
                                   x=kmin
                                ENDIF
                             ENDIF
                             IF((acc+x).GT.ncb) x=ncb-acc
                             nb_rows(i)=x
                             IF(smp)THEN
                                IF(min_load.GT.temp(i))THEN
                                   min_load=temp(i)
                                   pos_min_load=i
                                ENDIF
                             ENDIF
                             chosen=chosen+1
                             acc=acc+x
                             IF(ncb.EQ.acc) GOTO 666
                             IF(ncb-acc.LT.kmin) GOTO 477
                          ENDDO
 477                      CONTINUE
                          IF(acc.NE.ncb)THEN
                             nb_sat=0
                             acc=0
                             chosen=0
                             IF(smp)THEN
                                min_load=temp(1)
                                pos_min_load=1
                             ENDIF
                             DO i=1,others
                                a=dble(1)
                                b=dble(acc+2)
                                c=-buf_size+dble(acc+nelim)
                                delta=(b*b)-(dble(4)*a*c)
                                x=int((-b+sqrt(delta))/(dble(2)*a))
                                IF(x.GT.ncb-acc) x=ncb-acc
                                bande_k821=dble(x)*dble(nelim+acc+x)
                                IF(have_type1_son)THEN
                                   a=dble(1)
                                   b=dble(acc+2+nelim)
                                   c=-buf_size+dble(acc+nelim)
                                   delta=(b*b)-(dble(4)*a*c)
                                   x=int((-b+sqrt(delta))/(dble(2)*a))
                                   IF(x.GT.ncb-acc) x=ncb-acc
                                   bande_k821=dble(x)*dble(nelim+acc+x)
                                ENDIF
                                max_mem_allow=bande_k821
                                IF(bdc_md)THEN
                                   max_mem_allow=min(bande_k821,
     &                                  mem_size_strong(i))
                                   max_mem_allow=max(dble(0),
     &                                  max_mem_allow)
                                ENDIF
                                a=dble(1)
                                b=dble(acc+nelim)
                                c=dble(-max_mem_allow)
                                delta=((b*b)-(dble(4)*a*c))
                                kmax=int((-b+sqrt(delta))/(dble(2)*a))
                                x=kmax-nb_rows(i)
                                IF((acc+nb_rows(i)+x).GT.ncb)
     &                               x=ncb-(acc+nb_rows(i))
                                nb_rows(i)=nb_rows(i)+x
                                IF((dble(nb_rows(i))*
     &                               dble(nb_rows(i)+acc)).EQ.
     &                               bande_k821)THEN
                                   nb_sat=nb_sat+1
                                ENDIF
                                acc=acc+nb_rows(i)
                                IF(smp)THEN
                                   IF(min_load.GT.temp(i))THEN
                                      min_load=temp(i)
                                      pos_min_load=i
                                   ENDIF
                                ENDIF
                                chosen=chosen+1
                                IF(ncb.EQ.acc) GOTO 666
                                IF(ncb-acc.LT.kmin) GOTO 834
                             ENDDO
 834                         CONTINUE
                          ENDIF
                          IF(acc.NE.ncb)THEN
                            additionnal_rows=ncb-acc
                            somme=dble(nelim)*
     &                           dble(additionnal_rows)*
     &                           dble(2*nfront-additionnal_rows-
     &                           nelim+1)
                            somme=somme/dble(number_of_procs-nb_sat)
                            acc=0
                            DO i=1,chosen
                               a=dble(1)
                               b=dble(acc+2)
                               c=-buf_size+dble(acc+nelim)
                               delta=(b*b)-(dble(4)*a*c)
                               x=int((-b+sqrt(delta))/(dble(2)*a))
                               IF(x.GT.ncb-acc) x=ncb-acc
                               bande_k821=dble(x)*dble(nelim+acc+x)
                               IF(have_type1_son)THEN
                                  a=dble(1)
                                  b=dble(acc+2+nelim)
                                  c=-buf_size+dble(acc+nelim)
                                  delta=(b*b)-(dble(4)*a*c)
                                  x=int((-b+sqrt(delta))/(dble(2)*a))
                                  IF(x.GT.ncb-acc) x=ncb-acc
                                  bande_k821=dble(x)*dble(nelim+acc+x)
                               ENDIF
                               IF((dble(nb_rows(i))*
     &                              dble(nb_rows(i)+acc)).EQ.
     &                              bande_k821)THEN
                                  GOTO 102
                               ENDIF
                               a=dble(nelim)
                               b=dble(nelim)*
     &                              dble(nelim+2*(acc+nb_rows(i))+1)
                               c=-(somme)
                               delta=(b*b-(dble(4)*a*c))
                               x=int((-b+sqrt(delta))/(dble(2)*a))
                               a=dble(1)
                               b=dble(acc+nelim)
                               c=dble(-bande_k821)
                               delta=((b*b)-(dble(4)*a*c))
                               kmax=int((-b+sqrt(delta))/(dble(2)*a))
                               IF(x.LT.0) THEN
                                  WRITE(*,*)myid,
     &    ': Internal error 9 in CMUMPS_SET_PARTI_FLOP_IRR'
                                  CALL mumps_abort()
                               ENDIF
                               IF((acc+x+nb_rows(i)).GT.ncb)THEN
                                  IF((ncb-acc).GT.kmax)THEN
                                     nb_rows(i)=kmax
                                  ELSE
                                     nb_rows(i)=ncb-acc
                                  ENDIF
                               ELSE
                                  IF((nb_rows(i)+x).GT.kmax)THEN
                                     nb_rows(i)=kmax
                                  ELSE
                                     nb_rows(i)=nb_rows(i)+x
                                  ENDIF
                               ENDIF
 102                           CONTINUE
                               acc=acc+nb_rows(i)
                               IF(ncb.EQ.acc) THEN
                                  chosen=i
                                  GOTO 666
                               ENDIF
                               IF(ncb-acc.LT.kmin) THEN
                                  chosen=i
                                  GOTO 007
                               ENDIF
                            ENDDO
 007                        CONTINUE
                            DO i=1,chosen
                               nb_rows(i)=nb_rows(i)+1
                               acc=acc+1
                               IF(acc.EQ.ncb)GOTO 666
                            ENDDO
                            IF(acc.LT.ncb)THEN
                               IF(smp)THEN
                                  nb_rows(1)=nb_rows(1)+ncb-acc
                               ELSE
                                  nb_rows(pos_min_load)=
     &                                 nb_rows(pos_min_load)+ncb-acc
                               ENDIF
                            ENDIF
                         ENDIF
                         GOTO 666
                     ENDIF
                  ENDIF
                  GOTO 666
                 ENDIF
                 additionnal_rows=ncb-acc
                 i=chosen+1
                 IF(nb_sat.EQ.small_set) GOTO 777
                 DO i=1,small_set
                    idwload(i)=i
                    affected=int(buf_size/dble(ncb+1))-1
                    bande_k821=dble(affected)*dble(nfront)
                    IF(have_type1_son)THEN
                       affected=int((buf_size-dble(nfront))/
     &                      (dble(nfront+1)))
                       bande_k821=dble(affected)*dble(nfront)
                    ENDIF
                    max_mem_allow=bande_k821
                    IF(bdc_md)THEN
                       max_mem_allow=min(
     &                    min(mem_size_weak(i),mem_size_strong(i)),
     &                      bande_k821)
                       max_mem_allow=max(dble(0),max_mem_allow)
                    ENDIF
                    wload(i)=max_mem_allow
                 ENDDO
                 CALL mumps_sort_doubles(small_set, wload, idwload)
                 nb_zero=0
                 IF((nb_sat.EQ.small_set).AND.
     &                (small_set.LT.nslaves_ref))THEN
                    small_set=ref+1
                    ref=ref+1
                    nb_rows=0
                    GOTO 323
                 ENDIF
                 IF((nb_sat.EQ.small_set).AND.
     &                (small_set.LE.number_of_procs))GOTO 777
                 affected=int(additionnal_rows/(small_set-nb_sat))
                 affected=max(affected,1)
                 DO i=1,small_set
                    kmax=int(wload(i)/dble(nfront))
                    IF(nb_rows(idwload(i)).EQ.kmax)THEN 
                       GOTO 912
                    ENDIF
                    IF((nb_rows(idwload(i))+min(affected,
     &                   additionnal_rows)).GT.kmax)THEN
                       IF(nb_rows(idwload(i)).GT.kmax)THEN
                       ENDIF
                       additionnal_rows=additionnal_rows-
     &                      (kmax-nb_rows(idwload(i)))
                       nb_rows(idwload(i))=kmax
                       nb_sat=nb_sat+1
                       IF(nb_sat.EQ.small_set)THEN
                          IF(small_set.NE.nslaves_ref)THEN
                             small_set=ref+1
                             ref=ref+1
                             nb_rows=0
                             GOTO 323
                          ELSE
                             max_load=max(max_load,
     &                            (temp(idwload(i))+(dble(nelim) *
     &                            dble(nb_rows(idwload(i))))+
     &                            (dble(nb_rows(idwload(i)))*
     &                            dble(nelim))*
     &                            dble(2*nfront-nelim-1)))
                             GOTO 777
                          ENDIF
                       ENDIF
                       affected=int(additionnal_rows/(small_set-nb_sat))
                       affected=max(affected,1)
                    ELSE
                       IF((nb_rows(idwload(i))+min(affected,
     &                      additionnal_rows)).GE.kmin)THEN
                          x=min(affected,additionnal_rows)
                          nb_rows(idwload(i))=nb_rows(idwload(i))+
     &                         x
                          additionnal_rows=additionnal_rows-x
                       ELSE
                          x=int((max_load-temp(idwload(i)))/
     &                         (dble(nelim)*dble(2*nfront-nelim)))
                          IF(x+affected.GT.additionnal_rows)THEN
                             x=additionnal_rows
                          ELSE
                             x=affected+x
                          ENDIF
                          IF(x.GE.kmin)THEN
                             nb_rows(idwload(i))=nb_rows(idwload(i))+
     &                            x
                             additionnal_rows=additionnal_rows-
     &                            x
                          ELSE
                             nb_zero=nb_zero+1
                          ENDIF
                       ENDIF
                    ENDIF
 912                CONTINUE
                    max_load=max(max_load,
     &                   (temp(idwload(i))+(dble(nelim)*
     &                   dble(nb_rows(idwload(i))))+
     &                   (dble(nb_rows(idwload(i)))*dble(nelim))*
     &                   dble(2*nfront-nelim-1)))
                    IF(small_set.LT.number_of_procs)THEN
                       IF(max_load.GT.temp(small_set+1))THEN
                          IF(small_set.LT.nslaves_ref)THEN
                             small_set=ref+1
                             ref=ref+1
                             nb_rows=0
                             GOTO 323
                          ENDIF
                       ENDIF
                    ENDIF
                    IF(small_set.EQ.nb_sat)GOTO 777
                    IF(additionnal_rows.EQ.0)THEN
                       chosen=small_set
                       GOTO 049
                    ENDIF
                 ENDDO
 777             CONTINUE
                 IF((nb_zero.NE.0).AND.(additionnal_rows.GE.kmin))THEN
                    j=nb_zero
 732                CONTINUE
                    x=int(additionnal_rows/(j))
                    IF(x.LT.kmin)THEN
                       j=j-1
                       GOTO 732
                    ENDIF
                    IF(x*j.LT.additionnal_rows)THEN
                       x=x+1
                    ENDIF
                    DO i=1,small_set
                       affected=int(buf_size/dble(ncb+1))-1
                       bande_k821=dble(affected)*dble(nfront)
                       IF(have_type1_son)THEN
                          affected=int((buf_size-dble(nfront))/
     &                         dble(nfront+1))
                          bande_k821=dble(affected)*dble(nfront)
                       ENDIF
                       max_mem_allow=bande_k821
                       IF(bdc_md)THEN
                          max_mem_allow=min(
     &                    min(mem_size_weak(i),mem_size_strong(i)),
     &                         dble(bande_k821))
                          max_mem_allow=max(dble(0),max_mem_allow)
                       ENDIF
                       kmax=int(max_mem_allow/dble(nfront))
                       IF(nb_rows(i).EQ.0)THEN
                          IF(x.GT.additionnal_rows)THEN
                             x=additionnal_rows
                          ENDIF
                          IF(x.GT.kmax)THEN
                             x=kmax
                          ENDIF
                          IF(x.GT.kmin)THEN
                             nb_rows(i)=x
                             additionnal_rows=additionnal_rows-x
                             max_load=max(max_load,
     &                            (temp(i)+(dble(nelim) *
     &                            dble(nb_rows(i)))+
     &                            (dble(nb_rows(i))*dble(nelim))*
     &                            dble(2*nfront-nelim-1)))
                          ENDIF
                       ENDIF
                    ENDDO
                 ENDIF
                 i=chosen+1
                 DO WHILE ((additionnal_rows.NE.0)
     &                .AND.(i.LE.number_of_procs))
                    IF((temp(i).LE.max_load))THEN
                       affected=int(buf_size/dble(ncb+1))-1
                       bande_k821=dble(affected)*dble(nfront)
                       IF(have_type1_son)THEN
                          affected=int((buf_size-dble(nfront))/
     &                         dble(nfront+1))
                          bande_k821=dble(affected)*dble(nfront)
                       ENDIF
                       max_mem_allow=bande_k821
                       IF(bdc_md)THEN
                          max_mem_allow=min(
     &                    min(mem_size_weak(i),mem_size_strong(i)),
     &                         bande_k821)
                          max_mem_allow=max(dble(0),max_mem_allow)
                       ENDIF
                       kmax=int(max_mem_allow/dble(nfront))
                       affected=int((max_load-temp(i))/
     &                      (dble(nelim)*dble(2*nfront-nelim)))
                       IF(affected.GT.additionnal_rows)THEN
                          affected=additionnal_rows
                       ENDIF
                       IF(nb_rows(i).LT.kmax)THEN
                          IF((affected+nb_rows(i)).GT.kmax)THEN
                             affected=kmax-nb_rows(i)
                             nb_sat=nb_sat+1
                          ELSE
                             IF((affected+nb_rows(i)).LT.
     &                            kmin)THEN
                                affected=0
                             ENDIF
                          ENDIF
                          nb_rows(i)=nb_rows(i)+affected
                          additionnal_rows=additionnal_rows-affected
                       ENDIF
                    ELSE IF((temp(i).GT.max_load))THEN
                       IF(nb_sat.EQ.i-1) GOTO 218
                       x=(additionnal_rows/(i-1-nb_sat))
                       acc=1
                       DO j=1,i-1
                          tmp_sum=((dble(nelim) * dble(nb_rows(j)+x))
     &                         +(dble(nb_rows(j)+x)*dble(nelim))*
     &                         dble(2*nfront-nelim-1))
                          IF((temp(j)+tmp_sum).GT.max_load)THEN
                             acc=0
                          ENDIF
                       ENDDO
                       IF(acc.EQ.1)THEN
                          max_load=temp(i)
                          j=1
                          DO WHILE ((additionnal_rows.NE.0)
     &                         .AND.(j.LT.i))
                             affected=int(buf_size/dble(ncb+1))-1
                             bande_k821=dble(affected)*dble(nfront)
                             IF(have_type1_son)THEN
                                affected=int((buf_size-dble(nfront))/
     &                               dble(nfront+1))
                                bande_k821=dble(affected)*dble(nfront)
                             ENDIF
                             affected=x
                             max_mem_allow=bande_k821
                             IF(bdc_md)THEN
                                max_mem_allow=min(
     &                    min(mem_size_weak(j),mem_size_strong(j)),
     &                               bande_k821)
                                max_mem_allow=max(dble(0),
     &                               max_mem_allow)
                             ENDIF
                             kmax=int(max_mem_allow/dble(nfront))
                             IF(affected.GT.additionnal_rows)THEN
                                affected=additionnal_rows
                             ENDIF
                             IF(nb_rows(j).LT.kmax)THEN
                                IF((affected+nb_rows(j)).GT.kmax)THEN
                                   affected=kmax-nb_rows(j)
                                   nb_sat=nb_sat+1
                                ELSE
                                   IF((affected+nb_rows(j)).LT.
     &                                  kmin)THEN
                                      affected=0
                                   ENDIF
                                ENDIF
                                nb_rows(j)=nb_rows(j)+affected
                                additionnal_rows=additionnal_rows-
     &                               affected
                             ENDIF
                             j=j+1
                          ENDDO                          
                       ELSE
                          max_load=temp(i)
                          j=1
                          DO WHILE ((additionnal_rows.NE.0)
     &                         .AND.(j.LT.i))
                             affected=int(buf_size/dble(ncb+1))-1
                             bande_k821=dble(affected)*dble(nfront)
                             IF(have_type1_son)THEN
                                affected=int((buf_size-dble(nfront))/
     &                               dble(nfront+1))
                                bande_k821=dble(affected)*dble(nfront)
                             ENDIF
                             tmp_sum=((dble(nelim)* dble(nb_rows(j)))
     &                            +(dble(nb_rows(j))*dble(nelim))*
     &                            dble(2*nfront-nelim-1))
                             x=int((max_load-(temp(j)+tmp_sum))/
     &                            (dble(nelim)*dble(2*nfront-nelim)))
                             IF(x.LT.0)THEN
                                WRITE(*,*)myid,
     &    ': Internal error 10 in CMUMPS_SET_PARTI_FLOP_IRR'
                                CALL mumps_abort()
                             ENDIF
                             affected=x
                             max_mem_allow=bande_k821
                             IF(bdc_md)THEN
                                max_mem_allow=min(
     &                    min(mem_size_weak(j),mem_size_strong(j)),
     &                               bande_k821)
                                max_mem_allow=max(dble(0),
     &                               max_mem_allow)
                             ENDIF
                             kmax=int(max_mem_allow/dble(nfront))
                             IF(affected.GT.additionnal_rows)THEN
                                affected=additionnal_rows
                             ENDIF
                             IF(nb_rows(j).LT.kmax)THEN
                                IF((affected+nb_rows(j)).GT.kmax)THEN
                                   affected=kmax-nb_rows(j)
                                   nb_sat=nb_sat+1
                                ELSE
                                   IF((affected+nb_rows(j)).LT.
     &                                  kmin)THEN
                                      affected=0
                                   ENDIF
                                ENDIF
                                nb_rows(j)=nb_rows(j)+affected
                                additionnal_rows=additionnal_rows-
     &                               affected
                             ENDIF
                             j=j+1
                          ENDDO
                       ENDIF
                    ENDIF
 218                CONTINUE
                    i=i+1
                 ENDDO
                 chosen=i-1
                 IF((chosen.EQ.number_of_procs-1).AND.
     &                 (additionnal_rows.NE.0))THEN
                    DO i=1,chosen
                       IF(nb_rows(i)+1.GE.kmin)THEN
                          nb_rows(i)=nb_rows(i)+1
                          additionnal_rows=additionnal_rows-1
                       ENDIF
                       max_load=max(max_load,
     &                      (temp(i)+(dble(nelim) *
     &                      dble(nb_rows(i)))+
     &                      (dble(nb_rows(i))*dble(nelim))*
     &                      dble(2*nfront-nelim-1)))
                       IF(additionnal_rows.EQ.0) GOTO 048
                    ENDDO
 048                CONTINUE
                 ENDIF
                 IF((additionnal_rows.NE.0))THEN
                    IF(chosen.LT.number_of_procs)THEN
                       i=chosen+1
                    ELSE
                       IF(chosen.NE.number_of_procs)THEN
                          WRITE(*,*)myid,
     &    ': Internal error 11 in CMUMPS_SET_PARTI_FLOP_IRR'
                          CALL mumps_abort()
                       ENDIF
                       i=chosen
                    ENDIF
                    DO WHILE ((additionnal_rows.NE.0)
     &                   .AND.(i.LE.number_of_procs))
                       IF(temp(i).LE.max_load)THEN
                          affected=int(buf_size/dble(ncb+1))-1
                          bande_k821=dble(affected)*dble(nfront)
                          IF(have_type1_son)THEN
                             affected=int((buf_size-dble(nfront))/
     &                            dble(nfront+1))
                             bande_k821=dble(affected)*dble(nfront)
                          ENDIF
                          max_mem_allow=bande_k821
                          IF(bdc_md)THEN
                             max_mem_allow=min(
     &                    min(mem_size_weak(i),mem_size_strong(i)),
     &                            bande_k821)
                             max_mem_allow=max(dble(0),max_mem_allow)
                          ENDIF
                          kmax=int(max_mem_allow/dble(nfront))
                          tmp_sum=((dble(nelim) * dble(nb_rows(i)))
     &                         +(dble(nb_rows(i))*dble(nelim))*
     &                         dble(2*nfront-nelim-1))
                          x=int((max_load-(temp(i)+tmp_sum))/
     &                         (dble(nelim)*dble(2*nfront-nelim)))
                          affected=x
                          IF(x.LT.0)THEN
                             WRITE(*,*)myid,
     &    ': Internal error 12 in CMUMPS_SET_PARTI_FLOP_IRR'
                             CALL mumps_abort()
                          ENDIF
                          IF(affected.GT.additionnal_rows)THEN
                             affected=additionnal_rows
                          ENDIF
                          IF(nb_rows(i).LT.kmax)THEN
                             IF((affected+nb_rows(i)).GT.kmax)THEN
                                affected=kmax-nb_rows(i)
                             ELSE
                                IF((affected+nb_rows(i)).LT.
     &                               kmin)THEN
                                   affected=0
                                ENDIF
                             ENDIF
                             nb_rows(i)=nb_rows(i)+affected
                             additionnal_rows=additionnal_rows-affected
                          ENDIF
                          IF(i.NE.number_of_procs) GOTO 624
                       ELSE IF((temp(i).GT.max_load))THEN
                          x=int(additionnal_rows/i-1)
                          x=max(x,1)
                          IF((max_load+((dble(nelim)*
     &                         dble(x))+(dble(
     &                         x)*dble(nelim))*dble(
     &                         (2*nfront-nelim-1)))).LE.temp(i))THEN
                             affected=x
                             pos=1
                          ELSE
                             pos=0
                          ENDIF
                          max_load=temp(i)
                          j=1
                          DO WHILE ((additionnal_rows.NE.0)
     &                         .AND.(j.LT.i))
                             x=int(buf_size/dble(ncb+1))-1
                             bande_k821=dble(x)*dble(nfront)
                             max_mem_allow=bande_k821
                             IF(have_type1_son)THEN
                                x=int((buf_size-dble(nfront))/
     &                               dble(nfront+1))
                                bande_k821=dble(x)*dble(nfront)
                             ENDIF
                             IF(bdc_md)THEN
                                max_mem_allow=min(
     &                    min(mem_size_weak(j),mem_size_strong(j)),
     &                               bande_k821)
                                max_mem_allow=max(dble(0),
     &                               max_mem_allow)
                             ENDIF
                             kmax=int(max_mem_allow/dble(nfront))
                             IF(pos.EQ.0)THEN
                                tmp_sum=((dble(nelim) *
     &                               dble(nb_rows(j)))
     &                               +(dble(nb_rows(j))*dble(nelim))*
     &                               dble(2*nfront-nelim-1))
                                x=int((temp(i)-(temp(j)+tmp_sum))/
     &                               (dble(nelim)*dble(2*nfront-
     &                               nelim)))
                             ELSE
                                x=int(tmp_sum)
                             ENDIF
                             IF(x.GT.additionnal_rows)THEN
                                x=additionnal_rows
                             ENDIF
                             IF(nb_rows(j).LT.kmax)THEN
                                IF((x+nb_rows(j)).GT.kmax)THEN
                                   x=kmax-nb_rows(j)
                                ELSE
                                   IF((nb_rows(j)+x).LT.
     &                                  kmin)THEN
                                     x=0
                                  ENDIF
                               ENDIF
                               nb_rows(j)=nb_rows(j)+x
                               additionnal_rows=additionnal_rows-x
                            ENDIF
                            j=j+1
                         ENDDO
                       ENDIF
 624                   CONTINUE
                       i=i+1
                    ENDDO
                    chosen=i-1
                    IF(additionnal_rows.NE.0)THEN
                       acc=0
                       DO i=1,chosen
                          x=int(buf_size/dble(ncb+1))-1
                          bande_k821=dble(x)*dble(nfront)
                          IF(have_type1_son)THEN
                             x=int((buf_size-dble(nfront))/
     &                            dble(nfront+1))
                             bande_k821=dble(x)*dble(nfront)
                          ENDIF
                          max_mem_allow=bande_k821
                          IF(bdc_md)THEN
                             max_mem_allow=min(
     &                    min(mem_size_weak(i),mem_size_strong(i)),
     &                            bande_k821)
                             max_mem_allow=max(dble(0),max_mem_allow)
                          ENDIF
                             kmax=int(max_mem_allow/dble(nfront))
                          tmp_sum=((dble(nelim) * dble(nb_rows(i)))
     &                    +(dble(nb_rows(i))*dble(nelim))*
     &                    dble(2*nfront-nelim-1))
                          x=int((max_load-
     &                         (temp(i)+tmp_sum))/
     &                         (dble(nelim)*dble(2*nfront-nelim)))
                          IF(x.LT.0)THEN
                             WRITE(*,*)myid,
     &    ': Internal error 13 in CMUMPS_SET_PARTI_FLOP_IRR'
                             CALL mumps_abort()
                          ENDIF
                          IF(x.GT.additionnal_rows)THEN
                             x=additionnal_rows
                          ENDIF
                          IF(nb_rows(i).LT.kmax)THEN
                             IF((x+nb_rows(i)).GE.kmax)THEN
                                additionnal_rows=additionnal_rows-
     &                               (kmax-nb_rows(i))
                                nb_rows(i)=kmax
                             ELSE
                                IF((x+nb_rows(i)).GE.
     &                               kmin)THEN
                                   nb_rows(i)=nb_rows(i)+x
                                   additionnal_rows=additionnal_rows-x
                                   acc=acc+1
                                ELSE
                                   acc=acc+1
                                ENDIF
                             ENDIF
                          ENDIF
                          IF(additionnal_rows.EQ.0)GOTO 049
                       ENDDO
                       IF(chosen.LT.number_of_procs)THEN
                          chosen=chosen+1
                       ENDIF
                       IF(acc.EQ.0)THEN
                          acc=1
                       ENDIF
                       x=int(additionnal_rows/acc)
                       x=max(x,1)
                       acc=0
                       DO i=1,chosen
                          j=int(buf_size/dble(ncb+1))-1
                          bande_k821=dble(j)*dble(nfront)
                          IF(have_type1_son)THEN
                             j=int((buf_size-dble(nfront))/
     &                            dble(nfront+1))
                             bande_k821=dble(j)*dble(nfront)
                          ENDIF
                          max_mem_allow=bande_k821
                          IF(bdc_md)THEN
                             max_mem_allow=min(
     &                    min(mem_size_weak(i),mem_size_strong(i)),
     &                            bande_k821)
                             max_mem_allow=max(dble(0),max_mem_allow)
                          ENDIF
                          kmax=int(max_mem_allow/dble(nfront))
                          tmp_sum=((dble(nelim) * dble(nb_rows(i)))
     &                         +(dble(nb_rows(i))*dble(nelim))*
     &                         dble(2*nfront-nelim-1))
                          j=int((max_load-
     &                         (temp(i)+tmp_sum))/
     &                         (dble(nelim)*dble(2*nfront-nelim)))
                          IF(nb_rows(i).LT.kmax)THEN
                             IF((min(x,j)+nb_rows(i)).GE.kmax)THEN
                                IF((kmax-nb_rows(i)).GT.
     &                               additionnal_rows)THEN
                                   nb_rows(i)=nb_rows(i)+
     &                                  additionnal_rows
                                   additionnal_rows=0
                                ELSE
                                   additionnal_rows=additionnal_rows-
     &                                  (kmax-nb_rows(i))
                                   nb_rows(i)=kmax
                                ENDIF
                             ELSE
                                IF((min(x,j)+nb_rows(i)).GE.
     &                            kmin)THEN
                                   nb_rows(i)=nb_rows(i)+min(x,j)
                                   additionnal_rows=additionnal_rows-
     &                                  min(x,j)
                                   acc=acc+1
                                ENDIF
                             ENDIF
                          ENDIF
                          IF(additionnal_rows.EQ.0)GOTO 049
                       ENDDO
                       IF(acc.GT.0)THEN
                          DO i=1,chosen
                             x=int(buf_size/dble(ncb+1))-1
                             bande_k821=dble(x)*dble(nfront)
                             IF(have_type1_son)THEN
                                x=int((buf_size-dble(nfront))/
     &                               dble(nfront+1))
                                bande_k821=dble(x)*dble(nfront)
                             ENDIF
                             max_mem_allow=bande_k821
                             IF(bdc_md)THEN
                                max_mem_allow=min(
     &                    min(mem_size_weak(i),mem_size_strong(i)),
     &                               bande_k821)
                                max_mem_allow=max(dble(0),
     &                               max_mem_allow)
                             ENDIF
                             kmax=int(max_mem_allow/dble(nfront))
                             IF(kmax-nb_rows(i).LT.
     &                            additionnal_rows)THEN
                                additionnal_rows=additionnal_rows-
     &                               (kmax-nb_rows(i))
                                nb_rows(i)=kmax
                             ELSE
                                IF(nb_rows(i).EQ.0)THEN
                                   IF(min(kmin,kmax).LT.
     &                                  additionnal_rows)THEN
                                      nb_rows(i)=min(kmin,kmax)
                                      additionnal_rows=
     &                                     additionnal_rows-
     &                                     min(kmin,kmax)
                                   ENDIF
                                ELSE
                                   nb_rows(i)=nb_rows(i)+
     &                                  additionnal_rows
                                   additionnal_rows=0
                                ENDIF
                             ENDIF
                             IF(additionnal_rows.EQ.0)GOTO 049
                          ENDDO
                       ENDIF
                       DO i=1,chosen
                          idwload(i)=i
                          affected=int(buf_size/dble(ncb+1))-1
                          bande_k821=dble(affected)*dble(nfront)
                          IF(have_type1_son)THEN
                             affected=int((buf_size-dble(nfront))/
     &                            dble(nfront+1))
                             bande_k821=dble(affected)*dble(nfront)
                          ENDIF                          
                          wload(i)=(bande_k821-dble(nb_rows(i)*nfront))
                       ENDDO
                       CALL mumps_sort_doubles(number_of_procs, wload,
     &                      idwload)
                       nb_sat=0
                       DO i=1,chosen
                          x=int(additionnal_rows/(chosen-nb_sat))
                          x=max(x,1)
                          affected=int(buf_size/dble(ncb+1))-1
                          bande_k821=dble(affected)*dble(nfront)
                          IF(have_type1_son)THEN
                             affected=int((buf_size-dble(nfront))/
     &                            dble(nfront+1))
                             bande_k821=dble(affected)*dble(nfront)
                          ENDIF
                          IF(bdc_md)THEN
                             max_mem_allow=min(bande_k821,
     &                            mem_size_strong(i))
                             max_mem_allow=max(dble(0),max_mem_allow)
                          ENDIF
                          kmax=int(max_mem_allow/dble(nfront))
                          IF(nb_rows(idwload(i)).LT.kmax)THEN
                             IF((nb_rows(idwload(i))+x).LT.kmax)THEN
                                nb_rows(idwload(i))=
     &                               nb_rows(idwload(i))+x
                                additionnal_rows=additionnal_rows-x
                             ELSE
                                additionnal_rows=additionnal_rows-
     &                               (kmax-nb_rows(idwload(i)))
                                nb_rows(idwload(i))=kmax
                             ENDIF
                          ENDIF
                          IF(nb_rows(idwload(i)).EQ.kmax)THEN
                             nb_sat=nb_sat+1
                          ENDIF
                          IF(additionnal_rows.EQ.0) GOTO 049
                       ENDDO
                       DO i=1,chosen
                          x=int(buf_size/dble(ncb+1))-1
                          bande_k821=dble(x)*dble(nfront)
                          IF(have_type1_son)THEN
                             x=int((buf_size-dble(nfront))/
     &                            dble(nfront+1))
                             bande_k821=dble(x)*dble(nfront)
                          ENDIF
                          max_mem_allow=bande_k821
                          IF(bdc_md)THEN
                             max_mem_allow=min(bande_k821,
     &                            mem_size_strong(i))
                             max_mem_allow=max(dble(0),max_mem_allow)
                          ENDIF
                          kmax=int(max_mem_allow/dble(nfront))
                          IF(kmax-nb_rows(i).LT.additionnal_rows)THEN
                             additionnal_rows=additionnal_rows-
     &                            (kmax-nb_rows(i))
                             nb_rows(i)=kmax
                          ELSE
                             nb_rows(i)=nb_rows(i)+additionnal_rows
                             additionnal_rows=0
                          ENDIF
                          IF(additionnal_rows.EQ.0)GOTO 049
                       ENDDO
                       x=int(additionnal_rows/chosen)
                       x=max(x,1)
                       DO i=1,chosen
                          additionnal_rows=additionnal_rows-x
                          nb_rows(i)=nb_rows(i)+x
                          IF(additionnal_rows.EQ.0)GOTO 049
                       ENDDO
                       nb_rows(1)=nb_rows(1)+additionnal_rows
                    ENDIF
                 ENDIF
 049             CONTINUE
              ENDIF
 666          CONTINUE
              somme=dble(0)
              x=0
              pos=0
              DO i=1,chosen
                 x=x+nb_rows(i)
                 somme=somme+ dble(nb_rows(i))
              ENDDO
              GOTO 890
           ELSE IF((keep(83).GE.number_of_procs).AND.force_cand)THEN
              max_load=dble(0)
              DO i=1,others
                 max_load=max(max_load,temp(i))
              ENDDO
              acc=0
              chosen=0
              x=1
              DO i=1,others
              ENDDO
              DO i=2,others 
                 IF(temp(i).EQ.temp(1))THEN
                    x=x+1
                 ELSE 
                    GOTO 329
                 ENDIF
              ENDDO
 329          CONTINUE
              tmp_sum=total_cost/dble(x)
              temp_max_load=dble(0)
              DO i=1,others
                 IF(k50.EQ.0)THEN
                    x=int(buf_size/dble(ncb+1))-1
                    bande_k821=dble(x)*dble(nfront)
                 ELSE
                    a=dble(1)
                    b=dble(acc+2)
                    c=-buf_size+dble(acc+nelim)
                    delta=(b*b)-(dble(4)*a*c)
                    x=int((-b+sqrt(delta))/(dble(2)*a))
                    IF(x.GT.ncb-acc) x=ncb-acc
                    bande_k821=dble(x)*dble(nelim+acc+x)
                 ENDIF
                 IF(have_type1_son)THEN
                    IF(k50.EQ.0)THEN
                       x=int((buf_size-dble(nfront))/dble(nfront+1))
                       bande_k821=dble(x)*dble(nfront)
                    ELSE
                       a=dble(1)
                       b=dble(acc+2+nelim)
                       c=-buf_size+dble(acc+nelim)
                       delta=(b*b)-(dble(4)*a*c)
                       x=int((-b+sqrt(delta))/(dble(2)*a))
                       IF(x.GT.ncb-acc) x=ncb-acc
                       bande_k821=dble(x)*dble(nelim+acc+x)
                    ENDIF
                 ENDIF
                 max_mem_allow=bande_k821
                 IF(bdc_md)THEN
                    max_mem_allow=min(bande_k821,
     &                    min(mem_size_weak(i),mem_size_strong(i)))
                    max_mem_allow=max(dble(0),max_mem_allow)
                 ENDIF
                 IF(k50.EQ.0)THEN
                       kmax=int(max_mem_allow/dble(nfront))
                    IF(tmp_sum+temp(i).GT.max_load)THEN
                       somme=max_load-temp(i)
                    ELSE
                       somme=tmp_sum
                    ENDIF
                    x=int(somme/
     &                   (dble(nelim)*dble(2*nfront-nelim)))
                    IF(x.GT.kmax)THEN
                       x=kmax
                    ELSE
                       IF(x.LT.kmin)THEN
                          x=min(kmin,kmax)
                       ENDIF
                    ENDIF
                    IF((acc+x).GT.ncb) x=ncb-acc
                 ENDIF
                 IF(k50.NE.0)THEN
                       a=dble(1)
                       b=dble(acc+nelim)
                       c=dble(-max_mem_allow)
                       delta=((b*b)-(dble(4)*a*c))
                       kmax=int((-b+sqrt(delta))/(dble(2)*a))
                    a=dble(nelim)
                    b=dble(nelim)*dble(nelim+2*acc+1)
                    IF(tmp_sum+temp(i).GT.max_load)THEN
                       c=-(max_load-temp(i))
                    ELSE
                       c=-tmp_sum
                    ENDIF
                    delta=(b*b-(dble(4)*a*c))
                    x=int((-b+sqrt(delta))/(dble(2)*a))
                    IF(x.LT.0) THEN
                       WRITE(*,*)myid,
     &    ': Internal error 14 in CMUMPS_SET_PARTI_FLOP_IRR'
                       CALL mumps_abort()
                    ENDIF
                    IF(x.GE.kmax)THEN
                       IF(kmax.GT.kmin)THEN
                          x=kmax
                       ELSE
                          x=0
                       ENDIF
                    ELSE
                       IF(x.LE.min(kmin,kmax))THEN
                          IF(kmax.LT.kmin)THEN
                             x=0
                          ELSE
                             x=min(kmin,kmax)
                          ENDIF
                       ENDIF
                    ENDIF
                    IF((acc+x).GT.ncb) x=ncb-acc
                 ENDIF
                 temp_max_load=max(temp_max_load,temp(i))
                 nb_rows(i)=x
                 chosen=chosen+1
                 acc=acc+x
                 IF(acc.EQ.ncb) GOTO 541
              ENDDO
 541          CONTINUE
              IF(acc.LT.ncb)THEN
                 IF(k50.EQ.0)THEN
                    additionnal_rows=ncb-acc
                    DO j=1,chosen
                       affected=int(buf_size/dble(ncb+1))-1
                       bande_k821=dble(affected)*dble(nfront)
                       IF(have_type1_son)THEN
                          affected=int((buf_size-dble(nfront))/
     &                         dble(nfront+1))
                          bande_k821=dble(affected)*dble(nfront)
                       ENDIF
                       max_mem_allow=bande_k821
                       IF(bdc_md)THEN
                          max_mem_allow=min(
     &                    min(mem_size_weak(j),mem_size_strong(j)),
     &                         dble(bande_k821))
                          max_mem_allow=max(dble(0),max_mem_allow)
                       ENDIF
                       kmax=int(max_mem_allow/dble(nfront))
                       IF((nb_rows(j)).LT.kmax)THEN
                          IF(additionnal_rows.GT.(kmax-nb_rows(j)))THEN
                             additionnal_rows=additionnal_rows-
     &                            (kmax-nb_rows(j))
                             nb_rows(j)=kmax
                          ELSE
                             nb_rows(j)=nb_rows(j)+additionnal_rows
                             additionnal_rows=0
                          ENDIF
                       ENDIF
                       IF(additionnal_rows.EQ.0)GOTO 889
                    ENDDO 
                    x=int(additionnal_rows/chosen)
                    x=max(x,1)
                    DO j=1,chosen
                       affected=int(buf_size/dble(ncb+1))-1
                       bande_k821=dble(affected)*dble(nfront)
                       IF(have_type1_son)THEN
                          affected=int((buf_size-dble(nfront))/
     &                         dble(nfront+1))
                          bande_k821=dble(affected)*dble(nfront)
                       ENDIF
                       max_mem_allow=bande_k821
                       IF(bdc_md)THEN
                          max_mem_allow=min(bande_k821,
     &                         mem_size_strong(j))
                          max_mem_allow=max(dble(0),max_mem_allow)
                       ENDIF
                       kmax=int(max_mem_allow/dble(nfront))
                       IF((nb_rows(j)+x).GT.kmax)THEN
                          additionnal_rows=additionnal_rows-
     &                         (kmax-nb_rows(j))
                          nb_rows(j)=kmax
                       ELSE
                          additionnal_rows=additionnal_rows-x
                          nb_rows(j)=nb_rows(j)+x
                       ENDIF
                       IF(additionnal_rows.EQ.0)GOTO 889
                    ENDDO 
                    DO i=1,chosen
                       x=int(buf_size/dble(ncb+1))-1
                       bande_k821=dble(x)*dble(nfront)
                       IF(have_type1_son)THEN
                          x=int((buf_size-dble(nfront))/
     &                         dble(nfront+1))
                          bande_k821=dble(x)*dble(nfront)
                       ENDIF
                       max_mem_allow=bande_k821
                       IF(bdc_md)THEN
                          max_mem_allow=min(bande_k821,
     &                         mem_size_strong(i))
                          max_mem_allow=max(dble(0),max_mem_allow)
                       ENDIF
                       kmax=int(max_mem_allow/dble(nfront))
                       IF(kmax-nb_rows(i).LT.additionnal_rows)THEN
                          additionnal_rows=additionnal_rows-
     &                         (kmax-nb_rows(i))
                          nb_rows(i)=kmax
                       ELSE
                          nb_rows(i)=nb_rows(i)+additionnal_rows
                          additionnal_rows=0
                       ENDIF
                       IF(additionnal_rows.EQ.0)GOTO 889
                    ENDDO
                    DO i=1,number_of_procs
                       idwload(i)=i
                       affected=int(buf_size/dble(ncb+1))-1
                       bande_k821=dble(affected)*dble(nfront)
                       IF(have_type1_son)THEN
                          affected=int((buf_size-dble(nfront))/
     &                         dble(nfront+1))
                          bande_k821=dble(affected)*dble(nfront)
                       ENDIF                          
                       wload(i)=(bande_k821-(dble(nb_rows(i))*
     &                      dble(nfront)))
                    ENDDO
                    CALL mumps_sort_doubles(number_of_procs, wload,
     &                   idwload)
                    nb_sat=0
                    DO i=1,chosen
                       x=int(additionnal_rows/(chosen-nb_sat))
                       x=max(x,1)
                       affected=int(buf_size/dble(ncb+1))-1
                       bande_k821=dble(affected)*dble(nfront)
                       IF(have_type1_son)THEN
                          affected=int((buf_size-dble(nfront))/
     &                         dble(nfront+1))
                          bande_k821=dble(affected)*dble(nfront)
                       ENDIF
                       max_mem_allow=bande_k821
                       kmax=int(max_mem_allow/dble(nfront))
                       IF(nb_rows(idwload(i)).LT.kmax)THEN
                          IF((nb_rows(idwload(i))+x).LT.kmax)THEN
                             nb_rows(idwload(i))=
     &                            nb_rows(idwload(i))+x
                             additionnal_rows=additionnal_rows-x
                          ELSE
                             additionnal_rows=additionnal_rows-
     &                            (kmax-nb_rows(idwload(i)))
                             nb_rows(idwload(i))=kmax
                          ENDIF
                       ENDIF
                       IF(nb_rows(idwload(i)).EQ.kmax)THEN
                          nb_sat=nb_sat+1
                       ENDIF
                       IF(additionnal_rows.EQ.0) GOTO 889
                    ENDDO
                    GOTO 994
                 ELSE
                    acc=0
                    chosen=0
                    DO i=1,others
                       a=dble(1)
                       b=dble(acc+2)
                       c=-buf_size+dble(acc+nelim)
                       delta=(b*b)-(dble(4)*a*c)
                       x=int((-b+sqrt(delta))/(dble(2)*a))
                       IF(x.GT.ncb-acc) x=ncb-acc
                       bande_k821=dble(x)*dble(nelim+acc+x)
                       IF(have_type1_son)THEN
                          a=dble(1)
                          b=dble(acc+2+nelim)
                          c=-buf_size+dble(acc+nelim)
                          delta=(b*b)-(dble(4)*a*c)
                          x=int((-b+sqrt(delta))/(dble(2)*a))
                          IF(x.GT.ncb-acc) x=ncb-acc
                          bande_k821=dble(x)*dble(nelim+acc+x)
                       ENDIF
                       max_mem_allow=bande_k821
                       IF(bdc_md)THEN
                          max_mem_allow=min(bande_k821,
     &                         mem_size_strong(i))
                          max_mem_allow=max(dble(0),max_mem_allow)
                       ENDIF
                       a=dble(1)
                       b=dble(acc+nelim)
                       c=dble(-max_mem_allow)
                       delta=((b*b)-(dble(4)*a*c))
                       kmax=int((-b+sqrt(delta))/(dble(2)*a))
                       x=kmax-nb_rows(i)
                       IF((acc+nb_rows(i)+x).GT.ncb)
     &                            x=ncb-(acc+nb_rows(i))
                       nb_rows(i)=nb_rows(i)+x
                       acc=acc+nb_rows(i)
                       chosen=chosen+1
                       IF(ncb.EQ.acc) GOTO 889
                    ENDDO
                    additionnal_rows=ncb-acc
                 ENDIF
                 acc=0
                 chosen=0
                 DO i=1,others
                    a=dble(1)
                    b=dble(acc+2)
                    c=-buf_size+dble(acc+nelim)
                    delta=(b*b)-(dble(4)*a*c)
                    x=int((-b+sqrt(delta))/(dble(2)*a))
                    IF(x.GT.ncb-acc) x=ncb-acc
                    bande_k821=dble(x)*dble(nelim+acc+x)
                    IF(have_type1_son)THEN
                       a=dble(1)
                       b=dble(acc+2+nelim)
                       c=-buf_size+dble(acc+nelim)
                       delta=(b*b)-(dble(4)*a*c)
                       x=int((-b+sqrt(delta))/(dble(2)*a))
                       IF(x.GT.ncb-acc) x=ncb-acc
                       bande_k821=dble(x)*dble(nelim+acc+x)
                    ENDIF
                    max_mem_allow=bande_k821
                    a=dble(1)
                    b=dble(acc+nelim)
                    c=dble(-max_mem_allow)
                    delta=((b*b)-(dble(4)*a*c))
                    kmax=int((-b+sqrt(delta))/(dble(2)*a))
                    x=kmax-nb_rows(i)
                    IF((acc+nb_rows(i)+x).GT.ncb)
     &                   x=ncb-(acc+nb_rows(i))
                    nb_rows(i)=nb_rows(i)+x
                    acc=acc+nb_rows(i)
                    chosen=chosen+1
                    IF(ncb.EQ.acc) GOTO 889
                 ENDDO
                 additionnal_rows=ncb-acc
 994             CONTINUE
                 x=int(dble(additionnal_rows)/dble(others))
                 IF((x*others).LT.additionnal_rows)THEN
                    x=x+1
                 ENDIF
                 DO i=1,others
                    nb_rows(i)=nb_rows(i)+x
                    additionnal_rows=additionnal_rows-x
                    IF(additionnal_rows.LT.x)x=additionnal_rows
                 ENDDO
                 chosen=others
              ENDIF
           ENDIF
 889       CONTINUE
           max_load=temp_max_load
 890       CONTINUE
           j=chosen
           x=0
              DO i=j,1,-1
                 IF(nb_rows(i).EQ.0)THEN
                    chosen=chosen-1
                    ELSE 
                       IF(nb_rows(i).GT.0)THEN
                          x=1
                       ELSE
                          WRITE(*,*)myid,
     &    ': Internal error 15 in CMUMPS_SET_PARTI_FLOP_IRR'
                          CALL mumps_abort()
                       ENDIF
                    ENDIF
                 ENDDO
           nslaves_node=chosen
           tab_pos(nslaves_node+1)= ncb+1
           tab_pos(slavef+2) = chosen
           pos=1
           x=1
           DO i=1,j
              IF(nb_rows(i).NE.0)THEN
                 slaves_list(x)=temp_id(i)
                 tab_pos(x)=pos
                 pos=pos+nb_rows(i) 
                 IF(nb_rows(i).LE.0)THEN
                    WRITE(*,*)myid,
     &    ': Internal error 16 in CMUMPS_SET_PARTI_FLOP_IRR'
                    CALL mumps_abort()
                 ENDIF
                 x=x+1
               ENDIF
           ENDDO
           IF(pos.NE.(ncb+1))THEN
              WRITE(*,*)myid,
     &    ': Internal error 17 in CMUMPS_SET_PARTI_FLOP_IRR',
     &             pos,ncb+1
              CALL mumps_abort()
           ENDIF
      END SUBROUTINE cmumps_set_parti_flop_irr
      SUBROUTINE cmumps_load_pool_check_mem
     &      (inode,upper,slavef,keep,keep8,
     &       step,pool,lpool,procnode,n)
      IMPLICIT NONE
      INTEGER inode, lpool, slavef, n
      INTEGER keep(500)
      INTEGER(8) keep8(150)
      INTEGER step(keep(28)), pool(lpool), procnode(keep(28))
      LOGICAL upper
      INTEGER j
      DOUBLE PRECISION mem_cost
      INTEGER nbinsubtree,i,nbtop
      EXTERNAL cmumps_pool_empty,
     & mumps_in_or_root_ssarbr
      LOGICAL cmumps_pool_empty,
     & mumps_in_or_root_ssarbr
      nbinsubtree = pool(lpool)
      nbtop       = pool(lpool - 1)
      IF(keep(47).LT.2)THEN
         WRITE(*,*)'CMUMPS_LOAD_POOL_CHECK_MEM must
     &        be called with K47>=2'
         CALL mumps_abort()
      ENDIF        
      IF((inode.GT.0).AND.(inode.LE.n))THEN
      mem_cost=cmumps_load_get_mem(inode)
         IF((dm_mem(myid)+dble(mem_cost)+ peak_sbtr_cur_local-
     &        sbtr_cur_local)
     &        .GT.max_peak_stk)THEN
            DO i=nbtop-1,1,-1
               inode = pool( lpool - 2 - i)
               mem_cost=cmumps_load_get_mem(inode)
               IF((inode.LT.0).OR.(inode.GT.n)) THEN
                  DO j=i+1,nbtop,-1
                     pool(j-1)=pool(j)
                  ENDDO
                  upper=.true.
                  RETURN
               ENDIF
               IF((dm_mem(myid)+dble(mem_cost)+peak_sbtr_cur_local-
     &              sbtr_cur_local).LE.
     &              max_peak_stk) THEN
                  DO j=i+1,nbtop,-1
                     pool(j-1)=pool(j)
                  ENDDO
                  upper=.true.
                  RETURN
               ENDIF
            ENDDO
            IF(nbinsubtree.NE.0)THEN
               inode = pool( nbinsubtree )
               IF(.NOT.mumps_in_or_root_ssarbr(procnode(step(inode)),
     &              keep(199)))THEN
                  WRITE(*,*)
     &        'Internal error 1 in CMUMPS_LOAD_POOL_CHECK_MEM'
                  CALL mumps_abort()
               ENDIF
               upper=.false.
               RETURN
            ENDIF
            inode=pool(lpool-2-nbtop)
            upper=.true.
            RETURN
         ENDIF
      ENDIF
      upper=.true.
      END SUBROUTINE cmumps_load_pool_check_mem
      SUBROUTINE cmumps_load_set_sbtr_mem(WHAT)
      IMPLICIT NONE
      LOGICAL what
      IF(.NOT.bdc_pool_mng)THEN
         WRITE(*,*)'CMUMPS_LOAD_SET_SBTR_MEM
     &        should be called when K81>0 and K47>2'
      ENDIF
      IF(what)THEN
         peak_sbtr_cur_local=peak_sbtr_cur_local+
     &        dble(mem_subtree(indice_sbtr))
         IF(.NOT.bdc_sbtr) indice_sbtr=indice_sbtr+1
      ELSE
         peak_sbtr_cur_local=dble(0)
         sbtr_cur_local=dble(0)
      ENDIF
      END SUBROUTINE cmumps_load_set_sbtr_mem
      DOUBLE PRECISION FUNCTION cmumps_load_get_mem( INODE )
      IMPLICIT NONE
      INTEGER inode,level,i,nelim,nfr
      DOUBLE PRECISION cost
      EXTERNAL mumps_typenode
      INTEGER MUMPS_TYPENODE
      i = inode
      nelim = 0
 10   CONTINUE
      IF ( i > 0 ) THEN
        nelim = nelim + 1
        i = fils_load(i)
        GOTO 10
      ENDIF
      nfr = nd_load( step_load(inode) ) + keep_load(253)
      level = mumps_typenode( procnode_load(step_load(inode)),
     &                        keep_load(199) )
      IF (level .EQ. 1) THEN
        cost =  dble(nfr) * dble(nfr)
      ELSE
        IF ( k50 == 0 ) THEN
           cost =  dble(nfr) * dble(nelim)
        ELSE
           cost = dble(nelim) * dble(nelim)
        ENDIF
      ENDIF
      cmumps_load_get_mem=cost
      RETURN
      END FUNCTION cmumps_load_get_mem
      RECURSIVE SUBROUTINE cmumps_next_node(FLAG,COST,COMM)
      USE cmumps_buf
      USE mumps_future_niv2
      IMPLICIT NONE
      INTEGER comm,what,ierr
      LOGICAL flag, exit_flag
      DOUBLE PRECISION cost
      DOUBLE PRECISION to_be_sent
      EXTERNAL mumps_typenode
      INTEGER mumps_typenode
      IF(flag)THEN
         what=17 
         IF(bdc_m2_flops)THEN
            to_be_sent=delta_load-cost
            delta_load=dble(0)
         ELSE IF(bdc_m2_mem)THEN
            IF(bdc_pool.AND.(.NOT.bdc_md))THEN
               to_be_sent=max(tmp_m2,pool_last_cost_sent)
               pool_last_cost_sent=to_be_sent
            ELSE IF(bdc_md)THEN
               delta_mem=delta_mem+tmp_m2
               to_be_sent=delta_mem
            ELSE
               to_be_sent=dble(0)
            ENDIF
         ENDIF
      ELSE
         what=6
         to_be_sent=dble(0)
      ENDIF
 111  CONTINUE
      CALL cmumps_buf_broadcast( what,
     &         comm, nprocs,
     &               future_niv2,
     &         cost, 
     &         to_be_sent, 
     &         myid, keep_load, ierr  )
      IF ( ierr == -1 )THEN
         CALL cmumps_load_recv_msgs(comm_ld)
         CALL mumps_check_comm_nodes(comm_nodes, exit_flag)
         IF (exit_flag) THEN
            GOTO 100
         ELSE
            GOTO 111
         ENDIF
      ELSE IF ( ierr .NE. 0 ) THEN
         WRITE(*,*) "Internal Error in CMUMPS_LOAD_POOL_UPD_NEW_POOL",
     &   ierr
         CALL mumps_abort()
      ENDIF
 100  CONTINUE
      RETURN
      END SUBROUTINE cmumps_next_node
      SUBROUTINE cmumps_upper_predict(INODE,STEP,NSTEPS,PROCNODE,FRERE,
     &     NE,COMM,SLAVEF,MYID,KEEP,KEEP8,N)
      USE cmumps_buf
      IMPLICIT NONE
      INTEGER inode,nsteps,myid,slavef,comm,n
      INTEGER keep(500)
      INTEGER(8) keep8(150)
      INTEGER frere(nsteps),ne(nsteps),step(n),procnode(nsteps)
      EXTERNAL mumps_in_or_root_ssarbr,mumps_procnode
      LOGICAL mumps_in_or_root_ssarbr
      INTEGER i,ncb,nelim
      INTEGER mumps_procnode
      INTEGER father_node,father,what,ierr
      EXTERNAL mumps_typenode
      INTEGER mumps_typenode
      LOGICAL :: exit_flag
      if((.NOT.bdc_m2_mem).AND.(.NOT.bdc_m2_flops))then
         write(*,*)myid,': Problem in CMUMPS_UPPER_PREDICT'
         call mumps_abort()
      endif
      IF((inode.LT.0).OR.(inode.GT.n)) THEN
         RETURN
      ENDIF
      i=inode
      nelim = 0
 10   CONTINUE
      IF ( i > 0 ) THEN
         nelim = nelim + 1
         i = fils_load(i)
         GOTO 10
      ENDIF
      ncb=nd_load(step_load(inode))-nelim + keep_load(253)
      what=5
      father_node=dad_load(step_load(inode))
      IF (father_node.EQ.0) THEN
         RETURN
      ENDIF
      IF((frere(step(father_node)).EQ.0).AND.
     &     ((father_node.EQ.keep(38)).OR.
     &     (father_node.EQ.keep(20))))THEN
         RETURN 
      ENDIF
      IF(mumps_in_or_root_ssarbr(procnode(step(father_node)),
     &            keep(199))) THEN
         RETURN
      ENDIF
      father=mumps_procnode(procnode(step(father_node)),keep(199))
      IF(father.EQ.myid)THEN
        IF(bdc_m2_mem)THEN
           CALL cmumps_process_niv2_mem_msg(father_node)
        ELSEIF(bdc_m2_flops)THEN
           CALL cmumps_process_niv2_flops_msg(father_node)
        ENDIF
        IF((keep(81).EQ.2).OR.(keep(81).EQ.3))THEN
           IF(mumps_typenode(procnode_load(step_load(inode)),
     &          keep(199)).EQ.1)THEN
              cb_cost_id(pos_id)=inode
              cb_cost_id(pos_id+1)=1
              cb_cost_id(pos_id+2)=pos_mem
              pos_id=pos_id+3
              cb_cost_mem(pos_mem)=int(myid,8)
              pos_mem=pos_mem+1
              cb_cost_mem(pos_mem)=int(ncb,8)*int(ncb,8)
              pos_mem=pos_mem+1
           ENDIF
        ENDIF
        GOTO 666
      ENDIF
 111  CONTINUE      
      CALL cmumps_buf_send_fils(what, comm, nprocs,
     &     father_node,inode,ncb, keep,myid,
     &     father, ierr)
      IF (ierr == -1 ) THEN
        CALL cmumps_load_recv_msgs(comm_ld)
        CALL mumps_check_comm_nodes(comm_nodes, exit_flag)
        IF (exit_flag) THEN
           GOTO 666
        ELSE
           GOTO 111
        ENDIF
      ELSE IF ( ierr .NE. 0 ) THEN
        WRITE(*,*) "Internal Error in CMUMPS_UPPER_PREDICT",
     &  ierr
        CALL mumps_abort()
      ENDIF 
 666  CONTINUE
      RETURN
      END SUBROUTINE cmumps_upper_predict
      SUBROUTINE cmumps_remove_node(INODE,NUM_CALL)
      IMPLICIT NONE
      DOUBLE PRECISION maxi
      INTEGER i,j,ind_maxi
      INTEGER inode,num_call
      IF(bdc_m2_mem)THEN
         IF(((num_call.EQ.1).AND.(bdc_md)).OR.
     &       ((num_call.EQ.2).AND.(.NOT.bdc_md)))THEN
            RETURN
         ENDIF
      ENDIF
      IF((frere_load(step_load(inode)).EQ.0).AND.
     &     ((inode.EQ.keep_load(38)).OR.
     &     (inode.EQ.keep_load(20)))) THEN
         RETURN
      ENDIF
      DO i=pool_size,1,-1
         IF(pool_niv2(i).EQ.inode) GOTO 666
      ENDDO
         nb_son(step_load(inode))=-1
      RETURN         
 666  CONTINUE
      IF(bdc_m2_mem)THEN
         IF(pool_niv2_cost(i).EQ.max_m2)THEN
            tmp_m2=max_m2
            maxi=dble(0)
            ind_maxi=-9999
            DO j=pool_size,1,-1
               IF(j.NE.i) THEN
                  IF(pool_niv2_cost(j).GT.maxi)THEN
                     maxi=pool_niv2_cost(j)
                     ind_maxi=j
                  ENDIF
               ENDIF
            ENDDO
            max_m2=maxi
            j=ind_maxi
            remove_node_flag_mem=.true.
            remove_node_cost_mem=tmp_m2
            CALL cmumps_next_node(remove_node_flag,max_m2,comm_ld)
            niv2(myid+1)=max_m2
         ENDIF
      ELSEIF(bdc_m2_flops)THEN
         remove_node_cost=pool_niv2_cost(i)
         remove_node_flag=.true.
         CALL cmumps_next_node(remove_node_flag,
     &        -pool_niv2_cost(i),comm_ld)
         niv2(myid+1)=niv2(myid+1)-pool_niv2_cost(i)
      ENDIF
      DO j=i+1,pool_size
         pool_niv2(j-1)=pool_niv2(j)
         pool_niv2_cost(j-1)=pool_niv2_cost(j)
      ENDDO
      pool_size=pool_size-1
      END SUBROUTINE cmumps_remove_node
      RECURSIVE SUBROUTINE cmumps_process_niv2_mem_msg(INODE)
      IMPLICIT NONE
      INTEGER inode
      EXTERNAL mumps_typenode
      INTEGER mumps_typenode
      IF((inode.EQ.keep_load(20)).OR.
     &     (inode.EQ.keep_load(38)))THEN
         RETURN
      ENDIF
      IF(nb_son(step_load(inode)).EQ.-1)THEN
         RETURN
      ELSE
         IF(nb_son(step_load(inode)).LT.0)THEN
            WRITE(*,*)
     &        'Internal error 1 in CMUMPS_PROCESS_NIV2_MEM_MSG'
            CALL mumps_abort()
         ENDIF
      ENDIF
      nb_son(step_load(inode))=
     &     nb_son(step_load(inode))-1
      IF(nb_son(step_load(inode)).EQ.0)THEN
         IF(pool_size.EQ.pool_niv2_size)THEN
            WRITE(*,*)myid,': Internal Error 2 in
     &CMUMPS_PROCESS_NIV2_MEM_MSG'
            CALL mumps_abort()
         ENDIF
         pool_niv2(pool_size+1)=inode
         pool_niv2_cost(pool_size+1)=
     &        cmumps_load_get_mem(inode)
         pool_size=pool_size+1
         IF(pool_niv2_cost(pool_size).GT.max_m2)THEN
            max_m2=pool_niv2_cost(pool_size)
            id_max_m2=pool_niv2(pool_size)
            CALL cmumps_next_node(remove_node_flag_mem,max_m2,comm_ld)
            niv2(1+myid)=max_m2
         ENDIF
      ENDIF
      RETURN
      END SUBROUTINE cmumps_process_niv2_mem_msg    
      RECURSIVE SUBROUTINE cmumps_process_niv2_flops_msg(INODE)
      IMPLICIT NONE
      INTEGER inode
      EXTERNAL mumps_typenode
      INTEGER mumps_typenode
      IF((inode.EQ.keep_load(20)).OR.
     &     (inode.EQ.keep_load(38)))THEN
         RETURN
      ENDIF
      IF(nb_son(step_load(inode)).EQ.-1)THEN
         RETURN
      ELSE
         IF(nb_son(step_load(inode)).LT.0)THEN
            WRITE(*,*)
     &        'Internal error 1 in CMUMPS_PROCESS_NIV2_FLOPS_MSG'
            CALL mumps_abort()
         ENDIF
      ENDIF
      nb_son(step_load(inode))=
     &     nb_son(step_load(inode))-1
      IF(nb_son(step_load(inode)).EQ.0)THEN
         IF(pool_size.EQ.pool_niv2_size)THEN
            WRITE(*,*)myid,': Internal Error 2 in
     &CMUMPS_PROCESS_NIV2_FLOPS_MSG',pool_niv2_size,
     &           pool_size
            CALL mumps_abort()
         ENDIF
         pool_niv2(pool_size+1)=inode
         pool_niv2_cost(pool_size+1)=
     &        cmumps_load_get_flops_cost(inode)
         pool_size=pool_size+1
         max_m2=pool_niv2_cost(pool_size)
         id_max_m2=pool_niv2(pool_size)
         CALL cmumps_next_node(remove_node_flag,
     &           pool_niv2_cost(pool_size),
     &        comm_ld)
         niv2(myid+1)=pool_niv2_cost(pool_size)+niv2(myid+1)
      ENDIF
      RETURN
      END SUBROUTINE cmumps_process_niv2_flops_msg
      DOUBLE PRECISION FUNCTION cmumps_load_get_flops_cost(INODE)
      USE mumps_future_niv2
      INTEGER inode
      INTEGER nfront,nelim,i,level
      EXTERNAL mumps_typenode
      INTEGER mumps_typenode
      DOUBLE PRECISION cost
      i = inode
      nelim = 0
 10   CONTINUE
      IF ( i > 0 ) THEN
        nelim = nelim + 1
        i = fils_load(i)
        GOTO 10
      ENDIF
      nfront = nd_load( step_load(inode) ) + keep_load(253)
      level = mumps_typenode( procnode_load(step_load(inode)),
     &        keep_load(199) )
      cost=dble(0)
      CALL mumps_get_flops_cost(nfront,nelim,nelim,
     &                          keep_load(50),level,cost)
      cmumps_load_get_flops_cost=cost
      RETURN
      END FUNCTION cmumps_load_get_flops_cost
      INTEGER FUNCTION cmumps_load_get_cb_freed( INODE )
      IMPLICIT NONE
      INTEGER inode,nelim,nfr,son,in,i
      INTEGER cost_cb
      cost_cb=0
      i = inode
 10   CONTINUE
      IF ( i > 0 ) THEN
        i = fils_load(i)
        GOTO 10
      ENDIF
      son=-i
      DO i=1, ne_load(step_load(inode))
         nfr = nd_load( step_load(son) ) + keep_load(253)
         in=son
         nelim = 0
 20      CONTINUE
         IF ( in > 0 ) THEN
            nelim = nelim + 1
            in = fils_load(in)
            GOTO 20
         ENDIF
         cost_cb=cost_cb+((nfr-nelim)*(nfr-nelim))
         son=frere_load(step_load(son))
      ENDDO
      cmumps_load_get_cb_freed=cost_cb
      RETURN
      END FUNCTION cmumps_load_get_cb_freed
      SUBROUTINE cmumps_load_send_md_info(SLAVEF,NMB_OF_CAND,
     &     LIST_OF_CAND,
     &     TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES,
     &     NSLAVES,INODE)
      USE cmumps_buf
      USE mumps_future_niv2
      IMPLICIT NONE
      INTEGER, INTENT (IN) :: slavef, nass, nslaves
      INTEGER, INTENT (IN) :: nmb_of_cand
      INTEGER, INTENT (IN) :: list_of_cand(nmb_of_cand)
      INTEGER, INTENT (IN) :: tab_pos(slavef+2)
      INTEGER, INTENT (IN) :: list_slaves(nslaves)
      INTEGER keep(500),inode
      INTEGER(8) keep8(150)
      INTEGER allocok
      DOUBLE PRECISION mem_cost,fct_cost
      DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE :: delta_md
      INTEGER, DIMENSION(:), ALLOCATABLE :: iproc2posindeltamd
      INTEGER, DIMENSION(:), ALLOCATABLE :: p_to_update
      INTEGER nbrows_slave,i,what,ierr
      INTEGER :: np_to_update, k
      LOGICAL force_cand
      LOGICAL :: exit_flag
      mem_cost=dble(0)
      fct_cost=dble(0)
      IF ( keep(24) == 0 .OR. keep(24) == 1 ) THEN
        force_cand = .false.
      ELSE
        force_cand = (mod(keep(24),2).eq.0)
      END IF
      CALL cmumps_load_get_estim_mem_cost(inode,fct_cost,
     &        mem_cost,nmb_of_cand,nass)
      ALLOCATE(iproc2posindeltamd(0:slavef-1),
     & delta_md(min(slavef, nmb_of_cand+nslaves)),
     & p_to_update(min(slavef, nmb_of_cand+nslaves)),
     & stat=allocok)
      IF (allocok > 0 ) THEN
        WRITE(*,*) "PB ALLOC IN CMUMPS_LOAD_SEND_MD_INFO",
     &  slavef, nmb_of_cand, nslaves
        CALL mumps_abort()
      ENDIF
      iproc2posindeltamd = -99
      np_to_update = 0
      DO i = 1, nslaves
        np_to_update = np_to_update + 1
        iproc2posindeltamd(list_slaves(i)) = np_to_update
        nbrows_slave = tab_pos(i+1) - tab_pos(i)
        delta_md(np_to_update)=-dble(nbrows_slave)*
     &           dble(nass)
        p_to_update(np_to_update) = list_slaves(i)
      ENDDO
      DO i = 1, nmb_of_cand
        k = iproc2posindeltamd(list_of_cand(i))
        IF ( k > 0 ) THEN
          delta_md(k)=delta_md(k)+fct_cost
        ELSE
          np_to_update = np_to_update + 1
          iproc2posindeltamd(list_of_cand(i)) = np_to_update
          delta_md(np_to_update) = fct_cost
          p_to_update(np_to_update) = list_of_cand(i)
        ENDIF
      ENDDO
      what=7
 111  CONTINUE
      CALL cmumps_buf_bcast_array(.false., comm_ld, myid, slavef,
     &     future_niv2,
     &     np_to_update, p_to_update,0,
     &     delta_md, 
     &     delta_md, 
     &     delta_md, 
     &     what, keep, ierr)
      IF ( ierr == -1 ) THEN
          CALL cmumps_load_recv_msgs(comm_ld)
          CALL mumps_check_comm_nodes(comm_nodes, exit_flag)
          IF (exit_flag) THEN
             GOTO 100
          ELSE
             GOTO 111
          ENDIF
       ELSE IF ( ierr .NE. 0 ) THEN
         WRITE(*,*) "Internal Error 2 in CMUMPS_LOAD_SEND_MD_INFO",
     &   ierr
         CALL mumps_abort()
      ENDIF
      IF (future_niv2(myid+1) .NE. 0) THEN
        DO i = 1, np_to_update
           md_mem(p_to_update(i))=md_mem(p_to_update(i))+
     &          int(delta_md( i ),8)
           IF(future_niv2(p_to_update(i)+1).EQ.0)THEN
              md_mem(p_to_update(i))=999999999_8
           ENDIF
        ENDDO
      ENDIF
 100  CONTINUE
      DEALLOCATE(delta_md,p_to_update,iproc2posindeltamd)
      RETURN
      END SUBROUTINE cmumps_load_send_md_info
      SUBROUTINE cmumps_load_get_estim_mem_cost(INODE,FCT_COST,
     &     MEM_COST,NSLAVES,NELIM)
      IMPLICIT NONE
      INTEGER INODE,NSLAVES,NFR,NELIM,IN
      DOUBLE PRECISION MEM_COST,FCT_COST
      nfr=nd_load(step_load(inode)) + keep_load(253)
      in = inode
      fct_cost=dble(int(dble(nfr-nelim)/dble(nslaves))+1)*
     &     dble(nelim)
      mem_cost=dble(int(dble(nfr-nelim)/dble(nslaves))+1)*
     &     dble(nfr)
      END SUBROUTINE cmumps_load_get_estim_mem_cost
      SUBROUTINE cmumps_load_clean_meminfo_pool(INODE)
      USE mumps_future_niv2
      IMPLICIT NONE
      INTEGER inode
      INTEGER i,j,son,nslaves_temp,pos_temp,k
      INTEGER mumps_procnode
      EXTERNAL mumps_procnode
      IF((inode.LT.0).OR.(inode.GT.n_load))THEN
         RETURN
      ENDIF
      IF(pos_id.GT.1)THEN
         i=inode
 10      CONTINUE
         IF ( i > 0 ) THEN
            i = fils_load(i)
            GOTO 10
         ENDIF
         son=-i
         IF(pos_id.LT.ne_load(step_load(inode))*3)THEN
            i=1
         ENDIF
         DO i=1, ne_load(step_load(inode))
            j=1
            DO WHILE (j.LT.pos_id)
               IF(cb_cost_id(j).EQ.son)GOTO 295 
               j=j+3
            ENDDO
 295        CONTINUE
            IF(j.GE.pos_id)THEN
               IF ( mumps_procnode(
     &                procnode_load(step_load(inode)),
     &                keep_load(199) ) .EQ. myid ) THEN
                  IF(inode.EQ.keep_load(38))THEN
                     GOTO 666
                  ELSE
                     IF(future_niv2(myid+1).NE.0)THEN
                        WRITE(*,*)myid,': i did not find ',son
                        CALL mumps_abort()
                     ENDIF
                     GOTO 666
                  ENDIF
               ELSE
                  GOTO 666
               ENDIF
            ENDIF
            nslaves_temp=cb_cost_id(j+1)       
            pos_temp=cb_cost_id(j+2)
            DO k=j,pos_id-1
               cb_cost_id(k)=cb_cost_id(k+3)
            ENDDO
            k=pos_temp
            DO WHILE (k.LE.pos_mem-1)
               cb_cost_mem(k)=cb_cost_mem(k+2*nslaves_temp)
               k=k+1
            ENDDO
            pos_mem=pos_mem-2*nslaves_temp
            pos_id=pos_id-3
            IF((pos_mem.LT.1).OR.(pos_id.LT.1))THEN
               WRITE(*,*)myid,': negative pos_mem or pos_id'
               CALL mumps_abort()
            ENDIF
 666        CONTINUE
            son=frere_load(step_load(son))
         ENDDO
      ENDIF
      END SUBROUTINE cmumps_load_clean_meminfo_pool
      SUBROUTINE cmumps_load_chk_memcst_pool(FLAG)
      IMPLICIT NONE
      LOGICAL flag
      INTEGER i
      DOUBLE PRECISION mem
      flag=.false.
      DO i=0,nprocs-1
         mem=dm_mem(i)+lu_usage(i)
         IF(bdc_sbtr)THEN
            mem=mem+sbtr_mem(i)-sbtr_cur(i)
         ENDIF
         IF((mem/dble(tab_maxs(i))).GT.0.8d0)THEN
            flag=.true.
            GOTO 666
         ENDIF
      ENDDO
 666  CONTINUE
      END SUBROUTINE cmumps_load_chk_memcst_pool
      SUBROUTINE cmumps_check_sbtr_cost(NBINSUBTREE,INSUBTREE,NBTOP,
     &           MIN_COST,SBTR)
      IMPLICIT NONE
      INTEGER nbinsubtree,insubtree,nbtop
      DOUBLE PRECISION min_cost
      LOGICAL sbtr
      INTEGER i
      DOUBLE PRECISION tmp_cost,tmp_min
      tmp_min=huge(tmp_min)
      DO i=0,nprocs-1
         IF(i.NE.myid)THEN
            IF(bdc_sbtr)THEN
               tmp_min=min(tmp_min,dble(tab_maxs(i))-(dm_mem(i)+
     &              lu_usage(i))-(sbtr_mem(i)-sbtr_cur(i)))
            ELSE
               tmp_min=min(tmp_min,dble(tab_maxs(i))-
     &              (dm_mem(i)+lu_usage(i)))
            ENDIF
         ENDIF
      ENDDO
      IF(nbinsubtree.GT.0)THEN
         IF(insubtree.EQ.1)THEN
            tmp_cost=dble(tab_maxs(myid))-(dm_mem(myid)+
     &           lu_usage(myid))
     &           -(sbtr_mem(myid)-sbtr_cur(myid))
         ELSE
            sbtr=.false.
            GOTO 777
         ENDIF
      ENDIF
      tmp_min=min(tmp_cost,tmp_min)
      IF(tmp_min.GT.min_cost) sbtr=.true.
 777  CONTINUE
      END SUBROUTINE cmumps_check_sbtr_cost
      SUBROUTINE cmumps_load_comp_maxmem_pool(INODE,MAX_MEM,PROC)
      USE mumps_future_niv2
      IMPLICIT NONE
      INTEGER inode,proc
      INTEGER i,pos,nslaves,slave,ncand,j,nelim,ncb,nfront,son,k
      INTEGER allocok
      EXTERNAL mumps_typenode
      INTEGER  mumps_typenode
      DOUBLE PRECISION max_mem
      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: mem_on_procs,
     &     recv_buf
      LOGICAL, DIMENSION(:), ALLOCATABLE :: concerned
      DOUBLE PRECISION max_sent_msg
      IF((frere_load(step_load(inode)).EQ.0)
     &           .AND.(inode.EQ.keep_load(38)))THEN
         RETURN
      ENDIF
      ALLOCATE( mem_on_procs(0:nprocs-1), stat=allocok)
      IF ( allocok > 0 ) THEN
        WRITE(*,*) 'PB allocation in CMUMPS_LOAD_COMP_MAXMEM_POOL'
        CALL mumps_abort()
      ENDIF 
      ALLOCATE( concerned(0:nprocs-1), stat=allocok)
      IF ( allocok > 0 ) THEN
        WRITE(*,*) 'PB allocation in CMUMPS_LOAD_COMP_MAXMEM_POOL'
        CALL mumps_abort()
      ENDIF 
      ALLOCATE( recv_buf(0:nprocs-1), stat=allocok)
      IF ( allocok > 0 ) THEN
        WRITE(*,*) 'PB allocation in CMUMPS_LOAD_COMP_MAXMEM_POOL'
        CALL mumps_abort()
      ENDIF 
      recv_buf=dble(0)
      max_sent_msg=dble(0)
      i = inode
      nelim = 0
 10   CONTINUE
      IF ( i > 0 ) THEN
        nelim = nelim + 1
        i = fils_load(i)
        GOTO 10
      ENDIF
      son=-i
      nfront=nd_load(step_load(inode)) + keep_load(253)
      ncb=nfront-nelim
      IF(mumps_typenode(procnode_load(step_load(inode)),
     &     keep_load(199)).EQ.2)THEN
         ncand=cand_load(nprocs+1, step_to_niv2_load(step_load(inode)))
      ENDIF
      DO i=0,nprocs-1
         IF(i.EQ.myid)THEN
            mem_on_procs(i)=dble(tab_maxs(i))-(dm_mem(i)+
     &           lu_usage(i)+
     &           cmumps_load_get_mem(inode))
            IF(bdc_sbtr)THEN
               mem_on_procs(i)=mem_on_procs(i)-(sbtr_mem(i)-sbtr_cur(i))
            ENDIF
            concerned(i)=.true.
         ELSE
            mem_on_procs(i)=dble(tab_maxs(i))-(dm_mem(i)+lu_usage(i))
            IF(bdc_sbtr)THEN
               mem_on_procs(i)=mem_on_procs(i)-(sbtr_mem(i)-sbtr_cur(i))
            ENDIF
            IF(bdc_m2_mem)THEN
               mem_on_procs(i)=mem_on_procs(i)-niv2(i+1)
            ENDIF
         ENDIF
         IF(mumps_typenode(procnode_load(step_load(inode)),
     &        keep_load(199)).EQ.2)THEN
            IF(bdc_md.AND.(keep_load(48).EQ.5))THEN
               DO j=1,ncand
                  IF(cand_load(j, step_to_niv2_load(step_load(inode)))
     &                 .EQ.i)THEN
                     mem_on_procs(i)=mem_on_procs(i)-
     &                 ((dble(nfront)*dble(ncb))/dble(ncand))
                     concerned(i)=.true.
                     GOTO 666
                  ENDIF
               ENDDO
            ENDIF
         ENDIF
 666     CONTINUE
      ENDDO
      DO k=1, ne_load(step_load(inode))
         i=1
         DO WHILE (i.LE.pos_id)
            IF(cb_cost_id(i).EQ.son)GOTO 295
            i=i+3
         ENDDO
 295     CONTINUE
         IF(i.GE.pos_id)THEN
            IF(future_niv2(myid+1).NE.0)THEN
               WRITE(*,*)myid,': ',son,'has not been found
     & in CMUMPS_LOAD_COMP_MAXMEM_POOL'
               CALL mumps_abort()
            ENDIF
            GOTO 777
         ENDIF
         nslaves=cb_cost_id(i+1)
         pos=cb_cost_id(i+2)
         DO i=1,nslaves
            slave=int(cb_cost_mem(pos))
            IF(.NOT.concerned(slave))THEN
               mem_on_procs(slave)=mem_on_procs(slave)+
     &              dble(cb_cost_mem(pos+1))
            ENDIF
            DO j=0,nprocs-1
               IF(concerned(j))THEN
                  IF(slave.NE.j)THEN
                     recv_buf(j)=max(recv_buf(j),
     &                    dble(cb_cost_mem(pos+1)))
                  ENDIF
               ENDIF
            ENDDO
            pos=pos+2
         ENDDO
 777     CONTINUE
         son=frere_load(step_load(son))
      ENDDO
      max_mem=huge(max_mem)
      WRITE(*,*)'NPROCS=',nprocs,max_mem
      DO i=0,nprocs-1
         IF(max_mem.GT.mem_on_procs(i))THEN
            proc=i
         ENDIF
         max_mem=min(mem_on_procs(i),max_mem)
      ENDDO
      DEALLOCATE(mem_on_procs)
      DEALLOCATE(concerned)
      DEALLOCATE(recv_buf)
      END SUBROUTINE cmumps_load_comp_maxmem_pool
      SUBROUTINE cmumps_find_best_node_for_mem(MIN_PROC,POOL,
     &                      LPOOL,INODE)
      IMPLICIT NONE
      INTEGER inode,lpool,min_proc
      INTEGER pool(lpool)
      EXTERNAL mumps_procnode
      INTEGER mumps_procnode
      INTEGER i,nbtop,insubtree,nbinsubtree,node,father,son,J
      INTEGER sbtr_nb_leaf,pos,k,allocok,l
      INTEGER, ALLOCATABLE, DIMENSION (:) ::  tmp_sbtr
      nbinsubtree = pool(lpool)
      nbtop       = pool(lpool - 1)
      insubtree   = pool(lpool - 2)
      IF((keep_load(47).EQ.4).AND.
     &     ((nbinsubtree.NE.0)))THEN
         DO j=indice_sbtr,nb_subtrees
            node=my_root_sbtr(j) 
            father=dad_load(step_load(node))
            i=father
 110        CONTINUE
            IF ( i > 0 ) THEN
               i = fils_load(i)
               GOTO 110
            ENDIF
            son=-i
            i=son
 120        CONTINUE
            IF ( i > 0 ) THEN
               IF( mumps_procnode(procnode_load(step_load(i)),
     &             keep_load(199)) .EQ.  min_proc ) THEN
                  sbtr_nb_leaf=my_nb_leaf(j)
                  pos=sbtr_first_pos_in_pool(j)
                  IF(pool(pos+sbtr_nb_leaf).NE.my_first_leaf(j))THEN
                     WRITE(*,*)myid,': The first leaf is not ok'
                     CALL mumps_abort()
                  ENDIF
                  ALLOCATE (tmp_sbtr(sbtr_nb_leaf), stat=allocok)
                  IF (allocok > 0 ) THEN
                     WRITE(*,*)myid,': Not enough space
     &                    for allocation'
                     CALL mumps_abort()
                  ENDIF
                  pos=sbtr_first_pos_in_pool(j)
                  DO k=1,sbtr_nb_leaf
                     tmp_sbtr(k)=pool(pos+k-1)
                  ENDDO
                  DO k=pos+1,nbinsubtree-sbtr_nb_leaf
                     pool(k)=pool(k+sbtr_nb_leaf)
                  ENDDO
                  pos=1
                  DO k=nbinsubtree-sbtr_nb_leaf+1,nbinsubtree
                     pool(k)=tmp_sbtr(pos)
                     pos=pos+1
                  ENDDO
                  DO k=indice_sbtr,j
                     sbtr_first_pos_in_pool(k)=sbtr_first_pos_in_pool(k)
     &                    -sbtr_first_pos_in_pool(j)
                  ENDDO
                  sbtr_first_pos_in_pool(j)=nbinsubtree-sbtr_nb_leaf
                  pos=my_first_leaf(j)
                  l=my_nb_leaf(j)
                  DO k=indice_sbtr,j
                     my_first_leaf(j)=my_first_leaf(j+1)
                     my_nb_leaf(j)=my_nb_leaf(j+1)
                  ENDDO
                  my_first_leaf(indice_sbtr)=pos
                  my_nb_leaf(indice_sbtr)=l
                  inode=pool(nbinsubtree)
                  DEALLOCATE(tmp_sbtr)
                  RETURN
               ENDIF
               i = frere_load(step_load(i))
               GOTO 120
            ENDIF           
         ENDDO
      ENDIF
      DO j=nbtop,1,-1
         node=pool(lpool-2-j)
         father=dad_load(step_load(node))
         i=father
 11      CONTINUE
         IF ( i > 0 ) THEN
            i = fils_load(i)
            GOTO 11
         ENDIF
         son=-i
         i=son
 12      CONTINUE
         IF ( i > 0 ) THEN
            IF( mumps_procnode(procnode_load(step_load(i)),
     &          keep_load(199)) .EQ. min_proc ) THEN
               inode=node
               RETURN
            ENDIF
            i = frere_load(step_load(i))
            GOTO 12
         ENDIF
      ENDDO
      END SUBROUTINE cmumps_find_best_node_for_mem
      SUBROUTINE cmumps_load_init_sbtr_struct(POOL, LPOOL,KEEP,KEEP8)
      IMPLICIT NONE
      INTEGER lpool,pool(lpool),keep(500)
      INTEGER(8) keep8(150)
      INTEGER i,pos
      EXTERNAL mumps_rootssarbr
      LOGICAL mumps_rootssarbr
      IF(.NOT.bdc_sbtr) RETURN
      pos=0
      DO i=nb_subtrees,1,-1
         DO WHILE(mumps_rootssarbr(
     &            procnode_load(step_load(pool(pos+1))),
     &            keep(199)))
            pos=pos+1
         ENDDO
         sbtr_first_pos_in_pool(i)=pos+1
         pos=pos+my_nb_leaf(i)
      ENDDO
      END SUBROUTINE cmumps_load_init_sbtr_struct
      END MODULE cmumps_load