1C
2C  This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011
3C
4C
5C  This version of MUMPS is provided to you free of charge. It is public
6C  domain, based on public domain software developed during the Esprit IV
7C  European project PARASOL (1996-1999). Since this first public domain
8C  version in 1999, research and developments have been supported by the
9C  following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT,
10C  INRIA, and University of Bordeaux.
11C
12C  The MUMPS team at the moment of releasing this version includes
13C  Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche,
14C  Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora
15C  Ucar and Clement Weisbecker.
16C
17C  We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil
18C  Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat,
19C  Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire
20C  Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who
21C  have been contributing to this project.
22C
23C  Up-to-date copies of the MUMPS package can be obtained
24C  from the Web pages:
25C  http://mumps.enseeiht.fr/  or  http://graal.ens-lyon.fr/MUMPS
26C
27C
28C   THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY
29C   EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
30C
31C
32C  User documentation of any code that uses this software can
33C  include this complete notice. You can acknowledge (using
34C  references [1] and [2]) the contribution of this package
35C  in any scientific publication dependent upon the use of the
36C  package. You shall use reasonable endeavours to notify
37C  the authors of the package of this publication.
38C
39C   [1] P. R. Amestoy, I. S. Duff, J. Koster and  J.-Y. L'Excellent,
40C   A fully asynchronous multifrontal solver using distributed dynamic
41C   scheduling, SIAM Journal of Matrix Analysis and Applications,
42C   Vol 23, No 1, pp 15-41 (2001).
43C
44C   [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and
45C   S. Pralet, Hybrid scheduling for the parallel solution of linear
46C   systems. Parallel Computing Vol 32 (2), pp 136-156 (2006).
47C
48      MODULE SMUMPS_LOAD
49      implicit none
50      PUBLIC :: SMUMPS_188, SMUMPS_185,
51     &  SMUMPS_189, SMUMPS_190,
52     &  SMUMPS_183, SMUMPS_187,
53     &  SMUMPS_186, SMUMPS_409,
54     &  SMUMPS_384, SMUMPS_461,
55     &  SMUMPS_467, SMUMPS_471,
56     &  SMUMPS_472,
57     &  SMUMPS_791, SMUMPS_790,
58     &  SMUMPS_792, SMUMPS_500,
59     &  SMUMPS_501, SMUMPS_520,
60     &  SMUMPS_513,
61     &  SMUMPS_514, SMUMPS_512
62     &  ,SMUMPS_533,
63     &  SMUMPS_819, SMUMPS_818,
64     &  SMUMPS_820, SMUMPS_554,
65     &  SMUMPS_553,
66     &  SMUMPS_555
67      DOUBLE PRECISION, DIMENSION(:),
68     &       ALLOCATABLE, SAVE, PRIVATE :: LOAD_FLOPS
69      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PRIVATE :: BUF_LOAD_RECV
70      INTEGER, SAVE, PRIVATE :: LBUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES
71      INTEGER, SAVE, PRIVATE :: K50, K69, K35
72      INTEGER(8), SAVE, PRIVATE :: MAX_SURF_MASTER
73      LOGICAL, SAVE, PRIVATE :: BDC_MEM, BDC_POOL, BDC_SBTR,
74     &     BDC_POOL_MNG,
75     &     BDC_M2_MEM,BDC_M2_FLOPS,BDC_MD,REMOVE_NODE_FLAG,
76     &     REMOVE_NODE_FLAG_MEM
77      DOUBLE PRECISION, SAVE, PRIVATE :: REMOVE_NODE_COST,
78     &     REMOVE_NODE_COST_MEM
79      INTEGER, SAVE, PRIVATE :: SBTR_WHICH_M
80      DOUBLE PRECISION, DIMENSION(:),
81     &       ALLOCATABLE, TARGET, SAVE, PRIVATE :: WLOAD
82#if defined(OLD_LOAD_MECHANISM)
83#if defined(CHECK_COHERENCE)
84      INTEGER, SAVE, PRIVATE :: NB_LEVEL2
85      LOGICAL, PRIVATE :: AMI_CHOSEN,IS_DISPLAYED
86#endif
87#endif
88#if ! defined(OLD_LOAD_MECHANISM)
89      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PRIVATE :: FUTURE_NIV2
90      DOUBLE PRECISION, SAVE, PRIVATE :: DELTA_LOAD, DELTA_MEM
91#else
92      DOUBLE PRECISION, SAVE, PRIVATE :: LAST_LOAD_SENT,
93     &           DM_LAST_MEM_SENT
94#endif
95      INTEGER(8), SAVE, PRIVATE :: CHECK_MEM
96      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, TARGET, PRIVATE ::
97     &          IDWLOAD
98      DOUBLE PRECISION, SAVE, PRIVATE :: COST_SUBTREE
99      DOUBLE PRECISION, SAVE, PRIVATE :: ALPHA
100      DOUBLE PRECISION, SAVE, PRIVATE :: BETA
101      INTEGER, SAVE, PRIVATE :: MYID, NPROCS, COMM_LD
102      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE,
103     &           PRIVATE :: POOL_MEM
104      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, PRIVATE,
105     &           SAVE :: SBTR_MEM
106      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE,
107     &           PRIVATE, SAVE :: SBTR_CUR
108      INTEGER, DIMENSION(:), ALLOCATABLE,
109     &           PRIVATE, SAVE :: NB_SON
110      DOUBLE PRECISION,
111     &           PRIVATE, SAVE :: SBTR_CUR_LOCAL
112      DOUBLE PRECISION,
113     &           PRIVATE, SAVE :: PEAK_SBTR_CUR_LOCAL
114      DOUBLE PRECISION,
115     &           PRIVATE, SAVE :: MAX_PEAK_STK
116      DOUBLE PRECISION, SAVE,
117     &           PRIVATE :: POOL_LAST_COST_SENT
118      DOUBLE PRECISION, SAVE,
119     &           PRIVATE :: MIN_DIFF
120      INTEGER, SAVE :: POS_ID,POS_MEM
121      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: CB_COST_ID
122      INTEGER(8), DIMENSION(:), ALLOCATABLE, SAVE
123     &           :: CB_COST_MEM
124      PUBLIC :: CB_COST_ID, CB_COST_MEM,POS_MEM,POS_ID
125      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: LU_USAGE
126      INTEGER(8), DIMENSION(:), ALLOCATABLE, SAVE,
127     &        PRIVATE::MD_MEM, TAB_MAXS
128      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE ::MEM_SUBTREE
129      INTEGER  :: NB_SUBTREES,NIV1_FLAG
130      INTEGER, PRIVATE  :: INDICE_SBTR,INDICE_SBTR_ARRAY
131      INTEGER,SAVE :: INSIDE_SUBTREE
132      PUBLIC :: NB_SUBTREES,MEM_SUBTREE,INSIDE_SUBTREE,NIV1_FLAG
133      DOUBLE PRECISION, SAVE, PRIVATE :: DM_SUMLU,
134     &                   DM_THRES_MEM
135      DOUBLE PRECISION, DIMENSION(:),
136     &   ALLOCATABLE, SAVE , PRIVATE:: DM_MEM
137      INTEGER, SAVE, PRIVATE :: POOL_SIZE,ID_MAX_M2
138      DOUBLE PRECISION, SAVE, PRIVATE :: MAX_M2,TMP_M2
139      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE, PRIVATE:: POOL_NIV2
140      DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE,SAVE,
141     &      PRIVATE :: POOL_NIV2_COST, NIV2
142      DOUBLE PRECISION, SAVE, PRIVATE  ::      CHK_LD
143      INTEGER, DIMENSION(:),POINTER, SAVE, PRIVATE  ::
144     &         PROCNODE_LOAD, STEP_TO_NIV2_LOAD
145      INTEGER, DIMENSION(:),POINTER, SAVE, PRIVATE  :: KEEP_LOAD
146      INTEGER, SAVE, PRIVATE :: N_LOAD
147      INTEGER(8), DIMENSION(:), POINTER, SAVE, PRIVATE:: KEEP8_LOAD
148      INTEGER, DIMENSION(:),POINTER, SAVE ::
149     &         FILS_LOAD, STEP_LOAD,
150     &         FRERE_LOAD, ND_LOAD,
151     &         NE_LOAD,DAD_LOAD
152      INTEGER, DIMENSION(:,:),POINTER, SAVE, PRIVATE :: CAND_LOAD
153      INTEGER, DIMENSION(:),POINTER, SAVE,
154     &         PRIVATE :: MY_FIRST_LEAF,MY_NB_LEAF, MY_ROOT_SBTR
155      INTEGER, DIMENSION(:),ALLOCATABLE,SAVE,
156     &         PRIVATE ::SBTR_FIRST_POS_IN_POOL
157      DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE,SAVE,
158     &         PRIVATE ::SBTR_PEAK_ARRAY,
159     &     SBTR_CUR_ARRAY
160      DOUBLE PRECISION,DIMENSION(:),POINTER, SAVE :: COST_TRAV
161      INTEGER, DIMENSION(:),POINTER, SAVE :: DEPTH_FIRST_LOAD,
162     &     DEPTH_FIRST_SEQ_LOAD,SBTR_ID_LOAD
163      PUBLIC :: DEPTH_FIRST_LOAD,COST_TRAV, FILS_LOAD,STEP_LOAD,
164     &     FRERE_LOAD, ND_LOAD,NE_LOAD,DAD_LOAD,
165     &     DEPTH_FIRST_SEQ_LOAD,SBTR_ID_LOAD
166      INTEGER, SAVE     :: ROOT_CURRENT_SUBTREE,CURRENT_BEST,
167     &     SECOND_CURRENT_BEST
168      PUBLIC :: ROOT_CURRENT_SUBTREE,CURRENT_BEST,
169     &     SECOND_CURRENT_BEST
170      CONTAINS
171      SUBROUTINE SMUMPS_188( COST_SUBTREE_ARG, K64, K66,
172     &     MAXS )
173      IMPLICIT NONE
174      DOUBLE PRECISION COST_SUBTREE_ARG
175      INTEGER K64, K66
176      INTEGER(8)::MAXS
177      DOUBLE PRECISION T64, T66
178      T64 = max ( dble(K64), dble(1) )
179      T64 = min ( T64, dble(1000)  )
180      T66 = max (dble(K66), dble(100))
181      MIN_DIFF     =  ( T64 / dble(1000)  )*
182     &                  T66 * dble(1000000)
183      DM_THRES_MEM = dble(MAXS/1000_8)
184      COST_SUBTREE = COST_SUBTREE_ARG
185      END SUBROUTINE SMUMPS_188
186      SUBROUTINE SMUMPS_791 (
187     &      INODE, STEP, N, SLAVEF,
188     &      PROCNODE_STEPS, KEEP, DAD, FILS,
189     &      CAND, ICNTL, COPY_CAND,
190     &      NBSPLIT, NUMORG_SPLIT, SLAVES_LIST,
191     &      SIZE_SLAVES_LIST
192     &                                    )
193      IMPLICIT NONE
194       INTEGER, intent(in) :: INODE, N, SIZE_SLAVES_LIST, SLAVEF,
195     &                        KEEP(500)
196       INTEGER, intent(in) :: STEP(N), DAD (KEEP(28)), ICNTL(40),
197     &                        PROCNODE_STEPS(KEEP(28)), CAND(SLAVEF+1),
198     &                        FILS(N)
199       INTEGER, intent(out)   :: NBSPLIT, NUMORG_SPLIT
200       INTEGER, intent(inout) :: SLAVES_LIST(SIZE_SLAVES_LIST),
201     &                           COPY_CAND(SLAVEF+1)
202       INTEGER :: IN, LP, II
203       INTEGER  MUMPS_810
204       EXTERNAL MUMPS_810
205       LP = ICNTL(1)
206       IN = INODE
207       NBSPLIT = 0
208       NUMORG_SPLIT = 0
209       DO WHILE
210     &      (
211     &        ( MUMPS_810
212     &           (PROCNODE_STEPS(STEP(DAD(STEP(IN)))),SLAVEF)
213     &           .EQ.5
214     &        )
215     &        .OR.
216     &        ( MUMPS_810
217     &           (PROCNODE_STEPS(STEP(DAD(STEP(IN)))),SLAVEF)
218     &           .EQ.6
219     &        )
220     &      )
221           NBSPLIT = NBSPLIT + 1
222           IN = DAD(STEP(IN))
223           II = IN
224           DO WHILE (II.GT.0)
225             NUMORG_SPLIT = NUMORG_SPLIT + 1
226             II = FILS(II)
227           ENDDO
228       END DO
229      SLAVES_LIST(1:NBSPLIT) = CAND(1:NBSPLIT)
230      COPY_CAND(1:SIZE_SLAVES_LIST-NBSPLIT) =
231     &                   CAND(1+NBSPLIT:SIZE_SLAVES_LIST)
232      COPY_CAND(SIZE_SLAVES_LIST-NBSPLIT+1:SLAVEF) = -1
233      COPY_CAND(SLAVEF+1) = SIZE_SLAVES_LIST-NBSPLIT
234      RETURN
235      END SUBROUTINE SMUMPS_791
236      SUBROUTINE SMUMPS_790 (
237     &      INODE, STEP, N, SLAVEF, NBSPLIT, NCB,
238     &      PROCNODE_STEPS, KEEP, DAD, FILS, ICNTL,
239     &      TAB_POS, NSLAVES_NODE
240     &                                    )
241      IMPLICIT NONE
242       INTEGER, intent(in) :: INODE, N, SLAVEF, NCB,
243     &                        KEEP(500), NBSPLIT
244       INTEGER, intent(in) :: STEP(N), DAD (KEEP(28)), ICNTL(40),
245     &                        PROCNODE_STEPS(KEEP(28)),
246     &                        FILS(N)
247       INTEGER, intent(inout) :: TAB_POS ( SLAVEF+2 ), NSLAVES_NODE
248       INTEGER :: IN, LP, II, NUMORG, NBSPLIT_LOC, I
249       INTEGER  MUMPS_810
250       EXTERNAL MUMPS_810
251       DO I= NSLAVES_NODE+1, 1, -1
252          TAB_POS(I+NBSPLIT) = TAB_POS(I)
253       END DO
254       LP = ICNTL(1)
255       IN = INODE
256       NBSPLIT_LOC = 0
257       NUMORG = 0
258       TAB_POS(1) = 1
259       DO WHILE
260     &      (
261     &        ( MUMPS_810
262     &           (PROCNODE_STEPS(STEP(DAD(STEP(IN)))),SLAVEF)
263     &           .EQ.5
264     &        )
265     &        .OR.
266     &        ( MUMPS_810
267     &           (PROCNODE_STEPS(STEP(DAD(STEP(IN)))),SLAVEF)
268     &           .EQ.6
269     &        )
270     &      )
271           NBSPLIT_LOC = NBSPLIT_LOC + 1
272           IN = DAD(STEP(IN))
273           II = IN
274           DO WHILE (II.GT.0)
275             NUMORG = NUMORG + 1
276             II = FILS(II)
277           ENDDO
278           TAB_POS(NBSPLIT_LOC+1) = NUMORG + 1
279       END DO
280       DO I = NBSPLIT+2, NBSPLIT+NSLAVES_NODE+1
281         TAB_POS(I) = TAB_POS(I) + NUMORG
282       ENDDO
283      NSLAVES_NODE = NSLAVES_NODE + NBSPLIT
284      TAB_POS (NSLAVES_NODE+2:SLAVEF+1) = -9999
285      TAB_POS ( SLAVEF+2 ) =  NSLAVES_NODE
286      RETURN
287      END SUBROUTINE SMUMPS_790
288      SUBROUTINE SMUMPS_792 (
289     &      INODE, TYPESPLIT, IFSON,
290     &      SON_SLAVE_LIST, NSLSON,
291     &      STEP, N, SLAVEF, NBSPLIT, NCB,
292     &      PROCNODE_STEPS, KEEP, DAD, FILS, ICNTL,
293     &      ISTEP_TO_INIV2, INIV2,
294     &      TAB_POS_IN_PERE, NSLAVES_NODE,
295     &      SLAVES_LIST, SIZE_SLAVES_LIST
296     &                                    )
297      IMPLICIT NONE
298       INTEGER, intent(in) :: INODE, TYPESPLIT, IFSON, N, SLAVEF,
299     &                        NCB, KEEP(500), NBSPLIT,
300     &                        NSLSON, SIZE_SLAVES_LIST
301       INTEGER, intent(in) :: STEP(N), DAD (KEEP(28)), ICNTL(40),
302     &                        PROCNODE_STEPS(KEEP(28)),
303     &                        FILS(N), INIV2,
304     &                        SON_SLAVE_LIST (NSLSON),
305     &                        ISTEP_TO_INIV2(KEEP(71))
306       INTEGER, intent(out)   ::  NSLAVES_NODE
307       INTEGER, intent(inout) ::
308     &                   TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
309       INTEGER, intent(out)   :: SLAVES_LIST (SIZE_SLAVES_LIST)
310       INTEGER :: IN, LP, I, NSLAVES_SONS,
311     &            INIV2_FILS, ISHIFT
312       LP = ICNTL(1)
313       IN = INODE
314      INIV2_FILS = ISTEP_TO_INIV2( STEP( IFSON ))
315      NSLAVES_SONS = TAB_POS_IN_PERE (SLAVEF+2, INIV2_FILS)
316      TAB_POS_IN_PERE (1,INIV2) = 1
317      ISHIFT  = TAB_POS_IN_PERE (2, INIV2_FILS) -1
318      DO I = 2, NSLAVES_SONS
319         TAB_POS_IN_PERE (I,INIV2) =
320     &            TAB_POS_IN_PERE (I+1,INIV2_FILS) - ISHIFT
321         SLAVES_LIST(I-1) =  SON_SLAVE_LIST (I)
322      END DO
323      TAB_POS_IN_PERE(NSLAVES_SONS+1:SLAVEF+1,INIV2) = -9999
324      NSLAVES_NODE = NSLAVES_SONS - 1
325      TAB_POS_IN_PERE (SLAVEF+2, INIV2) = NSLAVES_NODE
326      RETURN
327      END SUBROUTINE SMUMPS_792
328      SUBROUTINE SMUMPS_472(
329     &  NCBSON_MAX, SLAVEF,
330     &  KEEP,KEEP8,ICNTL,
331     &  CAND_OF_NODE,
332     &  MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE,
333     &  TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST,INODE)
334       IMPLICIT NONE
335      INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST
336      INTEGER(8) KEEP8(150)
337      INTEGER, intent(in) :: ICNTL(40)
338      INTEGER, intent(in) :: SLAVEF, NFRONT
339      INTEGER, intent (inout) ::NCB
340      INTEGER, intent(in) :: CAND_OF_NODE(SLAVEF+1)
341      INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE
342      INTEGER, intent(in) :: NCBSON_MAX
343      INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
344      INTEGER, intent(out):: TAB_POS(SLAVEF+2)
345      INTEGER, intent(out):: NSLAVES_NODE
346      INTEGER i
347      INTEGER LP,MP
348      LP=ICNTL(4)
349      MP=ICNTL(2)
350      IF ( KEEP(48) == 0 .OR. KEEP(48) .EQ. 3 ) THEN
351         CALL SMUMPS_499(
352     &        SLAVEF,
353     &        KEEP,KEEP8,
354     &        CAND_OF_NODE,
355     &        MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE,
356     &        TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST)
357      ELSE IF ( KEEP(48) == 4 ) THEN
358         CALL SMUMPS_504(
359     &        SLAVEF,
360     &        KEEP,KEEP8,
361     &        CAND_OF_NODE,
362     &        MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE,
363     &        TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST,MYID)
364         DO i=1,NSLAVES_NODE
365            IF(TAB_POS(i+1)-TAB_POS(i).LE.0)THEN
366               WRITE(*,*)'probleme de partition dans
367     &SMUMPS_545'
368               CALL MUMPS_ABORT()
369            ENDIF
370         ENDDO
371      ELSE IF ( KEEP(48) == 5 ) THEN
372         CALL SMUMPS_518(
373     &        NCBSON_MAX,
374     &        SLAVEF,
375     &        KEEP,KEEP8,
376     &        CAND_OF_NODE,
377     &        MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE,
378     &        TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST,MYID,INODE,
379     &        MP,LP)
380         DO i=1,NSLAVES_NODE
381            IF(TAB_POS(i+1)-TAB_POS(i).LE.0)THEN
382               WRITE(*,*)'problem with partition in
383     &SMUMPS_518'
384               CALL MUMPS_ABORT()
385            ENDIF
386         ENDDO
387      ELSE
388        WRITE(*,*) "Strategy 6 not implemented"
389        CALL MUMPS_ABORT()
390      ENDIF
391      RETURN
392      END SUBROUTINE SMUMPS_472
393      SUBROUTINE SMUMPS_499(
394     &  SLAVEF,
395     &  KEEP,KEEP8,
396     &  CAND_OF_NODE,
397     &  MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE,
398     &  TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST)
399      IMPLICIT NONE
400      INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST
401      INTEGER(8) KEEP8(150)
402      INTEGER, intent(in) :: SLAVEF, NFRONT, NCB
403      INTEGER, intent(in) :: CAND_OF_NODE(SLAVEF+1)
404      INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1)
405      INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
406      INTEGER, intent(out):: TAB_POS(SLAVEF+2)
407      INTEGER, intent(out):: NSLAVES_NODE
408      INTEGER ITEMP, NMB_OF_CAND, NSLAVES_LESS
409      DOUBLE PRECISION MSG_SIZE
410      LOGICAL FORCE_CAND
411      INTEGER  MUMPS_12
412      EXTERNAL MUMPS_12
413      IF ( KEEP(48) == 0 .AND. KEEP(50) .NE. 0) THEN
414      write(*,*) "Internal error 2 in SMUMPS_499."
415      CALL MUMPS_ABORT()
416      END IF
417      IF ( KEEP(48) == 3 .AND. KEEP(50) .EQ. 0) THEN
418      write(*,*) "Internal error 3 in SMUMPS_499."
419      CALL MUMPS_ABORT()
420      END IF
421      MSG_SIZE = dble( NFRONT - NCB ) * dble(NCB)
422      IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN
423        FORCE_CAND = .FALSE.
424      ELSE
425        FORCE_CAND = (mod(KEEP(24),2).eq.0)
426      END IF
427      IF (FORCE_CAND) THEN
428        ITEMP=SMUMPS_409
429     &       (MEM_DISTRIB,
430     &        CAND_OF_NODE,
431     &
432     &        KEEP(69), SLAVEF, MSG_SIZE,
433     &        NMB_OF_CAND )
434      ELSE
435        ITEMP=SMUMPS_186(KEEP(69),MEM_DISTRIB,MSG_SIZE)
436        NMB_OF_CAND = SLAVEF - 1
437      END IF
438      NSLAVES_LESS = max(ITEMP,1)
439      NSLAVES_NODE = MUMPS_12(KEEP8(21), KEEP(48),
440     &          KEEP(50),SLAVEF,
441     &          NCB, NFRONT, NSLAVES_LESS, NMB_OF_CAND)
442      CALL MUMPS_441(
443     &            KEEP,KEEP8, SLAVEF,
444     &            TAB_POS,
445     &            NSLAVES_NODE, NFRONT, NCB
446     &             )
447      IF (FORCE_CAND) THEN
448        CALL SMUMPS_384(MEM_DISTRIB(0),
449     &       CAND_OF_NODE, SLAVEF, NSLAVES_NODE,
450     &       SLAVES_LIST)
451      ELSE
452        CALL SMUMPS_189(MEM_DISTRIB(0),
453     &       MSG_SIZE, SLAVES_LIST, NSLAVES_NODE)
454      ENDIF
455      RETURN
456      END SUBROUTINE SMUMPS_499
457      SUBROUTINE SMUMPS_185( id, MEMORY_MD_ARG, MAXS )
458      USE SMUMPS_COMM_BUFFER
459      USE SMUMPS_STRUC_DEF
460      IMPLICIT NONE
461      TYPE(SMUMPS_STRUC), TARGET :: id
462      INTEGER(8), intent(in) :: MEMORY_MD_ARG
463      INTEGER(8), intent(in) :: MAXS
464      INTEGER K34_LOC,K35_LOC
465      INTEGER allocok, IERR, i, BUF_LOAD_SIZE
466      DOUBLE PRECISION :: MAX_SBTR
467      DOUBLE PRECISION ZERO
468      DOUBLE PRECISION MEMORY_SENT
469      INTEGER,DIMENSION(:),POINTER:: KEEP
470      PARAMETER( ZERO=0.0d0 )
471      INTEGER WHAT
472      INTEGER(8) MEMORY_MD, LA
473      STEP_TO_NIV2_LOAD=>id%ISTEP_TO_INIV2
474      CAND_LOAD=>id%CANDIDATES
475      ND_LOAD=>id%ND_STEPS
476      KEEP_LOAD=>id%KEEP
477      KEEP     =>id%KEEP
478      KEEP8_LOAD=>id%KEEP8
479      FILS_LOAD=>id%FILS
480      FRERE_LOAD=>id%FRERE_STEPS
481      DAD_LOAD=>id%DAD_STEPS
482      PROCNODE_LOAD=>id%PROCNODE_STEPS
483      STEP_LOAD=>id%STEP
484      NE_LOAD=>id%NE_STEPS
485      N_LOAD=id%N
486      ROOT_CURRENT_SUBTREE=-9999
487      MEMORY_MD=MEMORY_MD_ARG
488      LA=MAXS
489      MAX_SURF_MASTER=id%MAX_SURF_MASTER+
490     & (int(id%KEEP(12),8)*int(id%MAX_SURF_MASTER,8)/int(100,8))
491      COMM_LD = id%COMM_LOAD
492      MAX_PEAK_STK = 0.0D0
493      K69  = KEEP(69)
494      IF ( KEEP(47) .le. 0 .OR. KEEP(47) .gt. 4 ) THEN
495        write(*,*) "Internal error 1 in SMUMPS_185"
496        CALL MUMPS_ABORT()
497      END IF
498      CHK_LD=dble(0)
499      BDC_MEM      = ( KEEP(47) >= 2 )
500      BDC_POOL     = ( KEEP(47) >= 3 )
501      BDC_SBTR     = ( KEEP(47) >= 4 )
502      BDC_M2_MEM   = ( ( KEEP(80) == 2 .OR. KEEP(80) == 3 )
503     &             .AND. KEEP(47) == 4 )
504      BDC_M2_FLOPS   = ( KEEP(80) == 1
505     &             .AND. KEEP(47) .GE. 1 )
506      BDC_MD       = (KEEP(86)==1)
507      SBTR_WHICH_M       = KEEP(90)
508      REMOVE_NODE_FLAG=.FALSE.
509      REMOVE_NODE_FLAG_MEM=.FALSE.
510      REMOVE_NODE_COST_MEM=dble(0)
511      REMOVE_NODE_COST=dble(0)
512      IF (KEEP(80) .LT. 0 .OR. KEEP(80)>3) THEN
513        WRITE(*,*) "Unimplemented KEEP(80) Strategy"
514        CALL MUMPS_ABORT()
515      ENDIF
516      IF ((KEEP(80) == 2 .OR. KEEP(80)==3 ).AND. KEEP(47).NE.4)
517     &  THEN
518        WRITE(*,*) "Internal error 3 in SMUMPS_185"
519         CALL MUMPS_ABORT()
520      END IF
521      IF (KEEP(81) == 1 .AND. KEEP(47) < 2) THEN
522        WRITE(*,*) "Internal error 2 in SMUMPS_185"
523        CALL MUMPS_ABORT()
524      ENDIF
525      BDC_POOL_MNG = ((KEEP(81) == 1).AND.(KEEP(47) >= 2))
526      IF(KEEP(76).EQ.4)THEN
527         DEPTH_FIRST_LOAD=>id%DEPTH_FIRST
528      ENDIF
529      IF(KEEP(76).EQ.5)THEN
530         COST_TRAV=>id%COST_TRAV
531      ENDIF
532      IF(KEEP(76).EQ.6)THEN
533         DEPTH_FIRST_LOAD=>id%DEPTH_FIRST
534         DEPTH_FIRST_SEQ_LOAD=>id%DEPTH_FIRST_SEQ
535         SBTR_ID_LOAD=>id%SBTR_ID
536      ENDIF
537      IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN
538         ALLOCATE(NIV2(id%NSLAVES), NB_SON(KEEP(28)),
539     &            POOL_NIV2(100),POOL_NIV2_COST(100),
540     &            stat=allocok)
541         NB_SON=id%NE_STEPS
542         NIV2=dble(0)
543         IF (allocok > 0) THEN
544           WRITE(*,*) 'PB allocation in SMUMPS_185'
545           id%INFO(1) = -13
546           id%INFO(2) = id%NSLAVES + KEEP(28) + 200
547           RETURN
548         ENDIF
549      ENDIF
550      K50      = id%KEEP(50)
551      CALL MPI_COMM_RANK( COMM_LD, MYID, IERR )
552      NPROCS = id%NSLAVES
553      DM_SUMLU=ZERO
554      POOL_SIZE=0
555      IF(BDC_MD)THEN
556         IF ( allocated(MD_MEM) ) DEALLOCATE(MD_MEM)
557         ALLOCATE( MD_MEM( 0: NPROCS - 1 ), stat=allocok )
558         IF ( allocok .gt. 0 ) THEN
559            WRITE(*,*) 'PB allocation in SMUMPS_185'
560            id%INFO(1) = -13
561            id%INFO(2) = NPROCS
562            RETURN
563         END IF
564         IF ( allocated(TAB_MAXS) ) DEALLOCATE(TAB_MAXS)
565         ALLOCATE( TAB_MAXS( 0: NPROCS - 1 ), stat=allocok )
566         IF ( allocok .gt. 0 ) THEN
567            WRITE(*,*) 'PB allocation in SMUMPS_185'
568            id%INFO(1) = -13
569            id%INFO(2) = NPROCS
570            RETURN
571         END IF
572         TAB_MAXS=0_8
573         IF ( allocated(LU_USAGE) ) DEALLOCATE(LU_USAGE)
574         ALLOCATE( LU_USAGE( 0: NPROCS - 1 ), stat=allocok )
575         IF ( allocok .gt. 0 ) THEN
576            WRITE(*,*) 'PB allocation in SMUMPS_185'
577            id%INFO(1) = -13
578            id%INFO(2) = NPROCS
579            RETURN
580         END IF
581         LU_USAGE=dble(0)
582         MD_MEM=int(0,8)
583      ENDIF
584      IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN
585         ALLOCATE(CB_COST_MEM(2*2000*id%NSLAVES),
586     &            stat=allocok)
587         IF (allocok > 0) THEN
588           WRITE(*,*) 'PB allocation in SMUMPS_185'
589           id%INFO(1) = -13
590           id%INFO(2) = id%NSLAVES
591           RETURN
592         ENDIF
593         CB_COST_MEM=int(0,8)
594         ALLOCATE(CB_COST_ID(2000*3),
595     &            stat=allocok)
596         IF (allocok > 0) THEN
597           WRITE(*,*) 'PB allocation in SMUMPS_185'
598           id%INFO(1) = -13
599           id%INFO(2) = id%NSLAVES
600           RETURN
601         ENDIF
602         CB_COST_ID=0
603         POS_MEM=1
604         POS_ID=1
605      ENDIF
606#if ! defined(OLD_LOAD_MECHANISM)
607      ALLOCATE(FUTURE_NIV2(NPROCS), stat=allocok)
608      IF (allocok > 0 ) THEN
609         WRITE(*,*) 'PB allocation in SMUMPS_185'
610         id%INFO(1) = -13
611         id%INFO(2) = NPROCS
612         RETURN
613      ENDIF
614      DO i = 1, NPROCS
615        FUTURE_NIV2(i) = id%FUTURE_NIV2(i)
616        IF(BDC_MD)THEN
617           IF(FUTURE_NIV2(i).EQ.0)THEN
618              MD_MEM(i-1)=999999999_8
619           ENDIF
620        ENDIF
621      ENDDO
622      DELTA_MEM=ZERO
623      DELTA_LOAD=ZERO
624#endif
625      CHECK_MEM=0_8
626#if defined(OLD_LOAD_MECHANISM)
627#if defined(CHECK_COHERENCE)
628      NB_LEVEL2=0
629      AMI_CHOSEN=.FALSE.
630      IS_DISPLAYED=.FALSE.
631#endif
632#endif
633      IF(BDC_SBTR.OR.BDC_POOL_MNG)THEN
634         NB_SUBTREES=id%NBSA_LOCAL
635         IF (allocated(MEM_SUBTREE)) DEALLOCATE(MEM_SUBTREE)
636         ALLOCATE(MEM_SUBTREE(id%NBSA_LOCAL),stat=allocok)
637         DO i=1,id%NBSA_LOCAL
638            MEM_SUBTREE(i)=id%MEM_SUBTREE(i)
639         ENDDO
640         MY_FIRST_LEAF=>id%MY_FIRST_LEAF
641         MY_NB_LEAF=>id%MY_NB_LEAF
642         MY_ROOT_SBTR=>id%MY_ROOT_SBTR
643         IF (allocated(SBTR_FIRST_POS_IN_POOL))
644     &        DEALLOCATE(SBTR_FIRST_POS_IN_POOL)
645         ALLOCATE(SBTR_FIRST_POS_IN_POOL(id%NBSA_LOCAL),stat=allocok)
646         INSIDE_SUBTREE=0
647         PEAK_SBTR_CUR_LOCAL = dble(0)
648         SBTR_CUR_LOCAL      = dble(0)
649         IF (allocated(SBTR_PEAK_ARRAY)) DEALLOCATE(SBTR_PEAK_ARRAY)
650         ALLOCATE(SBTR_PEAK_ARRAY(id%NBSA_LOCAL),stat=allocok)
651         SBTR_PEAK_ARRAY=dble(0)
652         IF (allocated(SBTR_CUR_ARRAY)) DEALLOCATE(SBTR_CUR_ARRAY)
653         ALLOCATE(SBTR_CUR_ARRAY(id%NBSA_LOCAL),stat=allocok)
654         SBTR_CUR_ARRAY=dble(0)
655         INDICE_SBTR_ARRAY=1
656         NIV1_FLAG=0
657         INDICE_SBTR=1
658      ENDIF
659      IF ( allocated(LOAD_FLOPS) ) DEALLOCATE( LOAD_FLOPS )
660      ALLOCATE( LOAD_FLOPS( 0: NPROCS - 1 ), stat=allocok )
661      IF ( allocok .gt. 0 ) THEN
662         WRITE(*,*) 'PB allocation in SMUMPS_185'
663         id%INFO(1) = -13
664         id%INFO(2) = NPROCS
665         RETURN
666      END IF
667      IF ( allocated(WLOAD) ) DEALLOCATE( WLOAD )
668      ALLOCATE( WLOAD( NPROCS ), stat=allocok )
669      IF ( allocok .gt. 0 ) THEN
670         WRITE(*,*) 'PB allocation in SMUMPS_185'
671         id%INFO(1) = -13
672         id%INFO(2) = NPROCS
673         RETURN
674      END IF
675      IF ( allocated(IDWLOAD) ) DEALLOCATE( IDWLOAD )
676      ALLOCATE( IDWLOAD( NPROCS ), stat=allocok )
677      IF ( allocok .gt. 0 ) THEN
678         WRITE(*,*) 'PB allocation in SMUMPS_185'
679         id%INFO(1) = -13
680         id%INFO(2) = NPROCS
681         RETURN
682      END IF
683      IF ( BDC_MEM ) THEN
684        IF ( allocated(DM_MEM) ) DEALLOCATE( DM_MEM )
685        ALLOCATE( DM_MEM( 0:NPROCS-1 ), stat=allocok )
686        IF ( allocok .gt. 0 ) THEN
687           WRITE(*,*) 'PB allocation in SMUMPS_185'
688           id%INFO(1) = -13
689           id%INFO(2) = NPROCS
690           RETURN
691        END IF
692      END IF
693      IF ( BDC_POOL ) THEN
694        IF ( allocated(POOL_MEM) ) DEALLOCATE(POOL_MEM)
695        ALLOCATE( POOL_MEM(0: NPROCS -1), stat=allocok)
696        IF ( allocok .gt. 0 ) THEN
697           WRITE(*,*) 'PB allocation in SMUMPS_185'
698           id%INFO(1) = -13
699           id%INFO(2) = NPROCS
700           RETURN
701        END IF
702        POOL_MEM = dble(0)
703        POOL_LAST_COST_SENT = dble(0)
704      END IF
705      IF ( BDC_SBTR ) THEN
706        IF ( allocated(SBTR_MEM) ) DEALLOCATE(SBTR_MEM)
707        ALLOCATE( SBTR_MEM(0: NPROCS -1), stat=allocok)
708        IF ( allocok .gt. 0 ) THEN
709           WRITE(*,*) 'PB allocation in SMUMPS_185'
710           id%INFO(1) = -13
711           id%INFO(2) = NPROCS
712           RETURN
713        END IF
714        IF ( allocated(SBTR_CUR) ) DEALLOCATE(SBTR_CUR)
715        ALLOCATE( SBTR_CUR(0: NPROCS -1), stat=allocok)
716        IF ( allocok .gt. 0 ) THEN
717           WRITE(*,*) 'PB allocation in SMUMPS_185'
718           id%INFO(1) = -13
719           id%INFO(2) = NPROCS
720           RETURN
721        END IF
722        SBTR_CUR = dble(0)
723        SBTR_MEM = dble(0)
724      END IF
725      CALL MUMPS_546(K34_LOC,K35_LOC)
726      K35  = K35_LOC
727      BUF_LOAD_SIZE = K34_LOC * 2 * ( NPROCS - 1 ) +
728     &                NPROCS * ( K35_LOC + K34_LOC )
729      IF (BDC_MEM) THEN
730        BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC
731      END IF
732      IF (BDC_SBTR)THEN
733        BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35_LOC
734      ENDIF
735      LBUF_LOAD_RECV = (BUF_LOAD_SIZE+K34_LOC)/K34_LOC
736      LBUF_LOAD_RECV_BYTES = LBUF_LOAD_RECV * K34_LOC
737      IF ( allocated(BUF_LOAD_RECV) ) DEALLOCATE(BUF_LOAD_RECV)
738      ALLOCATE( BUF_LOAD_RECV( LBUF_LOAD_RECV), stat=allocok)
739      IF ( allocok > 0 ) THEN
740        WRITE(*,*) 'PB allocation in SMUMPS_185'
741        id%INFO(1) = -13
742        id%INFO(2) = LBUF_LOAD_RECV
743        RETURN
744      ENDIF
745      BUF_LOAD_SIZE = BUF_LOAD_SIZE * 20
746      CALL SMUMPS_54( BUF_LOAD_SIZE, IERR )
747      IF ( IERR .LT. 0 ) THEN
748         id%INFO(1) = -13
749         id%INFO(2) = BUF_LOAD_SIZE
750         RETURN
751      END IF
752      DO i = 0, NPROCS - 1
753         LOAD_FLOPS( i ) = ZERO
754      END DO
755#if defined(OLD_LOAD_MECHANISM)
756      LOAD_FLOPS( MYID ) = COST_SUBTREE
757      LAST_LOAD_SENT = ZERO
758#endif
759      IF ( BDC_MEM ) THEN
760        DO i = 0, NPROCS - 1
761          DM_MEM( i )=ZERO
762        END DO
763#if defined(OLD_LOAD_MECHANISM)
764        DM_LAST_MEM_SENT=ZERO
765#endif
766      ENDIF
767      CALL SMUMPS_425(KEEP(69))
768      IF(BDC_MD)THEN
769         MAX_SBTR=0.0D0
770         IF(BDC_SBTR)THEN
771            DO i=1,id%NBSA_LOCAL
772               MAX_SBTR=max(id%MEM_SUBTREE(i),MAX_SBTR)
773            ENDDO
774         ENDIF
775         MD_MEM(MYID)=MEMORY_MD
776         WHAT=8
777         CALL SMUMPS_460( WHAT,
778     &        COMM_LD, NPROCS,
779#if ! defined(OLD_LOAD_MECHANISM)
780     &        FUTURE_NIV2,
781#endif
782     &        dble(MEMORY_MD),dble(0) ,MYID, IERR  )
783         WHAT=9
784         MEMORY_SENT = dble(LA-MAX_SURF_MASTER)-MAX_SBTR
785     &      - max( dble(LA) * dble(3) / dble(100),
786     &      dble(2) * dble(max(KEEP(5),KEEP(6))) * dble(KEEP(127)))
787         IF (KEEP(12) > 25) THEN
788           MEMORY_SENT = MEMORY_SENT -
789     &                   dble(KEEP(12))*0.2d0*dble(LA)/100.0d0
790         ENDIF
791         TAB_MAXS(MYID)=int(MEMORY_SENT,8)
792         CALL SMUMPS_460( WHAT,
793     &        COMM_LD, NPROCS,
794#if ! defined(OLD_LOAD_MECHANISM)
795     &        FUTURE_NIV2,
796#endif
797     &        MEMORY_SENT,
798     &        dble(0),MYID, IERR  )
799      ENDIF
800      RETURN
801      END SUBROUTINE SMUMPS_185
802      SUBROUTINE SMUMPS_190( CHECK_FLOPS,PROCESS_BANDE,
803     &     INC_LOAD, KEEP,KEEP8 )
804      USE SMUMPS_COMM_BUFFER
805      IMPLICIT NONE
806      DOUBLE PRECISION INC_LOAD
807      INTEGER KEEP(500)
808      INTEGER(8) KEEP8(150)
809      LOGICAL PROCESS_BANDE
810      INTEGER CHECK_FLOPS
811      INTEGER IERR
812      DOUBLE PRECISION ZERO, SEND_MEM, SEND_LOAD,SBTR_TMP
813      PARAMETER( ZERO=0.0d0 )
814      INTRINSIC max, abs
815      IF (INC_LOAD == 0.0D0) THEN
816         IF(REMOVE_NODE_FLAG)THEN
817            REMOVE_NODE_FLAG=.FALSE.
818         ENDIF
819         RETURN
820      ENDIF
821      IF((CHECK_FLOPS.NE.0).AND.
822     &     (CHECK_FLOPS.NE.1).AND.(CHECK_FLOPS.NE.2))THEN
823         WRITE(*,*)MYID,': Bad value for CHECK_FLOPS'
824         CALL MUMPS_ABORT()
825      ENDIF
826      IF(CHECK_FLOPS.EQ.1)THEN
827         CHK_LD=CHK_LD+INC_LOAD
828      ELSE
829         IF(CHECK_FLOPS.EQ.2)THEN
830            RETURN
831         ENDIF
832      ENDIF
833#if ! defined(OLD_LOAD_MECHANISM)
834      IF ( PROCESS_BANDE ) THEN
835         RETURN
836      ENDIF
837#endif
838      LOAD_FLOPS( MYID ) = max( LOAD_FLOPS( MYID ) + INC_LOAD, ZERO)
839      IF(BDC_M2_FLOPS.AND.REMOVE_NODE_FLAG)THEN
840         IF(INC_LOAD.NE.REMOVE_NODE_COST)THEN
841            IF(INC_LOAD.GT.REMOVE_NODE_COST)THEN
842#if ! defined(OLD_LOAD_MECHANISM)
843               DELTA_LOAD = DELTA_LOAD +
844     &              (INC_LOAD-REMOVE_NODE_COST)
845               GOTO 888
846#else
847               GOTO 888
848#endif
849            ELSE
850#if ! defined(OLD_LOAD_MECHANISM)
851               DELTA_LOAD = DELTA_LOAD -
852     &              (REMOVE_NODE_COST-INC_LOAD)
853               GOTO 888
854#else
855               GOTO 888
856#endif
857            ENDIF
858         ENDIF
859         GOTO 333
860      ENDIF
861#if ! defined(OLD_LOAD_MECHANISM)
862      DELTA_LOAD = DELTA_LOAD + INC_LOAD
863 888  CONTINUE
864      IF ( DELTA_LOAD > MIN_DIFF .OR. DELTA_LOAD < -MIN_DIFF) THEN
865         SEND_LOAD = DELTA_LOAD
866         IF (BDC_MEM) THEN
867           SEND_MEM = DELTA_MEM
868         ELSE
869           SEND_MEM = ZERO
870         END IF
871#else
872 888   CONTINUE
873       IF ( abs( LOAD_FLOPS ( MYID ) -
874     &      LAST_LOAD_SENT ).GT.MIN_DIFF)THEN
875          IERR = 0
876          SEND_LOAD  = LOAD_FLOPS( MYID )
877          IF ( BDC_MEM ) THEN
878             SEND_MEM = DM_MEM(MYID)
879          ELSE
880             SEND_MEM = ZERO
881          END IF
882#endif
883         IF(BDC_SBTR)THEN
884           SBTR_TMP=SBTR_CUR(MYID)
885         ELSE
886           SBTR_TMP=dble(0)
887         ENDIF
888 111     CONTINUE
889         CALL SMUMPS_77( BDC_SBTR,BDC_MEM,
890     &        BDC_MD,COMM_LD, NPROCS,
891     &        SEND_LOAD,
892     &        SEND_MEM,SBTR_TMP,
893     &        DM_SUMLU,
894#if ! defined(OLD_LOAD_MECHANISM)
895     &        FUTURE_NIV2,
896#endif
897     &        MYID, IERR )
898           IF ( IERR == -1 )THEN
899             CALL SMUMPS_467(COMM_LD, KEEP)
900             GOTO 111
901           ELSE IF ( IERR .NE.0 ) THEN
902             WRITE(*,*) "Internal Error in SMUMPS_190",IERR
903             CALL MUMPS_ABORT()
904           ENDIF
905         IF ( IERR .EQ. 0 ) THEN
906#if ! defined(OLD_LOAD_MECHANISM)
907           DELTA_LOAD = ZERO
908           IF (BDC_MEM) DELTA_MEM  = ZERO
909#else
910           LAST_LOAD_SENT = LOAD_FLOPS( MYID )
911           IF ( BDC_MEM ) DM_LAST_MEM_SENT = DM_MEM( MYID )
912#endif
913         END IF
914      ENDIF
915 333  CONTINUE
916      IF(REMOVE_NODE_FLAG)THEN
917         REMOVE_NODE_FLAG=.FALSE.
918      ENDIF
919      RETURN
920      END SUBROUTINE SMUMPS_190
921      SUBROUTINE SMUMPS_471( SSARBR,
922     &           PROCESS_BANDE_ARG, MEM_VALUE, NEW_LU, INC_MEM_ARG,
923     &           KEEP,KEEP8,LRLU)
924      USE SMUMPS_COMM_BUFFER
925      IMPLICIT NONE
926      INTEGER(8), INTENT(IN) :: MEM_VALUE, INC_MEM_ARG, NEW_LU,LRLU
927      LOGICAL, INTENT(IN) :: PROCESS_BANDE_ARG, SSARBR
928      INTEGER IERR, KEEP(500)
929      INTEGER(8) KEEP8(150)
930      DOUBLE PRECISION ZERO, SEND_MEM, SBTR_TMP
931      PARAMETER( ZERO=0.0d0 )
932      INTRINSIC max, abs
933      INTEGER(8) :: INC_MEM
934      LOGICAL PROCESS_BANDE
935#if defined(OLD_LOAD_MECHANISM)
936      DOUBLE PRECISION TMP_MEM
937#endif
938      PROCESS_BANDE=PROCESS_BANDE_ARG
939      INC_MEM = INC_MEM_ARG
940#if ! defined(OLD_LOAD_MECHANISM)
941      IF ( PROCESS_BANDE .AND. NEW_LU .NE. 0_8) THEN
942        WRITE(*,*) " Internal Error in SMUMPS_471."
943        WRITE(*,*) " NEW_LU must be zero if called from PROCESS_BANDE"
944        CALL MUMPS_ABORT()
945      ENDIF
946#endif
947#if defined(OLD_LOAD_MECHANISM)
948#if defined(CHECK_COHERENCE)
949      IF(PROCESS_BANDE)THEN
950         PROCESS_BANDE=.FALSE.
951         NB_LEVEL2=NB_LEVEL2-1
952         IF(NB_LEVEL2.LT.0)THEN
953            WRITE(*,*)MYID,': problem with NB_LEVEL2'
954         ELSEIF(NB_LEVEL2.EQ.0)THEN
955            IF(IS_DISPLAYED)THEN
956#if defined(STATS_DYNAMIC_MEMORY)
957               WRITE(*,*)MYID,': end of Incoherent state at time=',
958     &              MPI_WTIME()-TIME_REF
959#endif
960               IS_DISPLAYED=.FALSE.
961            ENDIF
962            AMI_CHOSEN=.FALSE.
963         ENDIF
964      ENDIF
965      IF((KEEP(73).EQ.0).AND.(NB_LEVEL2.NE.0)
966     &     .AND.(.NOT.IS_DISPLAYED))THEN
967         IS_DISPLAYED=.TRUE.
968#if defined(STATS_DYNAMIC_MEMORY)
969         WRITE(*,*)MYID,': Begin of Incoherent state (1) at time=',
970     &        MPI_WTIME()-TIME_REF
971#endif
972      ENDIF
973#endif
974#endif
975      DM_SUMLU = DM_SUMLU + dble(NEW_LU)
976      IF(KEEP_LOAD(201).EQ.0)THEN
977         CHECK_MEM = CHECK_MEM + INC_MEM
978      ELSE
979         CHECK_MEM = CHECK_MEM + INC_MEM - NEW_LU
980      ENDIF
981      IF ( MEM_VALUE .NE. CHECK_MEM ) THEN
982         WRITE(*,*)MYID,
983     &   ':Problem with increments in SMUMPS_471',
984     &   CHECK_MEM, MEM_VALUE, INC_MEM,NEW_LU
985         CALL MUMPS_ABORT()
986      ENDIF
987#if ! defined(OLD_LOAD_MECHANISM)
988      IF (PROCESS_BANDE) THEN
989         RETURN
990      ENDIF
991#endif
992      IF(BDC_POOL_MNG) THEN
993         IF(SBTR_WHICH_M.EQ.0)THEN
994            IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+
995     &                                   dble(INC_MEM-NEW_LU)
996         ELSE
997            IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+
998     &                                   dble(INC_MEM)
999         ENDIF
1000      ENDIF
1001      IF ( .NOT. BDC_MEM ) THEN
1002         RETURN
1003      ENDIF
1004#if defined(OLD_LOAD_MECHANISM)
1005      IF(KEEP_LOAD(201).EQ.0)THEN
1006         DM_MEM( MYID ) = dble(CHECK_MEM) - DM_SUMLU
1007      ELSE
1008         DM_MEM( MYID ) = dble(CHECK_MEM)
1009      ENDIF
1010      TMP_MEM = DM_MEM(MYID)
1011#endif
1012      IF (BDC_SBTR .AND. SSARBR) THEN
1013         IF((SBTR_WHICH_M.EQ.0).AND.(KEEP(201).NE.0))THEN
1014            SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM-NEW_LU)
1015         ELSE
1016            SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM)
1017         ENDIF
1018         SBTR_TMP = SBTR_CUR(MYID)
1019      ELSE
1020        SBTR_TMP=dble(0)
1021      ENDIF
1022#if ! defined(OLD_LOAD_MECHANISM)
1023      IF ( NEW_LU > 0_8 ) THEN
1024        INC_MEM = INC_MEM - NEW_LU
1025      ENDIF
1026      DM_MEM( MYID ) = DM_MEM(MYID) + dble(INC_MEM)
1027      MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MYID))
1028      IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN
1029         IF(dble(INC_MEM).NE.REMOVE_NODE_COST_MEM)THEN
1030            IF(dble(INC_MEM).GT.REMOVE_NODE_COST_MEM)THEN
1031               DELTA_MEM = DELTA_MEM +
1032     &              (dble(INC_MEM)-REMOVE_NODE_COST_MEM)
1033               GOTO 888
1034            ELSE
1035               DELTA_MEM = DELTA_MEM -
1036     &              (REMOVE_NODE_COST_MEM-dble(INC_MEM))
1037               GOTO 888
1038            ENDIF
1039         ENDIF
1040         GOTO 333
1041      ENDIF
1042      DELTA_MEM = DELTA_MEM + dble(INC_MEM)
1043 888  CONTINUE
1044      IF ((KEEP(48).NE.5).OR.
1045     &     ((KEEP(48).EQ.5).AND.(abs(DELTA_MEM)
1046     &      .GE.0.1d0*dble(LRLU))))THEN
1047         IF ( abs(DELTA_MEM) > DM_THRES_MEM ) THEN
1048            SEND_MEM = DELTA_MEM
1049#else
1050      IF(BDC_M2_MEM.AND.REMOVE_NODE_FLAG_MEM)THEN
1051         IF(INC_MEM.NE.REMOVE_NODE_COST_MEM)THEN
1052            IF(INC_MEM.EQ.REMOVE_NODE_COST_MEM)THEN
1053               GOTO 333
1054            ELSEIF(INC_MEM.LT.REMOVE_NODE_COST_MEM)THEN
1055               GOTO 333
1056            ENDIF
1057         ENDIF
1058      ENDIF
1059      IF ((KEEP(48).NE.5).OR.
1060     &     ((KEEP(48).EQ.5).AND.
1061     &      (abs(TMP_MEM-DM_LAST_MEM_SENT).GE.
1062     &     0.1d0*dble(LRLU))))THEN
1063         IF ( abs( TMP_MEM-DM_LAST_MEM_SENT) >
1064     &     DM_THRES_MEM )  THEN
1065            IERR = 0
1066            SEND_MEM = TMP_MEM
1067#endif
1068 111        CONTINUE
1069            CALL SMUMPS_77(
1070     &           BDC_SBTR,
1071     &           BDC_MEM,BDC_MD, COMM_LD,
1072     &           NPROCS,
1073#if ! defined(OLD_LOAD_MECHANISM)
1074     &           DELTA_LOAD,
1075#else
1076     &           LOAD_FLOPS( MYID ),
1077#endif
1078     &           SEND_MEM,SBTR_TMP,
1079     &           DM_SUMLU,
1080#if ! defined(OLD_LOAD_MECHANISM)
1081     &           FUTURE_NIV2,
1082#endif
1083     &           MYID,IERR )
1084            IF ( IERR == -1 )THEN
1085               CALL SMUMPS_467(COMM_LD, KEEP)
1086               GOTO 111
1087           ELSE IF ( IERR .NE. 0 ) THEN
1088             WRITE(*,*) "Internal Error in SMUMPS_471",IERR
1089             CALL MUMPS_ABORT()
1090           ENDIF
1091           IF ( IERR .EQ. 0 ) THEN
1092#if ! defined(OLD_LOAD_MECHANISM)
1093             DELTA_LOAD = ZERO
1094             DELTA_MEM  = ZERO
1095#else
1096             LAST_LOAD_SENT   = LOAD_FLOPS  ( MYID )
1097             DM_LAST_MEM_SENT = TMP_MEM
1098#endif
1099           END IF
1100         ENDIF
1101      ENDIF
1102 333  CONTINUE
1103      IF(REMOVE_NODE_FLAG_MEM)THEN
1104         REMOVE_NODE_FLAG_MEM=.FALSE.
1105      ENDIF
1106      END SUBROUTINE SMUMPS_471
1107      INTEGER FUNCTION SMUMPS_186( K69, MEM_DISTRIB,MSG_SIZE )
1108      IMPLICIT NONE
1109      INTEGER i, NLESS, K69
1110      INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB
1111      DOUBLE PRECISION LREF
1112      DOUBLE PRECISION MSG_SIZE
1113      NLESS = 0
1114      DO i=1,NPROCS
1115         IDWLOAD(i) = i - 1
1116      ENDDO
1117      WLOAD(1:NPROCS) = LOAD_FLOPS(0:NPROCS-1)
1118      IF(BDC_M2_FLOPS)THEN
1119         DO i=1,NPROCS
1120            WLOAD(i)=WLOAD(i)+NIV2(i)
1121         ENDDO
1122      ENDIF
1123      IF(K69 .gt. 1) THEN
1124         CALL SMUMPS_426(MEM_DISTRIB,MSG_SIZE,IDWLOAD,NPROCS)
1125      ENDIF
1126      LREF = LOAD_FLOPS(MYID)
1127      DO i=1, NPROCS
1128         IF (WLOAD(i).LT.LREF) NLESS=NLESS+1
1129      ENDDO
1130      SMUMPS_186 = NLESS
1131      RETURN
1132      END FUNCTION SMUMPS_186
1133      SUBROUTINE SMUMPS_189(MEM_DISTRIB,MSG_SIZE,DEST,
1134     &     NSLAVES)
1135      IMPLICIT NONE
1136      INTEGER NSLAVES
1137      INTEGER DEST(NSLAVES)
1138      INTEGER, DIMENSION(0:NPROCS - 1) :: MEM_DISTRIB
1139      INTEGER i,J,NBDEST
1140      DOUBLE PRECISION MSG_SIZE
1141      IF ( NSLAVES.eq.NPROCS-1 ) THEN
1142        J = MYID+1
1143        DO i=1,NSLAVES
1144           J=J+1
1145           IF (J.GT.NPROCS) J=1
1146           DEST(i) = J - 1
1147        ENDDO
1148      ELSE
1149        DO i=1,NPROCS
1150           IDWLOAD(i) = i - 1
1151        ENDDO
1152        CALL MUMPS_558(NPROCS, WLOAD, IDWLOAD)
1153         NBDEST = 0
1154         DO i=1, NSLAVES
1155            J = IDWLOAD(i)
1156            IF (J.NE.MYID) THEN
1157               NBDEST = NBDEST+1
1158               DEST(NBDEST) = J
1159            ENDIF
1160         ENDDO
1161         IF (NBDEST.NE.NSLAVES) THEN
1162            DEST(NSLAVES) = IDWLOAD(NSLAVES+1)
1163         ENDIF
1164         IF(BDC_MD)THEN
1165            J=NSLAVES+1
1166            do i=NSLAVES+1,NPROCS
1167               IF(IDWLOAD(i).NE.MYID)THEN
1168                  DEST(J)= IDWLOAD(i)
1169                  J=J+1
1170               ENDIF
1171            end do
1172         ENDIF
1173      ENDIF
1174      RETURN
1175      END SUBROUTINE SMUMPS_189
1176      SUBROUTINE SMUMPS_183( INFO1, IERR )
1177      USE SMUMPS_COMM_BUFFER
1178      IMPLICIT NONE
1179      INTEGER, intent(in) :: INFO1
1180      INTEGER, intent(out) :: IERR
1181      IERR=0
1182      DEALLOCATE( LOAD_FLOPS )
1183      DEALLOCATE( WLOAD )
1184      DEALLOCATE( IDWLOAD )
1185#if ! defined(OLD_LOAD_MECHANISM)
1186      DEALLOCATE(FUTURE_NIV2)
1187#endif
1188      IF(BDC_MD)THEN
1189         DEALLOCATE(MD_MEM)
1190         DEALLOCATE(LU_USAGE)
1191         DEALLOCATE(TAB_MAXS)
1192      ENDIF
1193      IF ( BDC_MEM ) DEALLOCATE( DM_MEM )
1194      IF ( BDC_POOL) DEALLOCATE( POOL_MEM )
1195      IF ( BDC_SBTR) THEN
1196         DEALLOCATE( SBTR_MEM )
1197         DEALLOCATE( SBTR_CUR )
1198         DEALLOCATE(SBTR_FIRST_POS_IN_POOL)
1199         NULLIFY(MY_FIRST_LEAF)
1200         NULLIFY(MY_NB_LEAF)
1201         NULLIFY(MY_ROOT_SBTR)
1202      ENDIF
1203      IF(KEEP_LOAD(76).EQ.4)THEN
1204         NULLIFY(DEPTH_FIRST_LOAD)
1205      ENDIF
1206      IF(KEEP_LOAD(76).EQ.5)THEN
1207         NULLIFY(COST_TRAV)
1208      ENDIF
1209      IF((KEEP_LOAD(76).EQ.4).OR.(KEEP_LOAD(76).EQ.6))THEN
1210         NULLIFY(DEPTH_FIRST_LOAD)
1211         NULLIFY(DEPTH_FIRST_SEQ_LOAD)
1212         NULLIFY(SBTR_ID_LOAD)
1213      ENDIF
1214      IF (BDC_M2_MEM.OR.BDC_M2_FLOPS) THEN
1215        DEALLOCATE(NB_SON,POOL_NIV2,POOL_NIV2_COST, NIV2)
1216      END IF
1217      IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN
1218         DEALLOCATE(CB_COST_MEM)
1219         DEALLOCATE(CB_COST_ID)
1220      ENDIF
1221      NULLIFY(ND_LOAD)
1222      NULLIFY(KEEP_LOAD)
1223      NULLIFY(KEEP8_LOAD)
1224      NULLIFY(FILS_LOAD)
1225      NULLIFY(FRERE_LOAD)
1226      NULLIFY(PROCNODE_LOAD)
1227      NULLIFY(STEP_LOAD)
1228      NULLIFY(NE_LOAD)
1229      NULLIFY(CAND_LOAD)
1230      NULLIFY(STEP_TO_NIV2_LOAD)
1231      NULLIFY(DAD_LOAD)
1232      IF (BDC_SBTR.OR.BDC_POOL_MNG) THEN
1233         DEALLOCATE(MEM_SUBTREE)
1234         DEALLOCATE(SBTR_PEAK_ARRAY)
1235         DEALLOCATE(SBTR_CUR_ARRAY)
1236      ENDIF
1237      CALL SMUMPS_58( IERR )
1238      CALL SMUMPS_150( MYID, COMM_LD,
1239     &     BUF_LOAD_RECV, LBUF_LOAD_RECV,
1240     &     LBUF_LOAD_RECV_BYTES )
1241      DEALLOCATE(BUF_LOAD_RECV)
1242      END SUBROUTINE SMUMPS_183
1243#if defined (LAMPORT_)
1244      RECURSIVE SUBROUTINE SMUMPS_467(COMM, KEEP)
1245#else
1246      SUBROUTINE SMUMPS_467(COMM, KEEP)
1247#endif
1248      IMPLICIT NONE
1249      INCLUDE 'mpif.h'
1250      INCLUDE 'mumps_tags.h'
1251      INTEGER IERR, MSGTAG, MSGLEN, MSGSOU,COMM
1252      INTEGER KEEP(500)
1253      INTEGER STATUS(MPI_STATUS_SIZE)
1254      LOGICAL FLAG
1255 10   CONTINUE
1256      CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM,
1257     &     FLAG, STATUS, IERR )
1258      IF (FLAG) THEN
1259        KEEP(65)=KEEP(65)+1
1260        MSGTAG = STATUS( MPI_TAG )
1261        MSGSOU = STATUS( MPI_SOURCE )
1262        IF ( MSGTAG .NE. UPDATE_LOAD) THEN
1263          write(*,*) "Internal error 1 in SMUMPS_467",
1264     &    MSGTAG
1265          CALL MUMPS_ABORT()
1266        ENDIF
1267        CALL MPI_GET_COUNT(STATUS, MPI_PACKED, MSGLEN, IERR)
1268        IF ( MSGLEN > LBUF_LOAD_RECV_BYTES ) THEN
1269          write(*,*) "Internal error 2 in SMUMPS_467",
1270     &    MSGLEN, LBUF_LOAD_RECV_BYTES
1271          CALL MUMPS_ABORT()
1272        ENDIF
1273        CALL MPI_RECV( BUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES,
1274     &    MPI_PACKED, MSGSOU, MSGTAG, COMM_LD, STATUS, IERR)
1275        CALL SMUMPS_187( MSGSOU, BUF_LOAD_RECV,
1276     &  LBUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES )
1277        GOTO 10
1278      ENDIF
1279      RETURN
1280      END SUBROUTINE SMUMPS_467
1281      RECURSIVE SUBROUTINE SMUMPS_187
1282     &   ( MSGSOU, BUFR, LBUFR, LBUFR_BYTES )
1283      IMPLICIT NONE
1284      INTEGER MSGSOU, LBUFR, LBUFR_BYTES
1285      INTEGER BUFR( LBUFR )
1286      INCLUDE 'mpif.h'
1287      INTEGER POSITION, IERR, WHAT, NSLAVES, i
1288      DOUBLE PRECISION LOAD_RECEIVED
1289      INTEGER INODE_RECEIVED,NCB_RECEIVED
1290      DOUBLE PRECISION SURF
1291      INTEGER, POINTER, DIMENSION (:) :: LIST_SLAVES
1292      DOUBLE PRECISION, POINTER, DIMENSION (:) :: LOAD_INCR
1293      EXTERNAL MUMPS_330
1294      INTEGER MUMPS_330
1295      POSITION = 0
1296      CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1297     &     WHAT, 1, MPI_INTEGER,
1298     &     COMM_LD, IERR )
1299      IF ( WHAT == 0 ) THEN
1300#if ! defined(OLD_LOAD_MECHANISM)
1301#else
1302#endif
1303        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1304     &     LOAD_RECEIVED, 1,
1305     &     MPI_DOUBLE_PRECISION,
1306     &     COMM_LD, IERR )
1307#if ! defined(OLD_LOAD_MECHANISM)
1308      LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED
1309#else
1310      LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED
1311#endif
1312        IF ( BDC_MEM ) THEN
1313          CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1314     &       LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION,
1315     &       COMM_LD, IERR )
1316#if ! defined(OLD_LOAD_MECHANISM)
1317          DM_MEM(MSGSOU)  = DM_MEM(MSGSOU) + LOAD_RECEIVED
1318#else
1319          DM_MEM(MSGSOU)  = LOAD_RECEIVED
1320#endif
1321          MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MSGSOU))
1322        END IF
1323        IF(BDC_SBTR)THEN
1324          CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1325     &       LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION,
1326     &       COMM_LD, IERR )
1327          SBTR_CUR(MSGSOU)=LOAD_RECEIVED
1328        ENDIF
1329        IF(BDC_MD)THEN
1330           CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1331     &          LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION,
1332     &          COMM_LD, IERR )
1333           IF(KEEP_LOAD(201).EQ.0)THEN
1334              LU_USAGE(MSGSOU)=LOAD_RECEIVED
1335           ENDIF
1336        ENDIF
1337      ELSEIF (( WHAT == 1).OR.(WHAT.EQ.19)) THEN
1338        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1339     &     NSLAVES, 1, MPI_INTEGER,
1340     &     COMM_LD, IERR )
1341        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1342     &     INODE_RECEIVED, 1, MPI_INTEGER,
1343     &     COMM_LD, IERR )
1344        LIST_SLAVES => IDWLOAD
1345        LOAD_INCR => WLOAD
1346        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1347     &     LIST_SLAVES(1), NSLAVES, MPI_INTEGER,
1348     &     COMM_LD, IERR)
1349        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1350     &     LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION,
1351     &     COMM_LD, IERR)
1352#if defined(OLD_LOAD_MECHANISM)
1353#if defined(CHECK_COHERENCE)
1354        WRITE(*,*)MYID,':Receiving M2A from',MSGSOU
1355        i=1
1356        DO WHILE ((i.LE.NSLAVES).AND.(LIST_SLAVES(i).NE.MYID))
1357           i=i+1
1358        ENDDO
1359        IF(i.LT.(NSLAVES+1))THEN
1360           NB_LEVEL2=NB_LEVEL2+1
1361           WRITE(*,*)MYID,':NB_LEVEL2=',NB_LEVEL2
1362           AMI_CHOSEN=.TRUE.
1363           IF(KEEP_LOAD(73).EQ.1)THEN
1364              IF(.NOT.IS_DISPLAYED)THEN
1365              WRITE(*,*)MYID,': Begin of Incoherent state (2) at time=',
1366     &                MPI_WTIME()-TIME_REF
1367              IS_DISPLAYED=.TRUE.
1368              ENDIF
1369            ENDIF
1370        ENDIF
1371        IF(KEEP_LOAD(73).EQ.1) GOTO 344
1372#endif
1373#endif
1374        DO i = 1, NSLAVES
1375#if defined(OLD_LOAD_MECHANISM)
1376          IF ( LIST_SLAVES(i) /= MYID ) THEN
1377#endif
1378            LOAD_FLOPS(LIST_SLAVES(i)) =
1379     &      LOAD_FLOPS(LIST_SLAVES(i)) +
1380     &      LOAD_INCR(i)
1381#if defined(OLD_LOAD_MECHANISM)
1382          END IF
1383#endif
1384        END DO
1385        IF ( BDC_MEM ) THEN
1386          CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1387     &     LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION,
1388     &     COMM_LD, IERR)
1389          DO i = 1, NSLAVES
1390#if defined(OLD_LOAD_MECHANISM)
1391            IF ( LIST_SLAVES(i) /= MYID ) THEN
1392#endif
1393              DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) +
1394     &        LOAD_INCR(i)
1395              MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(LIST_SLAVES(i)))
1396#if defined(OLD_LOAD_MECHANISM)
1397            END IF
1398#endif
1399          END DO
1400        END IF
1401        IF(WHAT.EQ.19)THEN
1402           CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1403     &          LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION,
1404     &          COMM_LD, IERR)
1405           CALL SMUMPS_819(INODE_RECEIVED)
1406           CB_COST_ID(POS_ID)=INODE_RECEIVED
1407           CB_COST_ID(POS_ID+1)=NSLAVES
1408           CB_COST_ID(POS_ID+2)=POS_MEM
1409           POS_ID=POS_ID+3
1410           DO i=1,NSLAVES
1411              WRITE(*,*)MYID,':',LIST_SLAVES(i),'->',LOAD_INCR(i)
1412              CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8)
1413              POS_MEM=POS_MEM+1
1414              CB_COST_MEM(POS_MEM)=int(LOAD_INCR(i),8)
1415              POS_MEM=POS_MEM+1
1416           ENDDO
1417        ENDIF
1418#if defined(OLD_LOAD_MECHANISM)
1419#if defined(CHECK_COHERENCE)
1420 344    CONTINUE
1421#endif
1422#endif
1423        NULLIFY( LIST_SLAVES )
1424        NULLIFY( LOAD_INCR )
1425      ELSE IF (WHAT == 2 ) THEN
1426        IF ( .not. BDC_POOL ) THEN
1427          WRITE(*,*) "Internal error 2 in SMUMPS_187"
1428          CALL MUMPS_ABORT()
1429        END IF
1430        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1431     &     LOAD_RECEIVED, 1,
1432     &     MPI_DOUBLE_PRECISION,
1433     &     COMM_LD, IERR )
1434        POOL_MEM(MSGSOU)=LOAD_RECEIVED
1435      ELSE IF ( WHAT == 3 ) THEN
1436        IF ( .NOT. BDC_SBTR) THEN
1437          WRITE(*,*) "Internal error 3 in SMUMPS_187"
1438          CALL MUMPS_ABORT()
1439        ENDIF
1440        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1441     &     LOAD_RECEIVED, 1,
1442     &     MPI_DOUBLE_PRECISION,
1443     &     COMM_LD, IERR )
1444        SBTR_MEM(MSGSOU)=SBTR_MEM(MSGSOU)+LOAD_RECEIVED
1445#if ! defined(OLD_LOAD_MECHANISM)
1446      ELSE IF (WHAT == 4) THEN
1447        FUTURE_NIV2(MSGSOU+1)=0
1448        IF(BDC_MD)THEN
1449           CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1450     &          SURF, 1, MPI_DOUBLE_PRECISION,
1451     &          COMM_LD, IERR )
1452          MD_MEM(MSGSOU)=999999999_8
1453          TAB_MAXS(MSGSOU)=TAB_MAXS(MSGSOU)+int(SURF,8)
1454        ENDIF
1455#endif
1456        IF(BDC_M2_MEM.OR.BDC_M2_FLOPS)THEN
1457        ENDIF
1458      ELSE IF (WHAT == 5) THEN
1459         IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN
1460            WRITE(*,*) "Internal error 7 in SMUMPS_187"
1461            CALL MUMPS_ABORT()
1462         ENDIF
1463         CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1464     &     INODE_RECEIVED, 1,
1465     &     MPI_INTEGER,
1466     &     COMM_LD, IERR )
1467         IF(BDC_M2_MEM) THEN
1468            CALL SMUMPS_816(INODE_RECEIVED)
1469         ELSEIF(BDC_M2_FLOPS) THEN
1470            CALL SMUMPS_817(INODE_RECEIVED)
1471         ENDIF
1472         IF((KEEP_LOAD(81).EQ.2).OR.(KEEP_LOAD(81).EQ.3))THEN
1473            CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1474     &           INODE_RECEIVED, 1,
1475     &           MPI_INTEGER,
1476     &           COMM_LD, IERR )
1477               CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1478     &              NCB_RECEIVED, 1,
1479     &              MPI_INTEGER,
1480     &              COMM_LD, IERR )
1481            IF(
1482     &          MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE_RECEIVED)),
1483     &                         NPROCS).EQ.1
1484     &        )THEN
1485               CB_COST_ID(POS_ID)=INODE_RECEIVED
1486               CB_COST_ID(POS_ID+1)=1
1487               CB_COST_ID(POS_ID+2)=POS_MEM
1488               POS_ID=POS_ID+3
1489               CB_COST_MEM(POS_MEM)=int(MSGSOU,8)
1490               POS_MEM=POS_MEM+1
1491               CB_COST_MEM(POS_MEM)=int(NCB_RECEIVED,8)*
1492     &              int(NCB_RECEIVED,8)
1493               POS_MEM=POS_MEM+1
1494            ENDIF
1495         ENDIF
1496      ELSE IF ( WHAT == 6 ) THEN
1497         IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN
1498            WRITE(*,*) "Internal error 8 in SMUMPS_187"
1499            CALL MUMPS_ABORT()
1500         ENDIF
1501         CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1502     &     LOAD_RECEIVED, 1,
1503     &     MPI_DOUBLE_PRECISION,
1504     &     COMM_LD, IERR )
1505         IF(BDC_M2_MEM) THEN
1506            NIV2(MSGSOU+1) = LOAD_RECEIVED
1507         ELSEIF(BDC_M2_FLOPS) THEN
1508            NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED
1509            IF(NIV2(MSGSOU+1).LT.0.0D0)THEN
1510               IF(abs(NIV2(MSGSOU+1)).LE.
1511     &              sqrt(epsilon(LOAD_RECEIVED)))THEN
1512                  NIV2(MSGSOU+1)=0.0D0
1513               ELSE
1514                  WRITE(*,*)'problem with NIV2_FLOPS message',
1515     &                 NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED
1516                  CALL MUMPS_ABORT()
1517               ENDIF
1518            ENDIF
1519         ENDIF
1520      ELSEIF(WHAT == 17)THEN
1521         CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1522     &     LOAD_RECEIVED, 1,
1523     &     MPI_DOUBLE_PRECISION,
1524     &     COMM_LD, IERR )
1525         IF(BDC_M2_MEM) THEN
1526            NIV2(MSGSOU+1) = LOAD_RECEIVED
1527            CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1528     &           LOAD_RECEIVED, 1,
1529     &           MPI_DOUBLE_PRECISION,
1530     &           COMM_LD, IERR )
1531            IF(BDC_MD)THEN
1532#if ! defined(OLD_LOAD_MECHANISM)
1533               DM_MEM(MYID)=DM_MEM(MYID)+LOAD_RECEIVED
1534#else
1535               DM_MEM(MYID)=LOAD_RECEIVED
1536#endif
1537            ELSEIF(BDC_POOL)THEN
1538               POOL_MEM(MSGSOU)=LOAD_RECEIVED
1539            ENDIF
1540         ELSEIF(BDC_M2_FLOPS) THEN
1541            NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED
1542            IF(NIV2(MSGSOU+1).LT.0.0D0)THEN
1543               WRITE(*,*)'problem with NIV2_FLOPS message',
1544     &              NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED
1545               CALL MUMPS_ABORT()
1546            ENDIF
1547            CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1548     &           LOAD_RECEIVED, 1,
1549     &           MPI_DOUBLE_PRECISION,
1550     &           COMM_LD, IERR )
1551#if ! defined(OLD_LOAD_MECHANISM)
1552            LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED
1553#else
1554            LOAD_FLOPS( MSGSOU ) = LOAD_RECEIVED
1555#endif
1556         ENDIF
1557      ELSEIF ( WHAT == 7 ) THEN
1558         IF(.NOT.BDC_MD)THEN
1559            WRITE(*,*)MYID,': Internal error 4
1560     &in SMUMPS_187'
1561            CALL MUMPS_ABORT()
1562         ENDIF
1563        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1564     &     NSLAVES, 1, MPI_INTEGER,
1565     &     COMM_LD, IERR )
1566        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1567     &     INODE_RECEIVED, 1, MPI_INTEGER,
1568     &     COMM_LD, IERR )
1569        LIST_SLAVES => IDWLOAD
1570        LOAD_INCR => WLOAD
1571        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1572     &     LIST_SLAVES(1), NSLAVES, MPI_INTEGER,
1573     &     COMM_LD, IERR)
1574        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1575     &     LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION,
1576     &     COMM_LD, IERR)
1577        DO i = 1, NSLAVES
1578#if defined(OLD_LOAD_MECHANISM)
1579          IF ( LIST_SLAVES(i) /= MYID ) THEN
1580#endif
1581            MD_MEM(LIST_SLAVES(i)) =
1582     &      MD_MEM(LIST_SLAVES(i)) +
1583     &      int(LOAD_INCR(i),8)
1584#if ! defined(OLD_LOAD_MECHANISM)
1585            IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN
1586               MD_MEM(LIST_SLAVES(i))=999999999_8
1587            ENDIF
1588#endif
1589#if defined(OLD_LOAD_MECHANISM)
1590          END IF
1591#endif
1592        END DO
1593      ELSEIF ( WHAT == 8 ) THEN
1594         IF(.NOT.BDC_MD)THEN
1595            WRITE(*,*)MYID,': Internal error 5
1596     &in SMUMPS_187'
1597            CALL MUMPS_ABORT()
1598         ENDIF
1599        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1600     &     LOAD_RECEIVED, 1,
1601     &     MPI_DOUBLE_PRECISION,
1602     &     COMM_LD, IERR )
1603        MD_MEM(MSGSOU)=MD_MEM(MSGSOU)+int(LOAD_RECEIVED,8)
1604#if ! defined(OLD_LOAD_MECHANISM)
1605        IF(FUTURE_NIV2(MSGSOU+1).EQ.0)THEN
1606           MD_MEM(MSGSOU)=999999999_8
1607        ENDIF
1608#endif
1609      ELSEIF ( WHAT == 9 ) THEN
1610         IF(.NOT.BDC_MD)THEN
1611            WRITE(*,*)MYID,': Internal error 6
1612     &in SMUMPS_187'
1613            CALL MUMPS_ABORT()
1614         ENDIF
1615        CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1616     &     LOAD_RECEIVED, 1,
1617     &     MPI_DOUBLE_PRECISION,
1618     &     COMM_LD, IERR )
1619        TAB_MAXS(MSGSOU)=int(LOAD_RECEIVED,8)
1620      ELSE
1621          WRITE(*,*) "Internal error 1 in SMUMPS_187"
1622          CALL MUMPS_ABORT()
1623      END IF
1624      RETURN
1625      END SUBROUTINE SMUMPS_187
1626      integer function SMUMPS_409
1627     &                 (MEM_DISTRIB,CAND,
1628     &                  K69,
1629     &                  SLAVEF,MSG_SIZE,
1630     &                  NMB_OF_CAND )
1631      implicit none
1632      integer, intent(in) :: K69, SLAVEF
1633      INTEGER, intent(in) :: CAND(SLAVEF+1)
1634      INTEGER, DIMENSION(0:NPROCS - 1), intent(in) :: MEM_DISTRIB
1635      INTEGER, intent(out) :: NMB_OF_CAND
1636      integer i,nless
1637      DOUBLE PRECISION lref
1638      DOUBLE PRECISION MSG_SIZE
1639      nless = 0
1640      NMB_OF_CAND=CAND(SLAVEF+1)
1641      do i=1,NMB_OF_CAND
1642         WLOAD(i)=LOAD_FLOPS(CAND(i))
1643         IF(BDC_M2_FLOPS)THEN
1644            WLOAD(i)=WLOAD(i)+NIV2(CAND(i)+1)
1645         ENDIF
1646      end do
1647      IF(K69 .gt. 1) THEN
1648         CALL SMUMPS_426(MEM_DISTRIB,MSG_SIZE,
1649     &        CAND,NMB_OF_CAND)
1650      ENDIF
1651      lref = LOAD_FLOPS(MYID)
1652      do i=1, NMB_OF_CAND
1653         if (WLOAD(i).lt.lref) nless=nless+1
1654      end do
1655      SMUMPS_409 = nless
1656      return
1657      end function SMUMPS_409
1658      subroutine SMUMPS_384
1659     &           (MEM_DISTRIB,CAND,
1660     &
1661     &            SLAVEF,
1662     &            nslaves_inode, DEST)
1663      implicit none
1664      integer, intent(in) :: nslaves_inode, SLAVEF
1665      integer, intent(in) :: CAND(SLAVEF+1)
1666      integer, dimension(0:NPROCS - 1), intent(in) :: MEM_DISTRIB
1667      integer, intent(out) :: DEST(CAND(SLAVEF+1))
1668      integer i,j,NMB_OF_CAND
1669      external MUMPS_558
1670      NMB_OF_CAND = CAND(SLAVEF+1)
1671      if(nslaves_inode.ge.NPROCS .or.
1672     &   nslaves_inode.gt.NMB_OF_CAND) then
1673         write(*,*)'Internal error in SMUMPS_384',
1674     &   nslaves_inode, NPROCS, NMB_OF_CAND
1675         CALL MUMPS_ABORT()
1676      end if
1677      if (nslaves_inode.eq.NPROCS-1) then
1678         j=MYID+1
1679         do i=1,nslaves_inode
1680            if(j.ge.NPROCS) j=0
1681            DEST(i)=j
1682            j=j+1
1683         end do
1684      else
1685        do i=1,NMB_OF_CAND
1686               IDWLOAD(i)=i
1687        end do
1688        call MUMPS_558(NMB_OF_CAND,
1689     &       WLOAD(1),IDWLOAD(1) )
1690        do i=1,nslaves_inode
1691           DEST(i)= CAND(IDWLOAD(i))
1692        end do
1693        IF(BDC_MD)THEN
1694           do i=nslaves_inode+1,NMB_OF_CAND
1695              DEST(i)= CAND(IDWLOAD(i))
1696           end do
1697        ENDIF
1698      end if
1699      return
1700      end subroutine SMUMPS_384
1701      SUBROUTINE SMUMPS_425(K69)
1702      IMPLICIT NONE
1703      INTEGER K69
1704      IF (K69 .LE. 4) THEN
1705         ALPHA = 0.0d0
1706         BETA = 0.0d0
1707         RETURN
1708      ENDIF
1709      IF (K69 .EQ. 5) THEN
1710         ALPHA = 0.5d0
1711         BETA = 50000.0d0
1712         RETURN
1713      ENDIF
1714      IF (K69 .EQ. 6) THEN
1715         ALPHA = 0.5d0
1716         BETA = 100000.0d0
1717         RETURN
1718      ENDIF
1719      IF (K69 .EQ. 7) THEN
1720         ALPHA = 0.5d0
1721         BETA = 150000.0d0
1722         RETURN
1723      ENDIF
1724      IF (K69 .EQ. 8) THEN
1725         ALPHA = 1.0d0
1726         BETA = 50000.0d0
1727         RETURN
1728      ENDIF
1729      IF (K69 .EQ. 9) THEN
1730         ALPHA = 1.0d0
1731         BETA = 100000.0d0
1732         RETURN
1733      ENDIF
1734      IF (K69 .EQ. 10) THEN
1735         ALPHA = 1.0d0
1736         BETA = 150000.0d0
1737         RETURN
1738      ENDIF
1739      IF (K69 .EQ. 11) THEN
1740         ALPHA = 1.5d0
1741         BETA = 50000.0d0
1742         RETURN
1743      ENDIF
1744      IF (K69 .EQ. 12) THEN
1745         ALPHA = 1.5d0
1746         BETA = 100000.0d0
1747         RETURN
1748      ENDIF
1749      ALPHA = 1.5d0
1750      BETA = 150000.0d0
1751      RETURN
1752      END SUBROUTINE SMUMPS_425
1753      SUBROUTINE SMUMPS_426(MEM_DISTRIB,MSG_SIZE,ARRAY_ADM,LEN)
1754      IMPLICIT NONE
1755      INTEGER i,LEN
1756      INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB
1757      DOUBLE PRECISION MSG_SIZE,FORBIGMSG
1758      INTEGER ARRAY_ADM(LEN)
1759      DOUBLE PRECISION MY_LOAD
1760      FORBIGMSG = 1.0d0
1761      IF (K69 .lt.2) THEN
1762         RETURN
1763      ENDIF
1764      IF(BDC_M2_FLOPS)THEN
1765         MY_LOAD=LOAD_FLOPS(MYID)+NIV2(MYID+1)
1766      ELSE
1767         MY_LOAD=LOAD_FLOPS(MYID)
1768      ENDIF
1769      IF((MSG_SIZE * dble(K35) ) .gt. 3200000.0d0) THEN
1770         FORBIGMSG = 2.0d0
1771      ENDIF
1772      IF (K69 .le. 4) THEN
1773         DO i = 1,LEN
1774            IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND.
1775     &      WLOAD(i) .LT. MY_LOAD ) THEN
1776               WLOAD(i) = WLOAD(i)/MY_LOAD
1777            ELSE
1778              IF ( MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1 ) THEN
1779                WLOAD(i) = WLOAD(i) *
1780     &              dble(MEM_DISTRIB(ARRAY_ADM(i)))
1781     &              * FORBIGMSG
1782     &              + dble(2)
1783              ENDIF
1784            ENDIF
1785         ENDDO
1786         RETURN
1787      ENDIF
1788      DO i = 1,LEN
1789         IF ((MEM_DISTRIB(ARRAY_ADM(i)) .EQ. 1) .AND.
1790     &        WLOAD(i) .LT. MY_LOAD ) THEN
1791            WLOAD(i) = WLOAD(i) /  MY_LOAD
1792         ELSE
1793            IF(MEM_DISTRIB(ARRAY_ADM(i)) .NE. 1) THEN
1794               WLOAD(i) = (WLOAD(i) +
1795     &              ALPHA * MSG_SIZE * dble(K35)  +
1796     &              BETA) * FORBIGMSG
1797            ENDIF
1798         ENDIF
1799      ENDDO
1800      RETURN
1801      END SUBROUTINE SMUMPS_426
1802      SUBROUTINE SMUMPS_461(MYID, SLAVEF, COMM,
1803     &     TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, NSLAVES,INODE)
1804      USE SMUMPS_COMM_BUFFER
1805      IMPLICIT NONE
1806      INTEGER, INTENT (IN) :: MYID, SLAVEF, COMM, NASS, NSLAVES
1807      INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2)
1808      INTEGER, INTENT (IN) :: LIST_SLAVES( NSLAVES )
1809      INTEGER KEEP(500)
1810      INTEGER(8) KEEP8(150)
1811      INTEGER NCB, NFRONT, NBROWS_SLAVE
1812      INTEGER i, IERR,WHAT,INODE
1813      DOUBLE PRECISION MEM_INCREMENT ( NSLAVES )
1814      DOUBLE PRECISION FLOPS_INCREMENT( NSLAVES )
1815      DOUBLE PRECISION CB_BAND( NSLAVES )
1816      IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN
1817         WHAT=1
1818      ELSE
1819         WHAT=19
1820      ENDIF
1821#if ! defined(OLD_LOAD_MECHANISM)
1822      FUTURE_NIV2(MYID+1) = FUTURE_NIV2(MYID+1) - 1
1823      IF ( FUTURE_NIV2(MYID+1) < 0 ) THEN
1824        WRITE(*,*) "Internal error in SMUMPS_461"
1825        CALL MUMPS_ABORT()
1826      ENDIF
1827      IF ( FUTURE_NIV2(MYID + 1) == 0 ) THEN
1828 112    CONTINUE
1829        CALL SMUMPS_502(COMM,MYID,SLAVEF,
1830     &       dble(MAX_SURF_MASTER),IERR)
1831        IF (IERR == -1 ) THEN
1832          CALL SMUMPS_467(COMM_LD, KEEP)
1833          GOTO 112
1834        ELSE IF ( IERR .NE. 0 ) THEN
1835          WRITE(*,*) "Internal Error in SMUMPS_461",
1836     &    IERR
1837          CALL MUMPS_ABORT()
1838        ENDIF
1839      TAB_MAXS(MYID) = TAB_MAXS(MYID) + int(MAX_SURF_MASTER,8)
1840      ENDIF
1841#endif
1842      IF ( NSLAVES /= TAB_POS(SLAVEF + 2) ) THEN
1843        write(*,*) "Error 1 in SMUMPS_461",
1844     &             NSLAVES, TAB_POS(SLAVEF+2)
1845        CALL MUMPS_ABORT()
1846      ENDIF
1847      NCB = TAB_POS(NSLAVES+1) - 1
1848      NFRONT = NCB + NASS
1849      DO i = 1, NSLAVES
1850         NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i)
1851         IF ( KEEP(50) == 0 ) THEN
1852            FLOPS_INCREMENT( i ) = (dble(NBROWS_SLAVE)*dble( NASS ))+
1853     &           dble(NBROWS_SLAVE) * dble(NASS) *
1854     &           dble(2*NFRONT-NASS-1)
1855         ELSE
1856            FLOPS_INCREMENT( i ) = dble(NBROWS_SLAVE) * dble(NASS ) *
1857     &           dble( 2 * ( NASS + TAB_POS(i+1) - 1 )
1858     &           - NBROWS_SLAVE - NASS + 1 )
1859         ENDIF
1860         IF ( BDC_MEM ) THEN
1861            IF ( KEEP(50) == 0 ) THEN
1862               MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) *
1863     &              dble(NFRONT)
1864            ELSE
1865               MEM_INCREMENT( i ) = dble(NBROWS_SLAVE) *
1866     &              dble( NASS + TAB_POS(i+1) - 1 )
1867            END IF
1868         ENDIF
1869         IF((KEEP(81).NE.2).AND.(KEEP(81).NE.3))THEN
1870            CB_BAND(i)=dble(-999999)
1871         ELSE
1872            IF ( KEEP(50) == 0 ) THEN
1873               CB_BAND( i ) = dble(NBROWS_SLAVE) *
1874     &              dble(NFRONT-NASS)
1875            ELSE
1876               CB_BAND( i ) = dble(NBROWS_SLAVE) *
1877     &              dble(TAB_POS(i+1)-1)
1878            END IF
1879         ENDIF
1880      END DO
1881      IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN
1882         CB_COST_ID(POS_ID)=INODE
1883         CB_COST_ID(POS_ID+1)=NSLAVES
1884         CB_COST_ID(POS_ID+2)=POS_MEM
1885         POS_ID=POS_ID+3
1886         DO i=1,NSLAVES
1887            CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8)
1888            POS_MEM=POS_MEM+1
1889            CB_COST_MEM(POS_MEM)=int(CB_BAND(i),8)
1890            POS_MEM=POS_MEM+1
1891         ENDDO
1892      ENDIF
1893 111  CONTINUE
1894      CALL SMUMPS_524(BDC_MEM, COMM, MYID, SLAVEF,
1895#if ! defined(OLD_LOAD_MECHANISM)
1896     &     FUTURE_NIV2,
1897#endif
1898     &     NSLAVES, LIST_SLAVES,INODE,
1899     &     MEM_INCREMENT,
1900     &     FLOPS_INCREMENT,CB_BAND, WHAT,IERR)
1901        IF ( IERR == -1 ) THEN
1902          CALL SMUMPS_467(COMM_LD, KEEP)
1903          GOTO 111
1904        ELSE IF ( IERR .NE. 0 ) THEN
1905          WRITE(*,*) "Internal Error in SMUMPS_461",
1906     &    IERR
1907          CALL MUMPS_ABORT()
1908        ENDIF
1909#if ! defined(OLD_LOAD_MECHANISM)
1910      IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN
1911#endif
1912        DO i = 1, NSLAVES
1913          LOAD_FLOPS(LIST_SLAVES(i)) = LOAD_FLOPS(LIST_SLAVES(i))
1914     &       +  FLOPS_INCREMENT(i)
1915          IF ( BDC_MEM ) THEN
1916            DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i))
1917     &       +  MEM_INCREMENT(i)
1918          END IF
1919        ENDDO
1920#if ! defined(OLD_LOAD_MECHANISM)
1921      ENDIF
1922#endif
1923      RETURN
1924      END SUBROUTINE SMUMPS_461
1925      SUBROUTINE SMUMPS_500(
1926     &     POOL, LPOOL,
1927     &     PROCNODE, KEEP,KEEP8, SLAVEF, COMM, MYID, STEP, N,
1928     &     ND, FILS )
1929      USE SMUMPS_COMM_BUFFER
1930      IMPLICIT NONE
1931      INTEGER LPOOL, SLAVEF, COMM, MYID
1932      INTEGER N, KEEP(500)
1933      INTEGER(8) KEEP8(150)
1934      INTEGER POOL( LPOOL ), PROCNODE( KEEP(28) ), STEP( N )
1935      INTEGER ND( KEEP(28) ), FILS( N )
1936      INTEGER i, INODE, NELIM, NFR, LEVEL, IERR, WHAT
1937      DOUBLE PRECISION COST
1938      INTEGER NBINSUBTREE,NBTOP,INSUBTREE
1939      INTEGER MUMPS_330
1940      EXTERNAL MUMPS_330
1941      NBINSUBTREE = POOL(LPOOL)
1942      NBTOP       = POOL(LPOOL - 1)
1943      INSUBTREE   = POOL(LPOOL - 2)
1944      IF(BDC_MD)THEN
1945         RETURN
1946      ENDIF
1947      IF((KEEP(76).EQ.0).OR.(KEEP(76).EQ.2))THEN
1948         IF(NBTOP.NE.0)THEN
1949            DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3)
1950               INODE = POOL( i )
1951               IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN
1952                  GOTO 20
1953               END IF
1954            END DO
1955            COST=dble(0)
1956            GOTO 30
1957         ELSE
1958            DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1
1959               INODE = POOL( i )
1960               IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN
1961                  GOTO 20
1962               END IF
1963            END DO
1964            COST=dble(0)
1965            GOTO 30
1966         ENDIF
1967      ELSE
1968         IF(KEEP(76).EQ.1)THEN
1969            IF(INSUBTREE.EQ.1)THEN
1970               DO i = NBINSUBTREE, max(1,NBINSUBTREE-3), -1
1971                  INODE = POOL( i )
1972                  IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN
1973                     GOTO 20
1974                  END IF
1975               END DO
1976               COST=dble(0)
1977               GOTO 30
1978            ELSE
1979               DO i = LPOOL-NBTOP-2, min(LPOOL-3,LPOOL-NBTOP-2+3)
1980                  INODE = POOL( i )
1981                  IF (INODE .LE. N .AND. INODE .GE. 1 ) THEN
1982                     GOTO 20
1983                  END IF
1984               END DO
1985               COST=dble(0)
1986               GOTO 30
1987            ENDIF
1988         ELSE
1989            WRITE(*,*)
1990     &      'Internal error: Unknown pool management strategy'
1991            CALL MUMPS_ABORT()
1992         ENDIF
1993      ENDIF
1994 20   CONTINUE
1995        i = INODE
1996        NELIM = 0
1997 10     CONTINUE
1998        IF ( i > 0 ) THEN
1999          NELIM = NELIM + 1
2000          i = FILS(i)
2001          GOTO 10
2002        ENDIF
2003        NFR = ND( STEP(INODE) )
2004        LEVEL = MUMPS_330( PROCNODE(STEP(INODE)), SLAVEF )
2005        IF (LEVEL .EQ. 1) THEN
2006          COST = dble( NFR ) * dble( NFR )
2007        ELSE
2008          IF ( KEEP(50) == 0 ) THEN
2009            COST = dble( NFR ) * dble( NELIM )
2010          ELSE
2011            COST = dble( NELIM ) * dble( NELIM )
2012          ENDIF
2013        ENDIF
2014 30   CONTINUE
2015      IF ( abs(POOL_LAST_COST_SENT-COST).GT.DM_THRES_MEM ) THEN
2016        WHAT = 2
2017 111    CONTINUE
2018        CALL SMUMPS_460( WHAT,
2019     &         COMM, SLAVEF,
2020#if ! defined(OLD_LOAD_MECHANISM)
2021     &               FUTURE_NIV2,
2022#endif
2023     &         COST, dble(0),MYID, IERR  )
2024        POOL_LAST_COST_SENT = COST
2025        POOL_MEM(MYID)=COST
2026        IF ( IERR == -1 )THEN
2027          CALL SMUMPS_467(COMM_LD, KEEP)
2028          GOTO 111
2029        ELSE IF ( IERR .NE. 0 ) THEN
2030          WRITE(*,*) "Internal Error in SMUMPS_500",
2031     &    IERR
2032          CALL MUMPS_ABORT()
2033        ENDIF
2034      ENDIF
2035      RETURN
2036      END SUBROUTINE SMUMPS_500
2037      SUBROUTINE SMUMPS_501(
2038     &     OK,INODE,POOL,LPOOL,MYID,SLAVEF,COMM,KEEP,KEEP8)
2039      USE SMUMPS_COMM_BUFFER
2040      IMPLICIT NONE
2041      INTEGER LPOOL,MYID,SLAVEF,COMM,INODE
2042      INTEGER POOL(LPOOL),KEEP(500)
2043      INTEGER(8) KEEP8(150)
2044      INTEGER WHAT,IERR
2045      LOGICAL OK
2046      DOUBLE PRECISION COST
2047      LOGICAL FLAG
2048      EXTERNAL MUMPS_283,MUMPS_170
2049      LOGICAL MUMPS_283,MUMPS_170
2050      IF((INODE.LE.0).OR.(INODE.GT.N_LOAD)) THEN
2051         RETURN
2052      ENDIF
2053      IF (.NOT.MUMPS_170(
2054     &     PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS)
2055     &   ) THEN
2056         RETURN
2057      ENDIF
2058      IF(MUMPS_283(PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS))THEN
2059         IF(NE_LOAD(STEP_LOAD(INODE)).EQ.0)THEN
2060            RETURN
2061         ENDIF
2062      ENDIF
2063      FLAG=.FALSE.
2064      IF(INDICE_SBTR.LE.NB_SUBTREES)THEN
2065         IF(INODE.EQ.MY_FIRST_LEAF(INDICE_SBTR))THEN
2066            FLAG=.TRUE.
2067         ENDIF
2068      ENDIF
2069      IF(FLAG)THEN
2070         SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY)=MEM_SUBTREE(INDICE_SBTR)
2071         SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY)=SBTR_CUR(MYID)
2072         INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY+1
2073         WHAT = 3
2074         IF(dble(MEM_SUBTREE(INDICE_SBTR)).GE.DM_THRES_MEM)THEN
2075 111        CONTINUE
2076            CALL SMUMPS_460(
2077     &           WHAT, COMM, SLAVEF,
2078#if ! defined(OLD_LOAD_MECHANISM)
2079     &           FUTURE_NIV2,
2080#endif
2081     &           dble(MEM_SUBTREE(INDICE_SBTR)), dble(0),MYID, IERR  )
2082            IF ( IERR == -1 )THEN
2083               CALL SMUMPS_467(COMM_LD, KEEP)
2084               GOTO 111
2085            ELSE IF ( IERR .NE. 0 ) THEN
2086               WRITE(*,*)
2087     &         "Internal Error 1 in SMUMPS_501",
2088     &         IERR
2089               CALL MUMPS_ABORT()
2090            ENDIF
2091         ENDIF
2092         SBTR_MEM(MYID)=SBTR_MEM(MYID)+
2093     &        dble(MEM_SUBTREE(INDICE_SBTR))
2094         INDICE_SBTR=INDICE_SBTR+1
2095         IF(INSIDE_SUBTREE.EQ.0)THEN
2096            INSIDE_SUBTREE=1
2097         ENDIF
2098      ELSE
2099         IF(INODE.EQ.MY_ROOT_SBTR(INDICE_SBTR-1))THEN
2100            WHAT = 3
2101            COST=-SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY-1)
2102            IF(abs(COST).GE.DM_THRES_MEM)THEN
2103 112           CONTINUE
2104               CALL SMUMPS_460(
2105     &              WHAT, COMM, SLAVEF,
2106#if ! defined(OLD_LOAD_MECHANISM)
2107     &              FUTURE_NIV2,
2108#endif
2109     &              COST, dble(0) ,MYID,IERR  )
2110               IF ( IERR == -1 )THEN
2111                  CALL SMUMPS_467(COMM_LD, KEEP)
2112                  GOTO 112
2113               ELSE IF ( IERR .NE. 0 ) THEN
2114                  WRITE(*,*)
2115     &        "Internal Error 3 in SMUMPS_501",
2116     &        IERR
2117                  CALL MUMPS_ABORT()
2118               ENDIF
2119            ENDIF
2120            INDICE_SBTR_ARRAY=INDICE_SBTR_ARRAY-1
2121            SBTR_MEM(MYID)=SBTR_MEM(MYID)-
2122     &           SBTR_PEAK_ARRAY(INDICE_SBTR_ARRAY)
2123            SBTR_CUR(MYID)=SBTR_CUR_ARRAY(INDICE_SBTR_ARRAY)
2124            IF(INDICE_SBTR_ARRAY.EQ.1)THEN
2125               SBTR_CUR(MYID)=dble(0)
2126               INSIDE_SUBTREE=0
2127            ENDIF
2128         ENDIF
2129         ENDIF
2130         CONTINUE
2131      END SUBROUTINE SMUMPS_501
2132      SUBROUTINE SMUMPS_504
2133     &      (SLAVEF,KEEP,KEEP8,PROCS,MEM_DISTRIB,NCB,NFRONT,
2134     &       NSLAVES_NODE,TAB_POS,
2135     &       SLAVES_LIST,SIZE_SLAVES_LIST,MYID)
2136      IMPLICIT NONE
2137      INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST
2138      INTEGER(8) KEEP8(150)
2139      INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID
2140      INTEGER, intent(in) :: PROCS(SLAVEF+1)
2141      INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1)
2142      INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
2143      INTEGER, intent(out):: TAB_POS(SLAVEF+2)
2144      INTEGER, intent(out):: NSLAVES_NODE
2145      INTEGER NUMBER_OF_PROCS,K47, K48, K50
2146      INTEGER(8) :: K821
2147      DOUBLE PRECISION DK821
2148      INTEGER J
2149      INTEGER KMIN, KMAX
2150      INTEGER OTHERS,CHOSEN,SMALL_SET,ACC
2151      DOUBLE PRECISION SOMME,TMP_SUM
2152      INTEGER AFFECTED
2153      INTEGER ADDITIONNAL_ROWS,i,X,REF,POS
2154      INTEGER(8)::TOTAL_MEM
2155      LOGICAL FORCE_CAND
2156      DOUBLE PRECISION TEMP(SLAVEF),PEAK
2157      INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF)
2158      EXTERNAL MPI_WTIME
2159      DOUBLE PRECISION MPI_WTIME
2160      IF (KEEP8(21) .GT. 0_8) THEN
2161      write(*,*)MYID,
2162     & ": Internal Error 1 in SMUMPS_504"
2163      CALL MUMPS_ABORT()
2164      ENDIF
2165      K821=abs(KEEP8(21))
2166      DK821=dble(K821)
2167      K50=KEEP(50)
2168      K48=KEEP(48)
2169      K47=KEEP(47)
2170      IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN
2171        FORCE_CAND = .FALSE.
2172      ELSE
2173        FORCE_CAND = (mod(KEEP(24),2).eq.0)
2174      END IF
2175      IF(K48.NE.4)THEN
2176         WRITE(*,*)'SMUMPS_COMPUTE_PARTI_ACTV_MEM_K821
2177     &      should be called with KEEP(48) different from 4'
2178         CALL MUMPS_ABORT()
2179      ENDIF
2180         KMIN=1
2181         KMAX=int(K821/int(NFRONT,8))
2182         IF(FORCE_CAND)THEN
2183            DO i=1,PROCS(SLAVEF+1)
2184               WLOAD(i)=DM_MEM(PROCS(i))
2185               IDWLOAD(i)=PROCS(i)
2186            ENDDO
2187            NUMBER_OF_PROCS=PROCS(SLAVEF+1)
2188            OTHERS=NUMBER_OF_PROCS
2189         ELSE
2190            NUMBER_OF_PROCS=SLAVEF
2191            WLOAD(1:SLAVEF) = DM_MEM(0:NUMBER_OF_PROCS-1)
2192            DO i=1,NUMBER_OF_PROCS
2193               IDWLOAD(i) = i - 1
2194            ENDDO
2195            OTHERS=NUMBER_OF_PROCS-1
2196         ENDIF
2197         NB_ROWS=0
2198         CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD)
2199         TOTAL_MEM=int(NCB,8)*int(NFRONT,8)
2200         SOMME=dble(0)
2201         J=1
2202         PEAK=dble(0)
2203         DO i=1,NUMBER_OF_PROCS
2204            IF((IDWLOAD(i).NE.MYID))THEN
2205               PEAK=max(PEAK,WLOAD(i))
2206               TEMP_ID(J)=IDWLOAD(i)
2207               TEMP(J)=WLOAD(i)
2208                IF(BDC_SBTR)THEN
2209                   TEMP(J)=TEMP(J)+SBTR_MEM(IDWLOAD(i))-
2210     &                  SBTR_CUR(IDWLOAD(i))
2211                ENDIF
2212                IF(BDC_POOL)THEN
2213                   TEMP(J)=TEMP(J)+POOL_MEM(TEMP_ID(J))
2214                ENDIF
2215                IF(BDC_M2_MEM)THEN
2216                   TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1)
2217                ENDIF
2218                J=J+1
2219            ENDIF
2220         ENDDO
2221         NUMBER_OF_PROCS=J-1
2222         CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID)
2223         IF(K50.EQ.0)THEN
2224           PEAK=max(PEAK,
2225     &       DM_MEM(MYID)+dble(NFRONT)*dble(NFRONT-NCB))
2226         ELSE
2227           PEAK=max(PEAK,
2228     &       DM_MEM(MYID)+dble(NFRONT-NCB)*dble(NFRONT-NCB))
2229         ENDIF
2230         PEAK=max(PEAK,TEMP(OTHERS))
2231         SOMME=dble(0)
2232         DO i=1,NUMBER_OF_PROCS
2233           SOMME=SOMME+TEMP(OTHERS)-TEMP(i)
2234         ENDDO
2235         IF(SOMME.LE.dble(TOTAL_MEM)) THEN
2236            GOTO 096
2237         ENDIF
2238 096     CONTINUE
2239         SOMME=dble(0)
2240         DO i=1,OTHERS
2241            SOMME=SOMME+TEMP(OTHERS)-TEMP(i)
2242         ENDDO
2243         IF(dble(TOTAL_MEM).GE.SOMME) THEN
2244#if defined (OLD_PART)
2245 887        CONTINUE
2246#endif
2247            AFFECTED=0
2248            CHOSEN=0
2249            ACC=0
2250            DO i=1,OTHERS
2251               IF(K50.EQ.0)THEN
2252                  IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN
2253                     TMP_SUM=DK821
2254                  ELSE
2255                     TMP_SUM=TEMP(OTHERS)-TEMP(i)
2256                  ENDIF
2257                  X=int(TMP_SUM/dble(NFRONT))
2258                  IF((ACC+X).GT.NCB) X=NCB-ACC
2259               ENDIF
2260               IF(K50.NE.0)THEN
2261                  IF((TEMP(OTHERS)-TEMP(i)).GT.DK821)THEN
2262                     TMP_SUM=DK821
2263                  ELSE
2264                     TMP_SUM=TEMP(OTHERS)-TEMP(i)
2265                  ENDIF
2266                  X=int((-dble(NFRONT-NCB+ACC)
2267     &                 +sqrt(((dble(NFRONT-NCB+ACC)*
2268     &                 dble(NFRONT-NCB+ACC))+dble(4)*
2269     &                 (TMP_SUM))))/
2270     &                 dble(2))
2271                  IF((ACC+X).GT.NCB) X=NCB-ACC
2272                  IF(X.LE.0) THEN
2273                     WRITE(*,*)"Internal Error 2 in
2274     &                    SMUMPS_504"
2275                     CALL MUMPS_ABORT()
2276                  ENDIF
2277               ENDIF
2278               NB_ROWS(i)=X
2279               CHOSEN=CHOSEN+1
2280               ACC=ACC+X
2281               IF(NCB-ACC.LT.KMIN) GOTO 111
2282               IF(NCB.EQ.ACC) GOTO 111
2283               ENDDO
2284 111           CONTINUE
2285               IF((ACC.GT.NCB))THEN
2286                  X=0
2287                  DO i=1,OTHERS
2288                     X=X+NB_ROWS(i)
2289                  ENDDO
2290                  WRITE(*,*)'NCB=',NCB,',SOMME=',X
2291                  WRITE(*,*)MYID,
2292     &               ": Internal Error 3 in SMUMPS_504"
2293                  CALL MUMPS_ABORT()
2294               ENDIF
2295               IF((NCB.NE.ACC))THEN
2296                  IF(K50.NE.0)THEN
2297                     IF(CHOSEN.NE.0)THEN
2298                        ADDITIONNAL_ROWS=NCB-ACC
2299                        NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+ADDITIONNAL_ROWS
2300                     ELSE
2301                        TMP_SUM=dble(TOTAL_MEM)/dble(NUMBER_OF_PROCS)
2302                        CHOSEN=0
2303                        ACC=0
2304                        DO i=1,OTHERS
2305                           X=int((-dble(NFRONT-NCB+ACC)
2306     &                          +sqrt(((dble(NFRONT-NCB+ACC)*
2307     &                          dble(NFRONT-NCB+ACC))+dble(4)*
2308     &                          (TMP_SUM))))/
2309     &                          dble(2))
2310                           IF((ACC+X).GT.NCB) X=NCB-ACC
2311                           NB_ROWS(i)=X
2312                           CHOSEN=CHOSEN+1
2313                           ACC=ACC+X
2314                           IF(NCB-ACC.LT.KMIN) GOTO 002
2315                           IF(NCB.EQ.ACC) GOTO 002
2316                        ENDDO
2317 002                    CONTINUE
2318                        IF(ACC.LT.NCB)THEN
2319                           NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+(NCB-ACC)
2320                        ENDIF
2321                     ENDIF
2322                     GOTO 333
2323                  ENDIF
2324                  ADDITIONNAL_ROWS=NCB-ACC
2325                  DO i=CHOSEN,1,-1
2326                     IF(int(dble(ADDITIONNAL_ROWS)/
2327     &                    dble(i)).NE.0)THEN
2328                        GOTO 222
2329                     ENDIF
2330                  ENDDO
2331 222              CONTINUE
2332                  X=int(dble(ADDITIONNAL_ROWS)/dble(i))
2333                  DO J=1,i
2334                     NB_ROWS(J)=NB_ROWS(J)+X
2335                     ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
2336                  ENDDO
2337                  IF(ADDITIONNAL_ROWS.NE.0) THEN
2338                     NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS
2339                  ENDIF
2340               ENDIF
2341 333           CONTINUE
2342               IF(NB_ROWS(CHOSEN).EQ.0) CHOSEN=CHOSEN-1
2343               GOTO 889
2344            ELSE
2345               DO i=OTHERS,1,-1
2346                  SOMME=dble(0)
2347                  DO J=1,i
2348                     SOMME=SOMME+TEMP(J)
2349                  ENDDO
2350                  SOMME=(dble(i)*TEMP(i))-SOMME
2351                  IF(dble(TOTAL_MEM).GE.SOMME) GOTO 444
2352               ENDDO
2353 444           CONTINUE
2354               REF=i
2355               DO J=1,i
2356                  IF(TEMP(J).EQ.TEMP(i)) THEN
2357                     SMALL_SET=J
2358                     GOTO 123
2359                  ENDIF
2360               ENDDO
2361 123           CONTINUE
2362               IF(i.EQ.1)THEN
2363                  NB_ROWS(i)=NCB
2364                  CHOSEN=1
2365                  GOTO 666
2366               ENDIF
2367 323           CONTINUE
2368               AFFECTED=0
2369               CHOSEN=0
2370               ACC=0
2371               DO i=1,SMALL_SET
2372                  IF(K50.EQ.0)THEN
2373                     IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN
2374                        TMP_SUM=DK821
2375                     ELSE
2376                        TMP_SUM=TEMP(SMALL_SET)-TEMP(i)
2377                     ENDIF
2378                     X=int(TMP_SUM/dble(NFRONT))
2379                     IF((ACC+X).GT.NCB) X=NCB-ACC
2380                  ENDIF
2381                  IF(K50.NE.0)THEN
2382                     IF((TEMP(SMALL_SET)-TEMP(i)).GT.DK821)THEN
2383                        TMP_SUM=DK821
2384                     ELSE
2385                        TMP_SUM=TEMP(SMALL_SET)-TEMP(i)
2386                     ENDIF
2387                      X=int((-dble(NFRONT-NCB+ACC)
2388     &                  +sqrt(((dble(NFRONT-NCB+ACC)*
2389     &                  dble(NFRONT-NCB+ACC))+dble(4)*
2390     &                  (TMP_SUM))))/
2391     &                  dble(2))
2392                     IF(X.LT.0)THEN
2393                        WRITE(*,*)MYID,
2394     &             ': Internal error 4 in SMUMPS_504'
2395                        CALL MUMPS_ABORT()
2396                     ENDIF
2397                     IF((ACC+X).GT.NCB) X=NCB-ACC
2398                  ENDIF
2399                  NB_ROWS(i)=X
2400                  ACC=ACC+X
2401                  CHOSEN=CHOSEN+1
2402                  IF(NCB-ACC.LT.KMIN) GOTO 888
2403                  IF(NCB.EQ.ACC) GOTO 888
2404                  IF(ACC.GT.NCB) THEN
2405                    WRITE(*,*)MYID,
2406     &            ': Internal error 5 in SMUMPS_504'
2407                    CALL MUMPS_ABORT()
2408                  ENDIF
2409               ENDDO
2410 888           CONTINUE
2411               SOMME=dble(0)
2412               X=NFRONT-NCB
2413               IF((ACC.GT.NCB))THEN
2414                  WRITE(*,*)MYID,
2415     &           ':Internal error 6 in SMUMPS_504'
2416                  CALL MUMPS_ABORT()
2417               ENDIF
2418               IF((ACC.LT.NCB))THEN
2419                  IF(K50.NE.0)THEN
2420                     IF(SMALL_SET.LT.OTHERS)THEN
2421                       SMALL_SET=REF+1
2422                       REF=SMALL_SET
2423                       GOTO 323
2424                     ELSE
2425                       NB_ROWS(CHOSEN)=NB_ROWS(CHOSEN)+NCB-ACC
2426                       GOTO 666
2427                     ENDIF
2428                 ENDIF
2429                 ADDITIONNAL_ROWS=NCB-ACC
2430#if ! defined (OLD_PART)
2431                 i=CHOSEN+1
2432                 DO WHILE ((ADDITIONNAL_ROWS.NE.0)
2433     &                .AND.(i.LE.NUMBER_OF_PROCS))
2434                    J=1
2435#if ! defined (PART1_)
2436                    X=int(ADDITIONNAL_ROWS/(i-1))
2437                    IF((X.EQ.0).AND.(ADDITIONNAL_ROWS.NE.0))THEN
2438                       DO WHILE ((J.LT.i).AND.(ADDITIONNAL_ROWS.GT.0))
2439                         NB_ROWS(J)=NB_ROWS(J)+1
2440                         ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1
2441                         J=J+1
2442                       ENDDO
2443                       IF(ADDITIONNAL_ROWS.NE.0)THEN
2444                          WRITE(*,*)MYID,
2445     &             ':Internal error 7 in SMUMPS_504'
2446                         CALL MUMPS_ABORT()
2447                      ENDIF
2448                      GOTO 047
2449                    ENDIF
2450                    IF((TEMP(1)+dble((NB_ROWS(1)+X)*NFRONT)).LE.
2451     &                   TEMP(i))THEN
2452                       DO WHILE ((ADDITIONNAL_ROWS.NE.0)
2453     &                      .AND.(J.LT.i))
2454                          AFFECTED=X
2455                          IF((AFFECTED+NB_ROWS(J)).GT.
2456     &                         KMAX)THEN
2457                             AFFECTED=KMAX-NB_ROWS(J)
2458                          ENDIF
2459                          NB_ROWS(J)=NB_ROWS(J)+AFFECTED
2460                          ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
2461     &                         AFFECTED
2462                          J=J+1
2463                       ENDDO
2464                    ELSE
2465#endif
2466                       DO WHILE ((ADDITIONNAL_ROWS.NE.0)
2467     &                      .AND.(J.LE.i))
2468                          AFFECTED=int((TEMP(i)-(TEMP(J)+
2469     &                         (dble(NB_ROWS(J))*dble(NFRONT))))
2470     &                         /dble(NFRONT))
2471                          IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN
2472                             AFFECTED=KMAX-NB_ROWS(J)
2473                          ENDIF
2474                          IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN
2475                             AFFECTED=ADDITIONNAL_ROWS
2476                          ENDIF
2477                          NB_ROWS(J)=NB_ROWS(J)+AFFECTED
2478                          ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED
2479                          J=J+1
2480                       ENDDO
2481#if ! defined (PART1_)
2482                    ENDIF
2483#endif
2484                    i=i+1
2485                 ENDDO
2486 047             CONTINUE
2487                 IF((ADDITIONNAL_ROWS.EQ.0).AND.
2488     &                (i.LT.NUMBER_OF_PROCS))THEN
2489                    CHOSEN=i-1
2490                 ELSE
2491                    CHOSEN=i-2
2492                 ENDIF
2493#if ! defined (PART1_)
2494                 IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND.
2495     &                 (ADDITIONNAL_ROWS.NE.0))THEN
2496                    DO i=1,CHOSEN
2497                       NB_ROWS(i)=NB_ROWS(i)+1
2498                       ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1
2499                       IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048
2500                    ENDDO
2501 048                CONTINUE
2502                 ENDIF
2503#endif
2504                 IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND.
2505     &                (ADDITIONNAL_ROWS.NE.0))THEN
2506                    i=CHOSEN+1
2507                    DO WHILE ((ADDITIONNAL_ROWS.NE.0)
2508     &                   .AND.(i.LE.NUMBER_OF_PROCS))
2509                       J=1
2510                       DO WHILE ((ADDITIONNAL_ROWS.NE.0)
2511     &                      .AND.(J.LE.i))
2512                          AFFECTED=int((TEMP(i)-(TEMP(J)+
2513     &                         (dble(NB_ROWS(J))*
2514     &                         dble(NFRONT))))/dble(NFRONT))
2515                          IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN
2516                             AFFECTED=ADDITIONNAL_ROWS
2517                          ENDIF
2518                          NB_ROWS(J)=NB_ROWS(J)+AFFECTED
2519                          ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED
2520                          J=J+1
2521                       ENDDO
2522                       i=i+1
2523                    ENDDO
2524                    CHOSEN=i-2
2525                 ENDIF
2526                 CONTINUE
2527#else
2528                 DO i=CHOSEN,1,-1
2529                    IF(int(dble(ADDITIONNAL_ROWS)/
2530     &                   dble(i)).NE.0)THEN
2531                       GOTO 555
2532                    ENDIF
2533                 ENDDO
2534 555             CONTINUE
2535                 X=int(dble(ADDITIONNAL_ROWS)/dble(i))
2536                 DO J=1,i
2537                    IF(NB_ROWS(J)+X.GT.K821/NCB)THEN
2538                       ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
2539     &                      ((K821/NCB)-NB_ROWS(J))
2540                       NB_ROWS(J)=(K821/NFRONT)
2541                    ELSE IF ((TEMP(J)+dble((NB_ROWS(J)+X))*
2542     &                      dble(NFRONT)).GT.
2543     &                 PEAK)THEN
2544                       AFFECTED=int((PEAK-(TEMP(J)+dble(NB_ROWS(J))*
2545     &                 dble(NFRONT))/dble(NFRONT))
2546                       ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED
2547                       NB_ROWS(J)=NB_ROWS(J)+AFFECTED
2548                    ELSE
2549                       NB_ROWS(J)=NB_ROWS(J)+X
2550                       ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
2551                    ENDIF
2552                    IF(((TEMP(J)+dble(NB_ROWS(J))*dble(NFRONT))
2553     &               .GT. PEAK)
2554     &               .AND.(SMALL_SET.LT.OTHERS))THEN
2555                       WRITE(*,*)MYID,
2556     &           ':Internal error 8 in SMUMPS_504'
2557                       SMALL_SET=SMALL_SET+1
2558                       CALL MUMPS_ABORT()
2559                    ENDIF
2560                 ENDDO
2561                 SOMME=dble(0)
2562                 DO J=1,CHOSEN
2563                   SOMME=SOMME+NB_ROWS(J)
2564                 ENDDO
2565                 IF(ADDITIONNAL_ROWS.NE.0) THEN
2566                       DO J=1,CHOSEN
2567                          IF(NB_ROWS(J).LT.0)THEN
2568                            WRITE(*,*)MYID,
2569     &           ':Internal error 9 in SMUMPS_504'
2570                            CALL MUMPS_ABORT()
2571                          ENDIF
2572                          IF ((TEMP(J)+dble(NB_ROWS(J))
2573     &                 *dble(NFRONT)).GT.
2574     &                 PEAK)THEN
2575                             WRITE(*,*)MYID,
2576     &         ':Internal error 10 in SMUMPS_504'
2577                          CALL MUMPS_ABORT()
2578                       ENDIF
2579                          IF ((TEMP(J)+dble(NB_ROWS(J)+
2580     &                 ADDITIONNAL_ROWS)*dble(NFRONT)).GE.
2581     &                 PEAK)THEN
2582                            AFFECTED=int((PEAK-(TEMP(J)+
2583     &                      dble(NB_ROWS(J))*
2584     &                      dble(NFRONT))/dble(NFRONT))
2585                            ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED
2586                            NB_ROWS(J)=NB_ROWS(J)+AFFECTED
2587                            IF((TEMP(J)+dble(NFRONT)*
2588     &                           dble(NB_ROWS(J))).GT.
2589     &                         PEAK)THEN
2590                               WRITE(*,*)MYID,
2591     &         ':Internal error 11 in SMUMPS_504'
2592                              CALL MUMPS_ABORT()
2593                            ENDIF
2594                          ELSE
2595                            NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS
2596                            ADDITIONNAL_ROWS=0
2597                          ENDIF
2598                          IF(ADDITIONNAL_ROWS.EQ.0) GOTO 666
2599                       ENDDO
2600                       IF(SMALL_SET.EQ.(NUMBER_OF_PROCS)) THEN
2601                         NB_ROWS=0
2602                         GOTO 887
2603                       ENDIF
2604                       i=CHOSEN+1
2605                       DO WHILE ((ADDITIONNAL_ROWS.NE.0)
2606     &                        .AND.(i.LE.NUMBER_OF_PROCS))
2607                          IF(NB_ROWS(i)+ADDITIONNAL_ROWS.LT.K821/NFRONT)
2608     &                         THEN
2609                             NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS
2610                             ADDITIONNAL_ROWS=0
2611                          ELSE
2612                             ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-(K821/
2613     &                            NFRONT
2614     &                            -NB_ROWS(i))
2615                             NB_ROWS(i)=K821/NFRONT
2616                          ENDIF
2617                          i=i+1
2618                       ENDDO
2619                       CHOSEN=i-1
2620                       IF(ADDITIONNAL_ROWS.NE.0)THEN
2621                         DO i=CHOSEN,1,-1
2622                          IF(int(dble(ADDITIONNAL_ROWS)/dble(i))
2623     &                          .NE.0)THEN
2624                             GOTO 372
2625                          ENDIF
2626                         ENDDO
2627 372                     CONTINUE
2628                         X=int(dble(ADDITIONNAL_ROWS)/dble(i))
2629                         DO J=1,i
2630                           NB_ROWS(J)=NB_ROWS(J)+X
2631                           ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
2632                         ENDDO
2633                         IF(ADDITIONNAL_ROWS.NE.0) THEN
2634                           NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS
2635                         ENDIF
2636                    ENDIF
2637                    ENDIF
2638#endif
2639              ENDIF
2640 666          CONTINUE
2641              SOMME=dble(0)
2642              X=0
2643              POS=0
2644              DO i=1,CHOSEN
2645                 IF(K50.NE.0) THEN
2646                    IF((TEMP(i)+dble(NB_ROWS(i))
2647     &                   *dble(X+NB_ROWS(i)+NFRONT-NCB))
2648     &                   .GT.PEAK)THEN
2649                       SMALL_SET=SMALL_SET+1
2650                    ENDIF
2651                 ENDIF
2652                 IF(K50.EQ.0) THEN
2653                    IF((TEMP(i)+dble(NB_ROWS(i))*dble(NFRONT))
2654     &                   .GT.PEAK)THEN
2655                       SMALL_SET=SMALL_SET+1
2656                    ENDIF
2657                 ENDIF
2658                 X=X+NB_ROWS(i)
2659                 SOMME=SOMME+ dble(NB_ROWS(i))
2660              ENDDO
2661           ENDIF
2662 889       CONTINUE
2663           J=CHOSEN
2664           X=0
2665           DO i=J,1,-1
2666             IF(NB_ROWS(i).EQ.0)THEN
2667                IF(X.EQ.1)THEN
2668                  WRITE(*,*)MYID,
2669     &         ':Internal error 12 in SMUMPS_504'
2670                  CALL MUMPS_ABORT()
2671                ENDIF
2672                CHOSEN=CHOSEN-1
2673             ELSE
2674                  IF(NB_ROWS(i).GT.0)THEN
2675                    X=1
2676                  ELSE
2677                    WRITE(*,*)
2678     &            'Internal error 13 in SMUMPS_504'
2679                    CALL MUMPS_ABORT()
2680                  ENDIF
2681             ENDIF
2682          ENDDO
2683           NSLAVES_NODE=CHOSEN
2684           TAB_POS(NSLAVES_NODE+1)= NCB+1
2685           TAB_POS(SLAVEF+2) = CHOSEN
2686           POS=1
2687           DO i=1,CHOSEN
2688              SLAVES_LIST(i)=TEMP_ID(i)
2689              TAB_POS(i)=POS
2690              POS=POS+NB_ROWS(i)
2691              IF(NB_ROWS(i).LE.0)THEN
2692                WRITE(*,*)
2693     &          'Internal error 14 in SMUMPS_504'
2694                 CALL MUMPS_ABORT()
2695              ENDIF
2696           ENDDO
2697           DO i=CHOSEN+1,NUMBER_OF_PROCS
2698              SLAVES_LIST(i)=TEMP_ID(i)
2699           ENDDO
2700           IF(POS.NE.(NCB+1))THEN
2701              WRITE(*,*)
2702     &        'Internal error 15 in SMUMPS_504'
2703             CALL MUMPS_ABORT()
2704           ENDIF
2705      END SUBROUTINE SMUMPS_504
2706      SUBROUTINE SMUMPS_518
2707     &      (NCBSON_MAX,SLAVEF,KEEP,KEEP8,
2708     &       PROCS,MEM_DISTRIB,NCB,NFRONT,
2709     &       NSLAVES_NODE,TAB_POS,
2710     &       SLAVES_LIST,SIZE_SLAVES_LIST,MYID,INODE,MP,LP)
2711      IMPLICIT NONE
2712      INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST
2713      INTEGER(8) KEEP8(150)
2714      INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID
2715      INTEGER, intent(in) :: NCBSON_MAX
2716      INTEGER, intent(in) :: PROCS(SLAVEF+1)
2717      INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE
2718      INTEGER, intent(in) :: MP,LP
2719      INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
2720      INTEGER, intent(out):: TAB_POS(SLAVEF+2)
2721      INTEGER, intent(out):: NSLAVES_NODE
2722      INTEGER NUMBER_OF_PROCS,K47,K48, K50,K83,K69
2723      INTEGER(8) :: K821
2724      INTEGER J
2725      INTEGER KMIN, KMAX
2726      INTEGER OTHERS,CHOSEN,SMALL_SET,ACC
2727      DOUBLE PRECISION SOMME,TMP_SUM,DELTA,A,B,C,MASTER_WORK
2728      INTEGER AFFECTED
2729      INTEGER ADDITIONNAL_ROWS,i,X,REF,POS,NELIM
2730      INTEGER(8) X8
2731      LOGICAL FORCE_CAND,SMP
2732      DOUBLE PRECISION BANDE_K821
2733      INTEGER NB_SAT,NB_ZERO
2734      DOUBLE PRECISION TEMP(SLAVEF),TOTAL_COST, MAX_MEM_ALLOW
2735      INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF)
2736      INTEGER NSLAVES_REF,NCB_FILS
2737      EXTERNAL MPI_WTIME,MUMPS_442
2738      INTEGER MUMPS_442
2739      INTEGER POS_MIN_LOAD,SIZE_MY_SMP,WHAT,ADDITIONNAL_ROWS_SPECIAL
2740      LOGICAL HAVE_TYPE1_SON
2741      DOUBLE PRECISION MIN_LOAD,MAX_LOAD,TEMP_MAX_LOAD
2742      DOUBLE PRECISION MPI_WTIME
2743      DOUBLE PRECISION BUF_SIZE,NELIM_MEM_SIZE
2744      DOUBLE PRECISION MEM_SIZE_STRONG(SLAVEF),MEM_SIZE_WEAK(SLAVEF)
2745      K821=abs(KEEP8(21))
2746      TEMP_MAX_LOAD=dble(0)
2747      K50=KEEP(50)
2748      K48=KEEP(48)
2749      K47=KEEP(47)
2750      K83=KEEP(83)
2751      K69=0
2752      NCB_FILS=NCBSON_MAX
2753      IF(int(NCB_FILS,8)*int(min(NCB,NCB_FILS),8).GT.K821)THEN
2754         HAVE_TYPE1_SON=.TRUE.
2755      ELSE
2756         HAVE_TYPE1_SON=.FALSE.
2757      ENDIF
2758      SMP=(K69.NE.0)
2759      IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN
2760        FORCE_CAND = .FALSE.
2761      ELSE
2762        FORCE_CAND = (mod(KEEP(24),2).eq.0)
2763      END IF
2764      NELIM=NFRONT-NCB
2765         KMAX=int(K821/int(NCB,8))
2766         IF(FORCE_CAND)THEN
2767           DO i=1,PROCS(SLAVEF+1)
2768              WLOAD(i)=LOAD_FLOPS(PROCS(i))
2769              IDWLOAD(i)=PROCS(i)
2770              IF (WLOAD(i) < -0.5d0 ) THEN
2771                 IF((MP.GT.0).AND.(LP.GE.2))THEN
2772                    WRITE(MP,*)MYID,': Warning: negative load ',
2773     &                   WLOAD(i)
2774                 ENDIF
2775              ENDIF
2776              WLOAD(i)=max(WLOAD(i),0.0d0)
2777           ENDDO
2778           NUMBER_OF_PROCS=PROCS(SLAVEF+1)
2779            OTHERS=NUMBER_OF_PROCS
2780         ELSE
2781            NUMBER_OF_PROCS=SLAVEF
2782            WLOAD(1:SLAVEF) = LOAD_FLOPS(0:NUMBER_OF_PROCS-1)
2783            DO i=1,NUMBER_OF_PROCS
2784               IDWLOAD(i) = i - 1
2785               IF (WLOAD(i) < -0.5d0 ) THEN
2786                  IF((MP.GT.0).AND.(LP.GE.2))THEN
2787                     WRITE(MP,*)MYID,': Negative load ',
2788     &                    WLOAD(i)
2789                  ENDIF
2790               ENDIF
2791               WLOAD(i)=max(WLOAD(i),0.0d0)
2792            ENDDO
2793            OTHERS=NUMBER_OF_PROCS-1
2794         ENDIF
2795         KMAX=int(NCB/OTHERS)
2796         KMIN=MUMPS_442(int(NCB,8)*int(KMAX,8),K50,KMAX,NCB)
2797         NB_ROWS=0
2798         CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD, IDWLOAD)
2799         IF(K50.EQ.0)THEN
2800            TOTAL_COST=dble( NELIM ) * dble ( NCB ) +
2801     &           dble(NCB) * dble(NELIM)*dble(2*NFRONT-NELIM-1)
2802         ELSE
2803            TOTAL_COST=dble(NELIM) * dble ( NCB ) *
2804     &           dble(NFRONT+1)
2805         ENDIF
2806         CALL MUMPS_511(NFRONT,NELIM,NELIM,K50,
2807     &        2,MASTER_WORK)
2808         SOMME=dble(0)
2809         J=1
2810         IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.GT.K83))THEN
2811            MASTER_WORK=dble(KEEP(88))*MASTER_WORK/dble(100)
2812         ENDIF
2813         IF(FORCE_CAND.AND.(NUMBER_OF_PROCS.LE.K83))THEN
2814            MASTER_WORK=dble(KEEP(87))*MASTER_WORK/dble(100)
2815         ENDIF
2816         IF(MASTER_WORK.LT.dble(1))THEN
2817            MASTER_WORK=dble(1)
2818         ENDIF
2819         NSLAVES_REF=int(TOTAL_COST/MASTER_WORK)+1
2820         IF(FORCE_CAND)THEN
2821            NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS)
2822         ELSE
2823            NSLAVES_REF=min(NSLAVES_REF,NUMBER_OF_PROCS-1)
2824         ENDIF
2825        DO i=1,NUMBER_OF_PROCS
2826           IF((IDWLOAD(i).NE.MYID))THEN
2827              TEMP_ID(J)=IDWLOAD(i)
2828              TEMP(J)=WLOAD(i)
2829              IF(BDC_M2_FLOPS)THEN
2830                 TEMP(J)=TEMP(J)+NIV2(TEMP_ID(J)+1)
2831              ENDIF
2832              J=J+1
2833           ENDIF
2834        ENDDO
2835        NUMBER_OF_PROCS=J-1
2836        CALL MUMPS_558(NUMBER_OF_PROCS, TEMP, TEMP_ID)
2837        SOMME=dble(0)
2838        TMP_SUM=dble(0)
2839        DO i=1,OTHERS
2840            SOMME=SOMME+TEMP(OTHERS)-TEMP(i)
2841            TMP_SUM=TMP_SUM+TEMP(i)
2842        ENDDO
2843         TMP_SUM=(TMP_SUM/dble(OTHERS))+
2844     &        (TOTAL_COST/dble(OTHERS))
2845         SIZE_MY_SMP=OTHERS
2846         MIN_LOAD=TEMP(1)
2847         POS_MIN_LOAD=1
2848         IF(.NOT.SMP) MAX_LOAD=TEMP(OTHERS)
2849         IF(SMP)THEN
2850            J=1
2851            DO i=1,OTHERS
2852               IF(MEM_DISTRIB(TEMP_ID(i)).EQ.1)THEN
2853                  IF(TEMP(i).LE.TMP_SUM)THEN
2854                     WLOAD(J)=TEMP(i)
2855                     IDWLOAD(J)=TEMP_ID(i)
2856                     J=J+1
2857                  ELSE
2858                  ENDIF
2859               ENDIF
2860            ENDDO
2861            MAX_LOAD=WLOAD(J-1)
2862            SIZE_MY_SMP=J-1
2863            DO i=1,OTHERS
2864               IF((MEM_DISTRIB(TEMP_ID(i)).NE.1).OR.
2865     &              ((MEM_DISTRIB(TEMP_ID(i)).EQ.1).AND.
2866     &              (TEMP(i).GE.TMP_SUM)))THEN
2867                  WLOAD(J)=TEMP(i)
2868                  IDWLOAD(J)=TEMP_ID(i)
2869                  J=J+1
2870               ENDIF
2871            ENDDO
2872            TEMP=WLOAD
2873            TEMP_ID=IDWLOAD
2874         ENDIF
2875        IF(BDC_MD)THEN
2876           BUF_SIZE=dble(K821)
2877           IF (KEEP(201).EQ.2) THEN
2878              A=dble(int((dble(KEEP(100))/dble(2))/dble(NELIM)))
2879              IF(K50.EQ.0)THEN
2880                 BUF_SIZE=min(BUF_SIZE,A*dble(NCB))
2881              ELSE
2882                 BUF_SIZE=min(BUF_SIZE,A*A)
2883              ENDIF
2884           ENDIF
2885           BUF_SIZE=dble(K821)
2886           DO i=1,NUMBER_OF_PROCS
2887              A=dble(MD_MEM(TEMP_ID(i)))/
2888     &             dble(NELIM)
2889              A=A*dble(NFRONT)
2890              IF(K50.EQ.0)THEN
2891                 B=dble(int(dble(NCB)/dble(NUMBER_OF_PROCS))+1)*
2892     &                dble(NFRONT)
2893              ELSE
2894                 WHAT = 5
2895#if ! defined (OOC_PAR_MEM_SLAVE_SELECT) && ! defined (OOC_PAR_MEM2)
2896                 CALL MUMPS_503(WHAT, KEEP,KEEP8, NCB,
2897     &                NFRONT, min(NCB,OTHERS), J, X8)
2898#endif
2899                 B=dble(X8)+(dble(J)*dble(NELIM))
2900              ENDIF
2901              NELIM_MEM_SIZE=A+B
2902              MEM_SIZE_WEAK(i)=NELIM_MEM_SIZE
2903            IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN
2904               IF(BDC_M2_MEM)THEN
2905                  MEM_SIZE_STRONG(i)=
2906     &                 dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))-
2907     &                 LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)
2908               ELSE
2909                  MEM_SIZE_STRONG(i)=
2910     &                 dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))-
2911     &                 LU_USAGE(TEMP_ID(i))
2912               ENDIF
2913            ELSE
2914               IF(BDC_SBTR)THEN
2915                  IF(BDC_M2_MEM)THEN
2916                     MEM_SIZE_STRONG(i)=
2917     &                    dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))-
2918     &                    LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)-
2919     &                    (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i)))
2920                  ELSE
2921                     MEM_SIZE_STRONG(i)=
2922     &                    dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))-
2923     &                    LU_USAGE(TEMP_ID(i))-
2924     &                    (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i)))
2925                  ENDIF
2926               ENDIF
2927            ENDIF
2928            IF(min(MEM_SIZE_STRONG(i),MEM_SIZE_WEAK(i)).LT.dble(0))THEN
2929                IF(MEM_SIZE_STRONG(i).LT.0.0d0)THEN
2930                   MEM_SIZE_STRONG(i)=dble(0)
2931                ELSE
2932                   MEM_SIZE_WEAK(i)=dble(0)
2933                ENDIF
2934             ENDIF
2935          ENDDO
2936       ELSE
2937          BUF_SIZE=dble(K821)
2938          DO i=1,NUMBER_OF_PROCS
2939            IF((SBTR_WHICH_M.EQ.0).OR.(.NOT.BDC_SBTR))THEN
2940               IF(BDC_M2_MEM)THEN
2941                  MEM_SIZE_STRONG(i)=
2942     &                 dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))-
2943     &                 LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)
2944               ELSE
2945                  MEM_SIZE_STRONG(i)=
2946     &                 dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))-
2947     &                 LU_USAGE(TEMP_ID(i))
2948               ENDIF
2949            ELSE
2950               IF(BDC_SBTR)THEN
2951                  IF(BDC_M2_MEM)THEN
2952                     MEM_SIZE_STRONG(i)=
2953     &                    dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))-
2954     &                    LU_USAGE(TEMP_ID(i))-NIV2(TEMP_ID(i)+1)-
2955     &                    (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i)))
2956                  ELSE
2957                     MEM_SIZE_STRONG(i)=
2958     &                    dble(TAB_MAXS(TEMP_ID(i)))-DM_MEM(TEMP_ID(i))-
2959     &                    LU_USAGE(TEMP_ID(i))-
2960     &                    (SBTR_MEM(TEMP_ID(i))-SBTR_CUR(TEMP_ID(i)))
2961                  ENDIF
2962               ENDIF
2963            ENDIF
2964            MEM_SIZE_STRONG(i)=max(dble(0),MEM_SIZE_STRONG(i))
2965            MEM_SIZE_WEAK(i)=huge(MEM_SIZE_WEAK(i))
2966          ENDDO
2967       ENDIF
2968       IF((((NUMBER_OF_PROCS.LE.K83).AND.FORCE_CAND).AND.
2969     &      (TOTAL_COST.GE.SOMME)).OR.
2970     &      (.NOT.FORCE_CAND).OR.
2971     &      (((NUMBER_OF_PROCS+1).GT.K83).AND.FORCE_CAND))THEN
2972               REF=NSLAVES_REF
2973               SMALL_SET=NSLAVES_REF
2974               IF(.NOT.SMP)THEN
2975                  DO i=NSLAVES_REF,1,-1
2976                     SOMME=dble(0)
2977                     DO J=1,i
2978                        SOMME=SOMME+TEMP(J)
2979                     ENDDO
2980                     SOMME=(dble(i)*TEMP(i))-SOMME
2981                     IF(TOTAL_COST.GE.SOMME) GOTO 444
2982                  ENDDO
2983 444              CONTINUE
2984                  REF=i
2985                  SMALL_SET=REF
2986                  MAX_LOAD=TEMP(SMALL_SET)
2987               ELSE
2988                  X=min(SIZE_MY_SMP,NSLAVES_REF)
2989 450              CONTINUE
2990                  SOMME=dble(0)
2991                  DO J=1,X
2992                     SOMME=SOMME+(TEMP(X)-TEMP(J))
2993                  ENDDO
2994                  IF(SOMME.GT.TOTAL_COST)THEN
2995                     X=X-1
2996                     GOTO 450
2997                  ELSE
2998                     IF(X.LT.SIZE_MY_SMP) THEN
2999                        REF=X
3000                        SMALL_SET=REF
3001                        MAX_LOAD=TEMP(SMALL_SET)
3002                     ELSE
3003                        X=min(SIZE_MY_SMP,NSLAVES_REF)
3004                        J=X+1
3005                        MAX_LOAD=TEMP(X)
3006                        TMP_SUM=MAX_LOAD
3007                        DO i=X+1,OTHERS
3008                           IF(TEMP(i).GT.MAX_LOAD)THEN
3009                              SOMME=SOMME+(dble(i-1)*(TEMP(i)-MAX_LOAD))
3010                              TMP_SUM=MAX_LOAD
3011                              MAX_LOAD=TEMP(i)
3012                           ELSE
3013                              SOMME=SOMME+(MAX_LOAD-TEMP(i))
3014                           ENDIF
3015                           IF(i.EQ.NSLAVES_REF)THEN
3016                              SMALL_SET=NSLAVES_REF
3017                              REF=SMALL_SET
3018                              GOTO 323
3019                           ENDIF
3020                           IF(SOMME.GT.TOTAL_COST)THEN
3021                              REF=i-1
3022                              SMALL_SET=i-1
3023                              MAX_LOAD=TMP_SUM
3024                              GOTO 323
3025                           ENDIF
3026                        ENDDO
3027                     ENDIF
3028                  ENDIF
3029               ENDIF
3030 323           CONTINUE
3031               MAX_LOAD=dble(0)
3032               DO i=1,SMALL_SET
3033                  MAX_LOAD=max(MAX_LOAD,TEMP(i))
3034               ENDDO
3035               TEMP_MAX_LOAD=MAX_LOAD
3036               NB_ROWS=0
3037               TMP_SUM=dble(0)
3038               CHOSEN=0
3039               ACC=0
3040               NB_SAT=0
3041               NB_ZERO=0
3042               DO i=1,SMALL_SET
3043                  IF(K50.EQ.0)THEN
3044                     X=int(BUF_SIZE/dble(NCB+1))-1
3045                     BANDE_K821=dble(X)*dble(NFRONT)
3046                  ELSE
3047                     A=dble(1)
3048                     B=dble(ACC+2)
3049                     C=-BUF_SIZE+dble(ACC+NELIM)
3050                     DELTA=(B*B)-(dble(4)*A*C)
3051                     X=int((-B+sqrt(DELTA))/(dble(2)*A))
3052                     IF(X.GT.NCB-ACC) X=NCB-ACC
3053                     BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3054                  ENDIF
3055                  IF(HAVE_TYPE1_SON)THEN
3056                     IF(K50.EQ.0)THEN
3057                        X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1))
3058                        BANDE_K821=dble(X)*dble(NFRONT)
3059                     ELSE
3060                        A=dble(1)
3061                        B=dble(ACC+2+NELIM)
3062                        C=-BUF_SIZE+dble(ACC+NELIM)
3063                        DELTA=(B*B)-(dble(4)*A*C)
3064                        X=int((-B+sqrt(DELTA))/(dble(2)*A))
3065                        IF(X.GT.NCB-ACC) X=NCB-ACC
3066                        BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3067                     ENDIF
3068                  ENDIF
3069                  MAX_MEM_ALLOW=BANDE_K821
3070                  IF(BDC_MD)THEN
3071                     MAX_MEM_ALLOW=min(
3072     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3073     &                    BANDE_K821)
3074                     MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
3075                  ENDIF
3076                  IF(K50.EQ.0)THEN
3077                     KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
3078                     X=int((MAX_LOAD-TEMP(i))/
3079     &                    (dble(NELIM)*dble(2*NFRONT-NELIM)))
3080                     IF(X.GE.KMAX)THEN
3081                        IF(KMAX.GE.KMIN)THEN
3082                           X=KMAX
3083                           NB_SAT=NB_SAT+1
3084                        ELSE
3085                           X=0
3086                        ENDIF
3087                     ELSE
3088                        IF(X.LT.KMIN)THEN
3089                           X=0
3090                        ENDIF
3091                     ENDIF
3092                     IF((ACC+X).GT.NCB) X=NCB-ACC
3093                  ENDIF
3094                  IF(K50.NE.0)THEN
3095                        A=dble(1)
3096                        B=dble(ACC+NELIM)
3097                        C=dble(-MAX_MEM_ALLOW)
3098                        DELTA=((B*B)-(dble(4)*A*C))
3099                        KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3100                     A=dble(NELIM)
3101                     B=dble(NELIM)*(dble(NELIM)+dble(2*ACC+1))
3102                     C=-(MAX_LOAD-TEMP(i))
3103                     DELTA=(B*B-(dble(4)*A*C))
3104                     X=int((-B+sqrt(DELTA))/(dble(2)*A))
3105                     IF(X.LT.0) THEN
3106                        WRITE(*,*)MYID,
3107     &    ': Internal error 1 in SMUMPS_518'
3108                        CALL MUMPS_ABORT()
3109                     ENDIF
3110                     IF(X.GE.KMAX)THEN
3111                        IF(KMAX.GE.KMIN)THEN
3112                           X=KMAX
3113                           NB_SAT=NB_SAT+1
3114                        ELSE
3115                           X=0
3116                        ENDIF
3117                     ELSE
3118                        IF(X.LT.KMIN)THEN
3119                           X=0
3120                        ENDIF
3121                     ENDIF
3122                     IF((ACC+X).GT.NCB) X=NCB-ACC
3123                  ENDIF
3124                  NB_ROWS(i)=X
3125                  ACC=ACC+X
3126                  CHOSEN=CHOSEN+1
3127                  IF(SMP)THEN
3128                     IF(MIN_LOAD.GT.TEMP(i))THEN
3129                        MIN_LOAD=TEMP(i)
3130                        POS_MIN_LOAD=i
3131                     ENDIF
3132                  ENDIF
3133                  TMP_SUM=MAX_LOAD
3134                  IF(K50.EQ.0)THEN
3135                     MAX_LOAD=max(MAX_LOAD,
3136     &                    (TEMP(i)+(dble(NELIM) *
3137     &                    dble(NB_ROWS(i)))+
3138     &                    (dble(NB_ROWS(i))*dble(NELIM)*
3139     &                    dble(2*NFRONT-NELIM-1))))
3140                  ELSE
3141                     MAX_LOAD=max(MAX_LOAD,
3142     &               TEMP(i)+(dble(NELIM) * dble(NB_ROWS(i)))*
3143     &                    dble(2*(NELIM+ACC)-NB_ROWS(i)
3144     &                    -NELIM+1))
3145                  ENDIF
3146                  IF(TMP_SUM.LT.MAX_LOAD)THEN
3147                  ENDIF
3148                  IF(NCB-ACC.LT.KMIN) GOTO 888
3149                  IF(NCB.EQ.ACC) GOTO 888
3150                  IF(ACC.GT.NCB) THEN
3151                    WRITE(*,*)MYID,
3152     &      ': Internal error 2 in SMUMPS_518'
3153                    CALL MUMPS_ABORT()
3154                  ENDIF
3155               ENDDO
3156 888           CONTINUE
3157               SOMME=dble(0)
3158               X=NFRONT-NCB
3159               IF((ACC.GT.NCB))THEN
3160                  WRITE(*,*)MYID,
3161     &          ': Internal error 3 in SMUMPS_518'
3162                  CALL MUMPS_ABORT()
3163               ENDIF
3164               IF((ACC.LT.NCB))THEN
3165                  IF(K50.NE.0)THEN
3166                     IF(SMALL_SET.LE.OTHERS)THEN
3167                       IF((NB_SAT.EQ.SMALL_SET).AND.(SMALL_SET.LT.
3168     &                      NSLAVES_REF))THEN
3169                          SMALL_SET=REF+1
3170                          REF=REF+1
3171                          NB_ROWS=0
3172                          GOTO 323
3173                       ENDIF
3174                       ADDITIONNAL_ROWS_SPECIAL=NCB-ACC
3175                       DO i=1,SMALL_SET
3176                          MAX_LOAD=TEMP_MAX_LOAD
3177                          ADDITIONNAL_ROWS=NCB-ACC
3178                          SOMME=dble(NELIM)*
3179     &                         dble(ADDITIONNAL_ROWS)*
3180     &                         dble(2*NFRONT-ADDITIONNAL_ROWS-NELIM
3181     &                         +1)
3182                          SOMME=SOMME/dble(SMALL_SET-NB_SAT)
3183                          NB_ROWS=0
3184                          NB_ZERO=0
3185                          ACC=0
3186                          CHOSEN=0
3187                          NB_SAT=0
3188                          IF(SMP)THEN
3189                             MIN_LOAD=TEMP(1)
3190                             POS_MIN_LOAD=1
3191                          ENDIF
3192                          DO J=1,SMALL_SET
3193                             A=dble(1)
3194                             B=dble(ACC+2)
3195                             C=-BUF_SIZE+dble(ACC+NELIM)
3196                             DELTA=(B*B)-(dble(4)*A*C)
3197                             X=int((-B+sqrt(DELTA))/(dble(2)*A))
3198                             IF(X.GT.NCB-ACC) X=NCB-ACC
3199                             BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3200                             IF(HAVE_TYPE1_SON)THEN
3201                                A=dble(1)
3202                                B=dble(ACC+2+NELIM)
3203                                C=-BUF_SIZE+dble(ACC+NELIM)
3204                                DELTA=(B*B)-(dble(4)*A*C)
3205                                X=int((-B+sqrt(DELTA))/(dble(2)*A))
3206                                IF(X.GT.NCB-ACC) X=NCB-ACC
3207                                BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3208                             ENDIF
3209                             MAX_MEM_ALLOW=BANDE_K821
3210                             IF(BDC_MD)THEN
3211                                MAX_MEM_ALLOW=min(
3212     &                        min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)),
3213     &                               BANDE_K821)
3214                                MAX_MEM_ALLOW=max(dble(0),
3215     &                               MAX_MEM_ALLOW)
3216                             ENDIF
3217                             A=dble(1)
3218                             B=dble(ACC+NELIM)
3219                             C=dble(-MAX_MEM_ALLOW)
3220                             DELTA=((B*B)-(dble(4)*A*C))
3221                             KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3222                             A=dble(NELIM)
3223                             B=(dble(NELIM)*dble(NELIM+2*ACC+1))
3224                             C=-(MAX_LOAD-TEMP(J)+SOMME)
3225                             DELTA=(B*B-(dble(4)*A*C))
3226                             X=int((-B+sqrt(DELTA))/(dble(2)*A))
3227                             X=X+1
3228                             IF(X.LT.0) THEN
3229                                WRITE(*,*)MYID,
3230     &    ': Internal error 4 in SMUMPS_518'
3231                                CALL MUMPS_ABORT()
3232                             ENDIF
3233                             IF(X.GE.KMAX)THEN
3234                                IF(KMAX.GE.KMIN)THEN
3235                                   X=KMAX
3236                                   NB_SAT=NB_SAT+1
3237                                ELSE
3238                                   NB_ZERO=NB_ZERO+1
3239                                   X=0
3240                                ENDIF
3241                             ELSE
3242                                IF(X.LT.min(KMIN,KMAX))THEN
3243                                   NB_ZERO=NB_ZERO+1
3244                                   X=0
3245                                ENDIF
3246                             ENDIF
3247                             IF((ACC+X).GT.NCB) X=NCB-ACC
3248                             NB_ROWS(J)=X
3249                             IF(SMP)THEN
3250                                IF(MIN_LOAD.GT.TEMP(J))THEN
3251                                   MIN_LOAD=TEMP(J)
3252                                   POS_MIN_LOAD=i
3253                                ENDIF
3254                             ENDIF
3255                             CHOSEN=CHOSEN+1
3256                             ACC=ACC+X
3257                             TMP_SUM=MAX_LOAD
3258                             TEMP_MAX_LOAD=max(TEMP_MAX_LOAD,
3259     &                            TEMP(J)+(dble(NELIM) *
3260     &                            dble(NB_ROWS(J)))*
3261     &                            dble(2*(NELIM+
3262     &                            ACC)-NB_ROWS(J)
3263     &                            -NELIM+1))
3264                             IF(REF.LE.NUMBER_OF_PROCS-1)THEN
3265                                IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN
3266                                   IF(SMALL_SET.LT.NSLAVES_REF)THEN
3267                                      SMALL_SET=REF+1
3268                                      REF=REF+1
3269                                      NB_ROWS=0
3270                                      GOTO 323
3271                                   ENDIF
3272                                ENDIF
3273                             ENDIF
3274                             IF(NCB.EQ.ACC) GOTO 666
3275                          ENDDO
3276                          IF(NB_SAT.EQ.SMALL_SET)THEN
3277                             IF(SMALL_SET.LT.NSLAVES_REF)THEN
3278                                SMALL_SET=REF+1
3279                                REF=REF+1
3280                                NB_ROWS=0
3281                                GOTO 323
3282                             ELSE
3283                                GOTO 434
3284                             ENDIF
3285                          ENDIF
3286                          IF(NB_ZERO.EQ.SMALL_SET)THEN
3287                             IF(SMALL_SET.LT.NSLAVES_REF)THEN
3288                                SMALL_SET=REF+1
3289                                REF=REF+1
3290                                NB_ROWS=0
3291                                GOTO 323
3292                             ELSE
3293                                GOTO 434
3294                             ENDIF
3295                          ENDIF
3296                          IF((NB_SAT+NB_ZERO).EQ.SMALL_SET)THEN
3297                             IF(SMALL_SET.LT.NSLAVES_REF)THEN
3298                                SMALL_SET=REF+1
3299                                REF=REF+1
3300                                NB_ROWS=0
3301                                GOTO 323
3302                             ELSE
3303                                GOTO 434
3304                             ENDIF
3305                          ENDIF
3306                       ENDDO
3307 434                   CONTINUE
3308                       ADDITIONNAL_ROWS=NCB-ACC
3309                       IF(ADDITIONNAL_ROWS.NE.0)THEN
3310                          IF(ADDITIONNAL_ROWS.LT.KMIN)THEN
3311                             i=CHOSEN
3312                             J=ACC
3313 436                         CONTINUE
3314                             IF(NB_ROWS(i).NE.0)THEN
3315                                J=J-NB_ROWS(i)
3316                                A=dble(1)
3317                                B=dble(J+2)
3318                                C=-BUF_SIZE+dble(J+NELIM)
3319                                DELTA=(B*B)-(dble(4)*A*C)
3320                                X=int((-B+sqrt(DELTA))/(dble(2)*A))
3321                                IF(X.GT.NCB-J) X=NCB-J
3322                                BANDE_K821=dble(X)*dble(NELIM+J+X)
3323                                IF(HAVE_TYPE1_SON)THEN
3324                                   A=dble(1)
3325                                   B=dble(J+2+NELIM)
3326                                   C=-BUF_SIZE+dble(J+NELIM)
3327                                   DELTA=(B*B)-(dble(4)*A*C)
3328                                   X=int((-B+sqrt(DELTA))/(dble(2)*A))
3329                                   IF(X.GT.NCB-J) X=NCB-J
3330                                   BANDE_K821=dble(X)*dble(NELIM+J+X)
3331                                ENDIF
3332                                MAX_MEM_ALLOW=BANDE_K821
3333                                IF(BDC_MD)THEN
3334                                   MAX_MEM_ALLOW=min(
3335     &                         min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3336     &                                  BANDE_K821)
3337                                   MAX_MEM_ALLOW=max(dble(0),
3338     &                                  MAX_MEM_ALLOW)
3339                                ENDIF
3340                                A=dble(1)
3341                                B=dble(J+NELIM)
3342                                C=dble(-MAX_MEM_ALLOW)
3343                                DELTA=((B*B)-(dble(4)*A*C))
3344                                KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3345                                IF(NB_ROWS(i).NE.KMAX)THEN
3346                                   IF(NCB-J.LE.KMAX)THEN
3347                                      NB_ROWS(i)=+NCB-J
3348                                      ADDITIONNAL_ROWS=0
3349                                   ENDIF
3350                                ENDIF
3351                                TEMP_MAX_LOAD=max(TEMP_MAX_LOAD,
3352     &                               TEMP(i)+
3353     &                               (dble(NELIM) * dble(NB_ROWS(i)))*
3354     &                               dble(2*(NELIM+
3355     &                               ACC)-NB_ROWS(i)
3356     &                               -NELIM+1))
3357                                IF(REF.LE.NUMBER_OF_PROCS-1)THEN
3358                                   IF(TEMP_MAX_LOAD.GT.TEMP(REF+1))THEN
3359                                      IF(SMALL_SET.LT.NSLAVES_REF)THEN
3360                                         SMALL_SET=REF+1
3361                                         REF=REF+1
3362                                         NB_ROWS=0
3363                                         GOTO 323
3364                                      ENDIF
3365                                   ENDIF
3366                                ENDIF
3367                             ELSE
3368                                i=i-1
3369                                IF(i.NE.0)GOTO 436
3370                             ENDIF
3371                             IF(ADDITIONNAL_ROWS.NE.0)THEN
3372                                i=CHOSEN
3373                                IF(i.NE.SMALL_SET)THEN
3374                                   i=i+1
3375                                   IF(NB_ROWS(i).NE.0)THEN
3376                                      WRITE(*,*)MYID,
3377     &    ': Internal error 5 in SMUMPS_518'
3378                                      CALL MUMPS_ABORT()
3379                                   ENDIF
3380                                ENDIF
3381                                NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS
3382                                ADDITIONNAL_ROWS=0
3383                             ENDIF
3384                             CHOSEN=i
3385                          ENDIF
3386                       ENDIF
3387                       i=CHOSEN+1
3388                       DO WHILE ((ADDITIONNAL_ROWS.NE.0)
3389     &                      .AND.(i.LE.NUMBER_OF_PROCS))
3390                          IF((TEMP(i).LE.MAX_LOAD))THEN
3391                             A=dble(1)
3392                             B=dble(ACC+2)
3393                             C=-BUF_SIZE+dble(ACC+NELIM)
3394                             DELTA=(B*B)-(dble(4)*A*C)
3395                             X=int((-B+sqrt(DELTA))/(dble(2)*A))
3396                             IF(X.GT.NCB-ACC) X=NCB-ACC
3397                             BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3398                             IF(HAVE_TYPE1_SON)THEN
3399                                A=dble(1)
3400                                B=dble(ACC+2+NELIM)
3401                                C=-BUF_SIZE+dble(ACC+NELIM)
3402                                DELTA=(B*B)-(dble(4)*A*C)
3403                                X=int((-B+sqrt(DELTA))/(dble(2)*A))
3404                                IF(X.GT.NCB-ACC) X=NCB-ACC
3405                                BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3406                             ENDIF
3407                             MAX_MEM_ALLOW=BANDE_K821
3408                             IF(BDC_MD)THEN
3409                                MAX_MEM_ALLOW=min(
3410     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3411     &                               BANDE_K821)
3412                                MAX_MEM_ALLOW=max(dble(0),
3413     &                               MAX_MEM_ALLOW)
3414                             ENDIF
3415                             A=dble(1)
3416                             B=dble(ACC+NELIM)
3417                             C=dble(-MAX_MEM_ALLOW)
3418                             DELTA=((B*B)-(dble(4)*A*C))
3419                             KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3420                             A=dble(NELIM)
3421                             B=dble(NELIM)*dble(NELIM+2*ACC+1)
3422                             C=-(MAX_LOAD-TEMP(i))
3423                             DELTA=(B*B-(dble(4)*A*C))
3424                             X=int((-B+sqrt(DELTA))/(dble(2)*A))
3425                             IF(X.GE.KMAX)THEN
3426                                IF(KMAX.GE.KMIN)THEN
3427                                   X=KMAX
3428                                ELSE
3429                                   X=0
3430                                ENDIF
3431                             ELSE
3432                                IF(X.LT.KMIN)THEN
3433                                   X=0
3434                                ENDIF
3435                             ENDIF
3436                             IF((ACC+X).GT.NCB) X=NCB-ACC
3437                             NB_ROWS(i)=X
3438                             ACC=ACC+X
3439                             ADDITIONNAL_ROWS=NCB-ACC
3440                          ELSE IF((TEMP(i).GT.MAX_LOAD))THEN
3441                             MAX_LOAD=TEMP(i)
3442                             NB_SAT=0
3443                             ACC=0
3444                             NB_ROWS=0
3445                             DO J=1,i
3446                                A=dble(1)
3447                                B=dble(ACC+2)
3448                                C=-BUF_SIZE+dble(ACC+NELIM)
3449                                DELTA=(B*B)-(dble(4)*A*C)
3450                                X=int((-B+sqrt(DELTA))/(dble(2)*A))
3451                                IF(X.GT.NCB-ACC) X=NCB-ACC
3452                                BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3453                                IF(HAVE_TYPE1_SON)THEN
3454                                   A=dble(1)
3455                                   B=dble(ACC+2+NELIM)
3456                                   C=-BUF_SIZE+dble(ACC+NELIM)
3457                                   DELTA=(B*B)-(dble(4)*A*C)
3458                                   X=int((-B+sqrt(DELTA))/(dble(2)*A))
3459                                   IF(X.GT.NCB-ACC) X=NCB-ACC
3460                                   BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3461                                ENDIF
3462                                MAX_MEM_ALLOW=BANDE_K821
3463                                IF(BDC_MD)THEN
3464                                   MAX_MEM_ALLOW=min(
3465     &                    min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)),
3466     &                                  BANDE_K821)
3467                                   MAX_MEM_ALLOW=max(dble(0),
3468     &                                  MAX_MEM_ALLOW)
3469                                ENDIF
3470                                A=dble(1)
3471                                B=dble(ACC+NELIM)
3472                                C=dble(-MAX_MEM_ALLOW)
3473                                DELTA=((B*B)-(dble(4)*A*C))
3474                                KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3475                                A=dble(NELIM)
3476                                B=dble(NELIM)*dble(NELIM+2*ACC+1)
3477                                C=-(MAX_LOAD-TEMP(J))
3478                                DELTA=(B*B-(dble(4)*A*C))
3479                                X=int((-B+sqrt(DELTA))/(dble(2)*A))
3480                                IF(X.LT.0) THEN
3481                        WRITE(*,*)MYID,
3482     &    ': Internal error 6 in SMUMPS_518'
3483                                   CALL MUMPS_ABORT()
3484                                ENDIF
3485                                IF(X.GE.KMAX)THEN
3486                                   IF(KMAX.GE.KMIN)THEN
3487                                      X=KMAX
3488                                      NB_SAT=NB_SAT+1
3489                                   ELSE
3490                                      X=0
3491                                   ENDIF
3492                                ELSE
3493                                   IF(X.LT.min(KMIN,KMAX))THEN
3494                                      X=0
3495                                   ENDIF
3496                                ENDIF
3497                                IF((ACC+X).GT.NCB) X=NCB-ACC
3498                                NB_ROWS(J)=X
3499                                IF(SMP)THEN
3500                                   IF(MIN_LOAD.GT.TEMP(J))THEN
3501                                      MIN_LOAD=TEMP(J)
3502                                      POS_MIN_LOAD=i
3503                                   ENDIF
3504                                ENDIF
3505                                ACC=ACC+X
3506                                MAX_LOAD=max(MAX_LOAD,
3507     &                               TEMP(J)+
3508     &                               (dble(NELIM)*dble(NB_ROWS(J)))*
3509     &                               dble(2*(NELIM+
3510     &                               ACC)-NB_ROWS(J)
3511     &                               -NELIM+1))
3512                                IF(NCB.EQ.ACC) GOTO 741
3513                                IF(NCB-ACC.LT.KMIN) GOTO 210
3514                             ENDDO
3515 210                         CONTINUE
3516                          ENDIF
3517 741                      CONTINUE
3518                          i=i+1
3519                          ADDITIONNAL_ROWS=NCB-ACC
3520                       ENDDO
3521                       CHOSEN=i-1
3522                       IF(ADDITIONNAL_ROWS.NE.0)THEN
3523                          ADDITIONNAL_ROWS=NCB-ACC
3524                          SOMME=dble(NELIM)*dble(ADDITIONNAL_ROWS)*
3525     &                         dble(2*NFRONT-ADDITIONNAL_ROWS-
3526     &                         NELIM+1)
3527                          SOMME=SOMME/dble(NUMBER_OF_PROCS)
3528                          NB_ROWS=0
3529                          ACC=0
3530                          CHOSEN=0
3531                          IF(SMP)THEN
3532                             MIN_LOAD=TEMP(1)
3533                             POS_MIN_LOAD=1
3534                          ENDIF
3535                          DO i=1,OTHERS
3536                             A=dble(1)
3537                             B=dble(ACC+2)
3538                             C=-BUF_SIZE+dble(ACC+NELIM)
3539                             DELTA=(B*B)-(dble(4)*A*C)
3540                             X=int((-B+sqrt(DELTA))/(dble(2)*A))
3541                             IF(X.GT.NCB-ACC) X=NCB-ACC
3542                             BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3543                             IF(HAVE_TYPE1_SON)THEN
3544                                A=dble(1)
3545                                B=dble(ACC+2+NELIM)
3546                                C=-BUF_SIZE+dble(ACC+NELIM)
3547                                DELTA=(B*B)-(dble(4)*A*C)
3548                                X=int((-B+sqrt(DELTA))/(dble(2)*A))
3549                                IF(X.GT.NCB-ACC) X=NCB-ACC
3550                                BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3551                             ENDIF
3552                             MAX_MEM_ALLOW=BANDE_K821
3553                             IF(BDC_MD)THEN
3554                                MAX_MEM_ALLOW=min(
3555     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3556     &                               BANDE_K821)
3557                                MAX_MEM_ALLOW=max(dble(0),
3558     &                               MAX_MEM_ALLOW)
3559                             ENDIF
3560                             A=dble(1)
3561                             B=dble(ACC+NELIM)
3562                             C=dble(-MAX_MEM_ALLOW)
3563                             DELTA=((B*B)-(dble(4)*A*C))
3564                             KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3565                             A=dble(NELIM)
3566                             B=dble(NELIM)*dble(NELIM+2*ACC+1)
3567                             C=-(MAX_LOAD-TEMP(i)+SOMME)
3568                             DELTA=(B*B-(dble(4)*A*C))
3569                             X=int((-B+sqrt(DELTA))/(dble(2)*A))
3570                             IF(X.LT.0) THEN
3571                                WRITE(*,*)MYID,
3572     &    ': Internal error 7 in SMUMPS_518'
3573                                CALL MUMPS_ABORT()
3574                             ENDIF
3575                             IF(X.GE.KMAX)THEN
3576                                IF(KMAX.GE.KMIN)THEN
3577                                   X=KMAX
3578                                ELSE
3579                                   X=0
3580                                ENDIF
3581                             ELSE
3582                                IF(X.LT.min(KMIN,KMAX))THEN
3583                                   X=min(KMAX,KMIN)
3584                                ENDIF
3585                             ENDIF
3586                             IF((ACC+X).GT.NCB) X=NCB-ACC
3587                             NB_ROWS(i)=X
3588                             IF(SMP)THEN
3589                                IF(MIN_LOAD.GT.TEMP(i))THEN
3590                                   MIN_LOAD=TEMP(i)
3591                                   POS_MIN_LOAD=i
3592                                ENDIF
3593                             ENDIF
3594                             CHOSEN=CHOSEN+1
3595                             ACC=ACC+X
3596                             IF(NCB.EQ.ACC) GOTO 666
3597                             IF(NCB-ACC.LT.KMIN) GOTO 488
3598                          ENDDO
3599 488                      CONTINUE
3600                          ADDITIONNAL_ROWS=NCB-ACC
3601                          SOMME=dble(NELIM)*
3602     &                         dble(ADDITIONNAL_ROWS)*
3603     &                         dble(2*NFRONT-ADDITIONNAL_ROWS-
3604     &                         NELIM+1)
3605                          SOMME=SOMME/dble(NUMBER_OF_PROCS)
3606                          NB_ROWS=0
3607                          ACC=0
3608                          CHOSEN=0
3609                          IF(SMP)THEN
3610                             MIN_LOAD=TEMP(1)
3611                             POS_MIN_LOAD=1
3612                          ENDIF
3613                          DO i=1,OTHERS
3614                             A=dble(1)
3615                             B=dble(ACC+2)
3616                             C=-BUF_SIZE+dble(ACC+NELIM)
3617                             DELTA=(B*B)-(dble(4)*A*C)
3618                             X=int((-B+sqrt(DELTA))/(dble(2)*A))
3619                             IF(X.GT.NCB-ACC) X=NCB-ACC
3620                             BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3621                             IF(HAVE_TYPE1_SON)THEN
3622                                A=dble(1)
3623                                B=dble(ACC+2+NELIM)
3624                                C=-BUF_SIZE+dble(ACC+NELIM)
3625                                DELTA=(B*B)-(dble(4)*A*C)
3626                                X=int((-B+sqrt(DELTA))/(dble(2)*A))
3627                                IF(X.GT.NCB-ACC) X=NCB-ACC
3628                                BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3629                             ENDIF
3630                             MAX_MEM_ALLOW=BANDE_K821
3631                             IF(BDC_MD)THEN
3632                                MAX_MEM_ALLOW=min(BANDE_K821,
3633     &                               MEM_SIZE_STRONG(i))
3634                                MAX_MEM_ALLOW=max(dble(0),
3635     &                               MAX_MEM_ALLOW)
3636                             ENDIF
3637                             A=dble(1)
3638                             B=dble(ACC+NELIM)
3639                             C=dble(-MAX_MEM_ALLOW)
3640                             DELTA=((B*B)-(dble(4)*A*C))
3641                             KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3642                             A=dble(NELIM)
3643                             B=dble(NELIM)*dble(NELIM+2*ACC+1)
3644                             C=-(MAX_LOAD-TEMP(i)+SOMME)
3645                             DELTA=(B*B-(dble(4)*A*C))
3646                             X=int((-B+sqrt(DELTA))/(dble(2)*A))
3647                             IF(X.LT.0) THEN
3648                                WRITE(*,*)MYID,
3649     &    ': Internal error 8 in SMUMPS_518'
3650                                CALL MUMPS_ABORT()
3651                             ENDIF
3652                             IF(X.GE.KMAX)THEN
3653                                X=KMAX
3654                             ELSE
3655                                IF(X.LT.KMIN)THEN
3656                                   X=KMIN
3657                                ENDIF
3658                             ENDIF
3659                             IF((ACC+X).GT.NCB) X=NCB-ACC
3660                             NB_ROWS(i)=X
3661                             IF(SMP)THEN
3662                                IF(MIN_LOAD.GT.TEMP(i))THEN
3663                                   MIN_LOAD=TEMP(i)
3664                                   POS_MIN_LOAD=i
3665                                ENDIF
3666                             ENDIF
3667                             CHOSEN=CHOSEN+1
3668                             ACC=ACC+X
3669                             IF(NCB.EQ.ACC) GOTO 666
3670                             IF(NCB-ACC.LT.KMIN) GOTO 477
3671                          ENDDO
3672 477                      CONTINUE
3673                          IF(ACC.NE.NCB)THEN
3674                             NB_SAT=0
3675                             ACC=0
3676                             CHOSEN=0
3677                             IF(SMP)THEN
3678                                MIN_LOAD=TEMP(1)
3679                                POS_MIN_LOAD=1
3680                             ENDIF
3681                             DO i=1,OTHERS
3682                                A=dble(1)
3683                                B=dble(ACC+2)
3684                                C=-BUF_SIZE+dble(ACC+NELIM)
3685                                DELTA=(B*B)-(dble(4)*A*C)
3686                                X=int((-B+sqrt(DELTA))/(dble(2)*A))
3687                                IF(X.GT.NCB-ACC) X=NCB-ACC
3688                                BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3689                                IF(HAVE_TYPE1_SON)THEN
3690                                   A=dble(1)
3691                                   B=dble(ACC+2+NELIM)
3692                                   C=-BUF_SIZE+dble(ACC+NELIM)
3693                                   DELTA=(B*B)-(dble(4)*A*C)
3694                                   X=int((-B+sqrt(DELTA))/(dble(2)*A))
3695                                   IF(X.GT.NCB-ACC) X=NCB-ACC
3696                                   BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3697                                ENDIF
3698                                MAX_MEM_ALLOW=BANDE_K821
3699                                IF(BDC_MD)THEN
3700                                   MAX_MEM_ALLOW=min(BANDE_K821,
3701     &                                  MEM_SIZE_STRONG(i))
3702                                   MAX_MEM_ALLOW=max(dble(0),
3703     &                                  MAX_MEM_ALLOW)
3704                                ENDIF
3705                                A=dble(1)
3706                                B=dble(ACC+NELIM)
3707                                C=dble(-MAX_MEM_ALLOW)
3708                                DELTA=((B*B)-(dble(4)*A*C))
3709                                KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3710                                X=KMAX-NB_ROWS(i)
3711                                IF((ACC+NB_ROWS(i)+X).GT.NCB)
3712     &                               X=NCB-(ACC+NB_ROWS(i))
3713                                NB_ROWS(i)=NB_ROWS(i)+X
3714                                IF((dble(NB_ROWS(i))*
3715     &                               dble(NB_ROWS(i)+ACC)).EQ.
3716     &                               BANDE_K821)THEN
3717                                   NB_SAT=NB_SAT+1
3718                                ENDIF
3719                                ACC=ACC+NB_ROWS(i)
3720                                IF(SMP)THEN
3721                                   IF(MIN_LOAD.GT.TEMP(i))THEN
3722                                      MIN_LOAD=TEMP(i)
3723                                      POS_MIN_LOAD=i
3724                                   ENDIF
3725                                ENDIF
3726                                CHOSEN=CHOSEN+1
3727                                IF(NCB.EQ.ACC) GOTO 666
3728                                IF(NCB-ACC.LT.KMIN) GOTO 834
3729                             ENDDO
3730 834                         CONTINUE
3731                          ENDIF
3732                          IF(ACC.NE.NCB)THEN
3733                            ADDITIONNAL_ROWS=NCB-ACC
3734                            SOMME=dble(NELIM)*
3735     &                           dble(ADDITIONNAL_ROWS)*
3736     &                           dble(2*NFRONT-ADDITIONNAL_ROWS-
3737     &                           NELIM+1)
3738                            SOMME=SOMME/dble(NUMBER_OF_PROCS-NB_SAT)
3739                            ACC=0
3740                            DO i=1,CHOSEN
3741                               A=dble(1)
3742                               B=dble(ACC+2)
3743                               C=-BUF_SIZE+dble(ACC+NELIM)
3744                               DELTA=(B*B)-(dble(4)*A*C)
3745                               X=int((-B+sqrt(DELTA))/(dble(2)*A))
3746                               IF(X.GT.NCB-ACC) X=NCB-ACC
3747                               BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3748                               IF(HAVE_TYPE1_SON)THEN
3749                                  A=dble(1)
3750                                  B=dble(ACC+2+NELIM)
3751                                  C=-BUF_SIZE+dble(ACC+NELIM)
3752                                  DELTA=(B*B)-(dble(4)*A*C)
3753                                  X=int((-B+sqrt(DELTA))/(dble(2)*A))
3754                                  IF(X.GT.NCB-ACC) X=NCB-ACC
3755                                  BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3756                               ENDIF
3757                               IF((dble(NB_ROWS(i))*
3758     &                              dble(NB_ROWS(i)+ACC)).EQ.
3759     &                              BANDE_K821)THEN
3760                                  GOTO 102
3761                               ENDIF
3762                               A=dble(NELIM)
3763                               B=dble(NELIM)*
3764     &                              dble(NELIM+2*(ACC+NB_ROWS(i))+1)
3765                               C=-(SOMME)
3766                               DELTA=(B*B-(dble(4)*A*C))
3767                               X=int((-B+sqrt(DELTA))/(dble(2)*A))
3768                               A=dble(1)
3769                               B=dble(ACC+NELIM)
3770                               C=dble(-BANDE_K821)
3771                               DELTA=((B*B)-(dble(4)*A*C))
3772                               KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3773                               IF(X.LT.0) THEN
3774                                  WRITE(*,*)MYID,
3775     &    ': Internal error 9 in SMUMPS_518'
3776                                  CALL MUMPS_ABORT()
3777                               ENDIF
3778                               IF((ACC+X+NB_ROWS(i)).GT.NCB)THEN
3779                                  IF((NCB-ACC).GT.KMAX)THEN
3780                                     NB_ROWS(i)=KMAX
3781                                  ELSE
3782                                     NB_ROWS(i)=NCB-ACC
3783                                  ENDIF
3784                               ELSE
3785                                  IF((NB_ROWS(i)+X).GT.KMAX)THEN
3786                                     NB_ROWS(i)=KMAX
3787                                  ELSE
3788                                     NB_ROWS(i)=NB_ROWS(i)+X
3789                                  ENDIF
3790                               ENDIF
3791 102                           CONTINUE
3792                               ACC=ACC+NB_ROWS(i)
3793                               IF(NCB.EQ.ACC) THEN
3794                                  CHOSEN=i
3795                                  GOTO 666
3796                               ENDIF
3797                               IF(NCB-ACC.LT.KMIN) THEN
3798                                  CHOSEN=i
3799                                  GOTO 007
3800                               ENDIF
3801                            ENDDO
3802 007                        CONTINUE
3803                            DO i=1,CHOSEN
3804                               NB_ROWS(i)=NB_ROWS(i)+1
3805                               ACC=ACC+1
3806                               IF(ACC.EQ.NCB)GOTO 666
3807                            ENDDO
3808                            IF(ACC.LT.NCB)THEN
3809                               IF(SMP)THEN
3810                                  NB_ROWS(1)=NB_ROWS(1)+NCB-ACC
3811                               ELSE
3812                                  NB_ROWS(POS_MIN_LOAD)=
3813     &                                 NB_ROWS(POS_MIN_LOAD)+NCB-ACC
3814                               ENDIF
3815                            ENDIF
3816                         ENDIF
3817                         GOTO 666
3818                     ENDIF
3819                  ENDIF
3820                  GOTO 666
3821                 ENDIF
3822                 ADDITIONNAL_ROWS=NCB-ACC
3823                 i=CHOSEN+1
3824                 IF(NB_SAT.EQ.SMALL_SET) GOTO 777
3825                 DO i=1,SMALL_SET
3826                    IDWLOAD(i)=i
3827                    AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
3828                    BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3829                    IF(HAVE_TYPE1_SON)THEN
3830                       AFFECTED=int((BUF_SIZE-dble(NFRONT))/
3831     &                      (dble(NFRONT+1)))
3832                       BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3833                    ENDIF
3834                    MAX_MEM_ALLOW=BANDE_K821
3835                    IF(BDC_MD)THEN
3836                       MAX_MEM_ALLOW=min(
3837     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3838     &                      BANDE_K821)
3839                       MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
3840                    ENDIF
3841                    WLOAD(i)=MAX_MEM_ALLOW
3842                 ENDDO
3843                 CALL MUMPS_558(SMALL_SET, WLOAD, IDWLOAD)
3844                 NB_ZERO=0
3845                 IF((NB_SAT.EQ.SMALL_SET).AND.
3846     &                (SMALL_SET.LT.NSLAVES_REF))THEN
3847                    SMALL_SET=REF+1
3848                    REF=REF+1
3849                    NB_ROWS=0
3850                    GOTO 323
3851                 ENDIF
3852                 IF((NB_SAT.EQ.SMALL_SET).AND.
3853     &                (SMALL_SET.LE.NUMBER_OF_PROCS))GOTO 777
3854                 AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT))
3855                 AFFECTED=max(AFFECTED,1)
3856                 DO i=1,SMALL_SET
3857                    KMAX=int(WLOAD(i)/dble(NFRONT))
3858                    IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN
3859                       GOTO 912
3860                    ENDIF
3861                    IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED,
3862     &                   ADDITIONNAL_ROWS)).GT.KMAX)THEN
3863                       IF(NB_ROWS(IDWLOAD(i)).GT.KMAX)THEN
3864                       ENDIF
3865                       ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
3866     &                      (KMAX-NB_ROWS(IDWLOAD(i)))
3867                       NB_ROWS(IDWLOAD(i))=KMAX
3868                       NB_SAT=NB_SAT+1
3869                       IF(NB_SAT.EQ.SMALL_SET)THEN
3870                          IF(SMALL_SET.NE.NSLAVES_REF)THEN
3871                             SMALL_SET=REF+1
3872                             REF=REF+1
3873                             NB_ROWS=0
3874                             GOTO 323
3875                          ELSE
3876                             MAX_LOAD=max(MAX_LOAD,
3877     &                            (TEMP(IDWLOAD(i))+(dble(NELIM) *
3878     &                            dble(NB_ROWS(IDWLOAD(i))))+
3879     &                            (dble(NB_ROWS(IDWLOAD(i)))*
3880     &                            dble(NELIM))*
3881     &                            dble(2*NFRONT-NELIM-1)))
3882                             GOTO 777
3883                          ENDIF
3884                       ENDIF
3885                       AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT))
3886                       AFFECTED=max(AFFECTED,1)
3887                    ELSE
3888                       IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED,
3889     &                      ADDITIONNAL_ROWS)).GE.KMIN)THEN
3890                          X=min(AFFECTED,ADDITIONNAL_ROWS)
3891                          NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+
3892     &                         X
3893                          ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
3894                       ELSE
3895                          X=int((MAX_LOAD-TEMP(IDWLOAD(i)))/
3896     &                         (dble(NELIM)*dble(2*NFRONT-NELIM)))
3897                          IF(X+AFFECTED.GT.ADDITIONNAL_ROWS)THEN
3898                             X=ADDITIONNAL_ROWS
3899                          ELSE
3900                             X=AFFECTED+X
3901                          ENDIF
3902                          IF(X.GE.KMIN)THEN
3903                             NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+
3904     &                            X
3905                             ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
3906     &                            X
3907                          ELSE
3908                             NB_ZERO=NB_ZERO+1
3909                          ENDIF
3910                       ENDIF
3911                    ENDIF
3912 912                CONTINUE
3913                    MAX_LOAD=max(MAX_LOAD,
3914     &                   (TEMP(IDWLOAD(i))+(dble(NELIM)*
3915     &                   dble(NB_ROWS(IDWLOAD(i))))+
3916     &                   (dble(NB_ROWS(IDWLOAD(i)))*dble(NELIM))*
3917     &                   dble(2*NFRONT-NELIM-1)))
3918                    IF(SMALL_SET.LT.NUMBER_OF_PROCS)THEN
3919                       IF(MAX_LOAD.GT.TEMP(SMALL_SET+1))THEN
3920                          IF(SMALL_SET.LT.NSLAVES_REF)THEN
3921                             SMALL_SET=REF+1
3922                             REF=REF+1
3923                             NB_ROWS=0
3924                             GOTO 323
3925                          ENDIF
3926                       ENDIF
3927                    ENDIF
3928                    IF(SMALL_SET.EQ.NB_SAT)GOTO 777
3929                    IF(ADDITIONNAL_ROWS.EQ.0)THEN
3930                       CHOSEN=SMALL_SET
3931                       GOTO 049
3932                    ENDIF
3933                 ENDDO
3934 777             CONTINUE
3935                 IF((NB_ZERO.NE.0).AND.(ADDITIONNAL_ROWS.GE.KMIN))THEN
3936                    J=NB_ZERO
3937 732                CONTINUE
3938                    X=int(ADDITIONNAL_ROWS/(J))
3939                    IF(X.LT.KMIN)THEN
3940                       J=J-1
3941                       GOTO 732
3942                    ENDIF
3943                    IF(X*J.LT.ADDITIONNAL_ROWS)THEN
3944                       X=X+1
3945                    ENDIF
3946                    DO i=1,SMALL_SET
3947                       AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
3948                       BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3949                       IF(HAVE_TYPE1_SON)THEN
3950                          AFFECTED=int((BUF_SIZE-dble(NFRONT))/
3951     &                         dble(NFRONT+1))
3952                          BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3953                       ENDIF
3954                       MAX_MEM_ALLOW=BANDE_K821
3955                       IF(BDC_MD)THEN
3956                          MAX_MEM_ALLOW=min(
3957     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3958     &                         dble(BANDE_K821))
3959                          MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
3960                       ENDIF
3961                       KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
3962                       IF(NB_ROWS(i).EQ.0)THEN
3963                          IF(X.GT.ADDITIONNAL_ROWS)THEN
3964                             X=ADDITIONNAL_ROWS
3965                          ENDIF
3966                          IF(X.GT.KMAX)THEN
3967                             X=KMAX
3968                          ENDIF
3969                          IF(X.GT.KMIN)THEN
3970                             NB_ROWS(i)=X
3971                             ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
3972                             MAX_LOAD=max(MAX_LOAD,
3973     &                            (TEMP(i)+(dble(NELIM) *
3974     &                            dble(NB_ROWS(i)))+
3975     &                            (dble(NB_ROWS(i))*dble(NELIM))*
3976     &                            dble(2*NFRONT-NELIM-1)))
3977                          ENDIF
3978                       ENDIF
3979                    ENDDO
3980                 ENDIF
3981                 i=CHOSEN+1
3982                 DO WHILE ((ADDITIONNAL_ROWS.NE.0)
3983     &                .AND.(i.LE.NUMBER_OF_PROCS))
3984                    IF((TEMP(i).LE.MAX_LOAD))THEN
3985                       AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
3986                       BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3987                       IF(HAVE_TYPE1_SON)THEN
3988                          AFFECTED=int((BUF_SIZE-dble(NFRONT))/
3989     &                         dble(NFRONT+1))
3990                          BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3991                       ENDIF
3992                       MAX_MEM_ALLOW=BANDE_K821
3993                       IF(BDC_MD)THEN
3994                          MAX_MEM_ALLOW=min(
3995     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3996     &                         BANDE_K821)
3997                          MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
3998                       ENDIF
3999                       KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4000                       AFFECTED=int((MAX_LOAD-TEMP(i))/
4001     &                      (dble(NELIM)*dble(2*NFRONT-NELIM)))
4002                       IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN
4003                          AFFECTED=ADDITIONNAL_ROWS
4004                       ENDIF
4005                       IF(NB_ROWS(i).LT.KMAX)THEN
4006                          IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN
4007                             AFFECTED=KMAX-NB_ROWS(i)
4008                             NB_SAT=NB_SAT+1
4009                          ELSE
4010                             IF((AFFECTED+NB_ROWS(i)).LT.
4011     &                            KMIN)THEN
4012                                AFFECTED=0
4013                             ENDIF
4014                          ENDIF
4015                          NB_ROWS(i)=NB_ROWS(i)+AFFECTED
4016                          ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED
4017                       ENDIF
4018                    ELSE IF((TEMP(i).GT.MAX_LOAD))THEN
4019                       IF(NB_SAT.EQ.i-1) GOTO 218
4020                       X=(ADDITIONNAL_ROWS/(i-1-NB_SAT))
4021                       ACC=1
4022                       DO J=1,i-1
4023                          TMP_SUM=((dble(NELIM) * dble(NB_ROWS(J)+X))
4024     &                         +(dble(NB_ROWS(J)+X)*dble(NELIM))*
4025     &                         dble(2*NFRONT-NELIM-1))
4026                          IF((TEMP(J)+TMP_SUM).GT.MAX_LOAD)THEN
4027                             ACC=0
4028                          ENDIF
4029                       ENDDO
4030                       IF(ACC.EQ.1)THEN
4031                          MAX_LOAD=TEMP(i)
4032                          J=1
4033                          DO WHILE ((ADDITIONNAL_ROWS.NE.0)
4034     &                         .AND.(J.LT.i))
4035                             AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4036                             BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4037                             IF(HAVE_TYPE1_SON)THEN
4038                                AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4039     &                               dble(NFRONT+1))
4040                                BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4041                             ENDIF
4042                             AFFECTED=X
4043                             MAX_MEM_ALLOW=BANDE_K821
4044                             IF(BDC_MD)THEN
4045                                MAX_MEM_ALLOW=min(
4046     &                    min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)),
4047     &                               BANDE_K821)
4048                                MAX_MEM_ALLOW=max(dble(0),
4049     &                               MAX_MEM_ALLOW)
4050                             ENDIF
4051                             KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4052                             IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN
4053                                AFFECTED=ADDITIONNAL_ROWS
4054                             ENDIF
4055                             IF(NB_ROWS(J).LT.KMAX)THEN
4056                                IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN
4057                                   AFFECTED=KMAX-NB_ROWS(J)
4058                                   NB_SAT=NB_SAT+1
4059                                ELSE
4060                                   IF((AFFECTED+NB_ROWS(J)).LT.
4061     &                                  KMIN)THEN
4062                                      AFFECTED=0
4063                                   ENDIF
4064                                ENDIF
4065                                NB_ROWS(J)=NB_ROWS(J)+AFFECTED
4066                                ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4067     &                               AFFECTED
4068                             ENDIF
4069                             J=J+1
4070                          ENDDO
4071                       ELSE
4072                          MAX_LOAD=TEMP(i)
4073                          J=1
4074                          DO WHILE ((ADDITIONNAL_ROWS.NE.0)
4075     &                         .AND.(J.LT.i))
4076                             AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4077                             BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4078                             IF(HAVE_TYPE1_SON)THEN
4079                                AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4080     &                               dble(NFRONT+1))
4081                                BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4082                             ENDIF
4083                             TMP_SUM=((dble(NELIM)* dble(NB_ROWS(J)))
4084     &                            +(dble(NB_ROWS(J))*dble(NELIM))*
4085     &                            dble(2*NFRONT-NELIM-1))
4086                             X=int((MAX_LOAD-(TEMP(J)+TMP_SUM))/
4087     &                            (dble(NELIM)*dble(2*NFRONT-NELIM)))
4088                             IF(X.LT.0)THEN
4089                                WRITE(*,*)MYID,
4090     &    ': Internal error 10 in SMUMPS_518'
4091                                CALL MUMPS_ABORT()
4092                             ENDIF
4093                             AFFECTED=X
4094                             MAX_MEM_ALLOW=BANDE_K821
4095                             IF(BDC_MD)THEN
4096                                MAX_MEM_ALLOW=min(
4097     &                    min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)),
4098     &                               BANDE_K821)
4099                                MAX_MEM_ALLOW=max(dble(0),
4100     &                               MAX_MEM_ALLOW)
4101                             ENDIF
4102                             KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4103                             IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN
4104                                AFFECTED=ADDITIONNAL_ROWS
4105                             ENDIF
4106                             IF(NB_ROWS(J).LT.KMAX)THEN
4107                                IF((AFFECTED+NB_ROWS(J)).GT.KMAX)THEN
4108                                   AFFECTED=KMAX-NB_ROWS(J)
4109                                   NB_SAT=NB_SAT+1
4110                                ELSE
4111                                   IF((AFFECTED+NB_ROWS(J)).LT.
4112     &                                  KMIN)THEN
4113                                      AFFECTED=0
4114                                   ENDIF
4115                                ENDIF
4116                                NB_ROWS(J)=NB_ROWS(J)+AFFECTED
4117                                ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4118     &                               AFFECTED
4119                             ENDIF
4120                             J=J+1
4121                          ENDDO
4122                       ENDIF
4123                    ENDIF
4124 218                CONTINUE
4125                    i=i+1
4126                 ENDDO
4127                 CHOSEN=i-1
4128                 IF((CHOSEN.EQ.NUMBER_OF_PROCS-1).AND.
4129     &                 (ADDITIONNAL_ROWS.NE.0))THEN
4130                    DO i=1,CHOSEN
4131                       IF(NB_ROWS(i)+1.GE.KMIN)THEN
4132                          NB_ROWS(i)=NB_ROWS(i)+1
4133                          ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1
4134                       ENDIF
4135                       MAX_LOAD=max(MAX_LOAD,
4136     &                      (TEMP(i)+(dble(NELIM) *
4137     &                      dble(NB_ROWS(i)))+
4138     &                      (dble(NB_ROWS(i))*dble(NELIM))*
4139     &                      dble(2*NFRONT-NELIM-1)))
4140                       IF(ADDITIONNAL_ROWS.EQ.0) GOTO 048
4141                    ENDDO
4142 048                CONTINUE
4143                 ENDIF
4144                 IF((ADDITIONNAL_ROWS.NE.0))THEN
4145                    IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN
4146                       i=CHOSEN+1
4147                    ELSE
4148                       IF(CHOSEN.NE.NUMBER_OF_PROCS)THEN
4149                          WRITE(*,*)MYID,
4150     &    ': Internal error 11 in SMUMPS_518'
4151                          CALL MUMPS_ABORT()
4152                       ENDIF
4153                       i=CHOSEN
4154                    ENDIF
4155                    DO WHILE ((ADDITIONNAL_ROWS.NE.0)
4156     &                   .AND.(i.LE.NUMBER_OF_PROCS))
4157                       IF(TEMP(i).LE.MAX_LOAD)THEN
4158                          AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4159                          BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4160                          IF(HAVE_TYPE1_SON)THEN
4161                             AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4162     &                            dble(NFRONT+1))
4163                             BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4164                          ENDIF
4165                          MAX_MEM_ALLOW=BANDE_K821
4166                          IF(BDC_MD)THEN
4167                             MAX_MEM_ALLOW=min(
4168     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
4169     &                            BANDE_K821)
4170                             MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4171                          ENDIF
4172                          KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4173                          TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i)))
4174     &                         +(dble(NB_ROWS(i))*dble(NELIM))*
4175     &                         dble(2*NFRONT-NELIM-1))
4176                          X=int((MAX_LOAD-(TEMP(i)+TMP_SUM))/
4177     &                         (dble(NELIM)*dble(2*NFRONT-NELIM)))
4178                          AFFECTED=X
4179                          IF(X.LT.0)THEN
4180                             WRITE(*,*)MYID,
4181     &    ': Internal error 12 in SMUMPS_518'
4182                             CALL MUMPS_ABORT()
4183                          ENDIF
4184                          IF(AFFECTED.GT.ADDITIONNAL_ROWS)THEN
4185                             AFFECTED=ADDITIONNAL_ROWS
4186                          ENDIF
4187                          IF(NB_ROWS(i).LT.KMAX)THEN
4188                             IF((AFFECTED+NB_ROWS(i)).GT.KMAX)THEN
4189                                AFFECTED=KMAX-NB_ROWS(i)
4190                             ELSE
4191                                IF((AFFECTED+NB_ROWS(i)).LT.
4192     &                               KMIN)THEN
4193                                   AFFECTED=0
4194                                ENDIF
4195                             ENDIF
4196                             NB_ROWS(i)=NB_ROWS(i)+AFFECTED
4197                             ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED
4198                          ENDIF
4199                          IF(i.NE.NUMBER_OF_PROCS) GOTO 624
4200                       ELSE IF((TEMP(i).GT.MAX_LOAD))THEN
4201                          X=int(ADDITIONNAL_ROWS/i-1)
4202                          X=max(X,1)
4203                          IF((MAX_LOAD+((dble(NELIM)*
4204     &                         dble(X))+(dble(
4205     &                         X)*dble(NELIM))*dble(
4206     &                         (2*NFRONT-NELIM-1)))).LE.TEMP(i))THEN
4207                             AFFECTED=X
4208                             POS=1
4209                          ELSE
4210                             POS=0
4211                          ENDIF
4212                          MAX_LOAD=TEMP(i)
4213                          J=1
4214                          DO WHILE ((ADDITIONNAL_ROWS.NE.0)
4215     &                         .AND.(J.LT.i))
4216                             X=int(BUF_SIZE/dble(NCB+1))-1
4217                             BANDE_K821=dble(X)*dble(NFRONT)
4218                             MAX_MEM_ALLOW=BANDE_K821
4219                             IF(HAVE_TYPE1_SON)THEN
4220                                X=int((BUF_SIZE-dble(NFRONT))/
4221     &                               dble(NFRONT+1))
4222                                BANDE_K821=dble(X)*dble(NFRONT)
4223                             ENDIF
4224                             IF(BDC_MD)THEN
4225                                MAX_MEM_ALLOW=min(
4226     &                    min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)),
4227     &                               BANDE_K821)
4228                                MAX_MEM_ALLOW=max(dble(0),
4229     &                               MAX_MEM_ALLOW)
4230                             ENDIF
4231                             KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4232                             IF(POS.EQ.0)THEN
4233                                TMP_SUM=((dble(NELIM) *
4234     &                               dble(NB_ROWS(J)))
4235     &                               +(dble(NB_ROWS(J))*dble(NELIM))*
4236     &                               dble(2*NFRONT-NELIM-1))
4237                                X=int((TEMP(i)-(TEMP(J)+TMP_SUM))/
4238     &                               (dble(NELIM)*dble(2*NFRONT-
4239     &                               NELIM)))
4240                             ELSE
4241                                X=int(TMP_SUM)
4242                             ENDIF
4243                             IF(X.GT.ADDITIONNAL_ROWS)THEN
4244                                X=ADDITIONNAL_ROWS
4245                             ENDIF
4246                             IF(NB_ROWS(J).LT.KMAX)THEN
4247                                IF((X+NB_ROWS(J)).GT.KMAX)THEN
4248                                   X=KMAX-NB_ROWS(J)
4249                                ELSE
4250                                   IF((NB_ROWS(J)+X).LT.
4251     &                                  KMIN)THEN
4252                                     X=0
4253                                  ENDIF
4254                               ENDIF
4255                               NB_ROWS(J)=NB_ROWS(J)+X
4256                               ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4257                            ENDIF
4258                            J=J+1
4259                         ENDDO
4260                       ENDIF
4261 624                   CONTINUE
4262                       i=i+1
4263                    ENDDO
4264                    CHOSEN=i-1
4265                    IF(ADDITIONNAL_ROWS.NE.0)THEN
4266                       ACC=0
4267                       DO i=1,CHOSEN
4268                          X=int(BUF_SIZE/dble(NCB+1))-1
4269                          BANDE_K821=dble(X)*dble(NFRONT)
4270                          IF(HAVE_TYPE1_SON)THEN
4271                             X=int((BUF_SIZE-dble(NFRONT))/
4272     &                            dble(NFRONT+1))
4273                             BANDE_K821=dble(X)*dble(NFRONT)
4274                          ENDIF
4275                          MAX_MEM_ALLOW=BANDE_K821
4276                          IF(BDC_MD)THEN
4277                             MAX_MEM_ALLOW=min(
4278     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
4279     &                            BANDE_K821)
4280                             MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4281                          ENDIF
4282                             KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4283                          TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i)))
4284     &                    +(dble(NB_ROWS(i))*dble(NELIM))*
4285     &                    dble(2*NFRONT-NELIM-1))
4286                          X=int((MAX_LOAD-
4287     &                         (TEMP(i)+TMP_SUM))/
4288     &                         (dble(NELIM)*dble(2*NFRONT-NELIM)))
4289                          IF(X.LT.0)THEN
4290                             WRITE(*,*)MYID,
4291     &    ': Internal error 13 in SMUMPS_518'
4292                             CALL MUMPS_ABORT()
4293                          ENDIF
4294                          IF(X.GT.ADDITIONNAL_ROWS)THEN
4295                             X=ADDITIONNAL_ROWS
4296                          ENDIF
4297                          IF(NB_ROWS(i).LT.KMAX)THEN
4298                             IF((X+NB_ROWS(i)).GE.KMAX)THEN
4299                                ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4300     &                               (KMAX-NB_ROWS(i))
4301                                NB_ROWS(i)=KMAX
4302                             ELSE
4303                                IF((X+NB_ROWS(i)).GE.
4304     &                               KMIN)THEN
4305                                   NB_ROWS(i)=NB_ROWS(i)+X
4306                                   ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4307                                   ACC=ACC+1
4308                                ELSE
4309                                   ACC=ACC+1
4310                                ENDIF
4311                             ENDIF
4312                          ENDIF
4313                          IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049
4314                       ENDDO
4315                       IF(CHOSEN.LT.NUMBER_OF_PROCS)THEN
4316                          CHOSEN=CHOSEN+1
4317                       ENDIF
4318                       IF(ACC.EQ.0)THEN
4319                          ACC=1
4320                       ENDIF
4321                       X=int(ADDITIONNAL_ROWS/ACC)
4322                       X=max(X,1)
4323                       ACC=0
4324                       DO i=1,CHOSEN
4325                          J=int(BUF_SIZE/dble(NCB+1))-1
4326                          BANDE_K821=dble(J)*dble(NFRONT)
4327                          IF(HAVE_TYPE1_SON)THEN
4328                             J=int((BUF_SIZE-dble(NFRONT))/
4329     &                            dble(NFRONT+1))
4330                             BANDE_K821=dble(J)*dble(NFRONT)
4331                          ENDIF
4332                          MAX_MEM_ALLOW=BANDE_K821
4333                          IF(BDC_MD)THEN
4334                             MAX_MEM_ALLOW=min(
4335     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
4336     &                            BANDE_K821)
4337                             MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4338                          ENDIF
4339                          KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4340                          TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i)))
4341     &                         +(dble(NB_ROWS(i))*dble(NELIM))*
4342     &                         dble(2*NFRONT-NELIM-1))
4343                          J=int((MAX_LOAD-
4344     &                         (TEMP(i)+TMP_SUM))/
4345     &                         (dble(NELIM)*dble(2*NFRONT-NELIM)))
4346                          IF(NB_ROWS(i).LT.KMAX)THEN
4347                             IF((min(X,J)+NB_ROWS(i)).GE.KMAX)THEN
4348                                IF((KMAX-NB_ROWS(i)).GT.
4349     &                               ADDITIONNAL_ROWS)THEN
4350                                   NB_ROWS(i)=NB_ROWS(i)+
4351     &                                  ADDITIONNAL_ROWS
4352                                   ADDITIONNAL_ROWS=0
4353                                ELSE
4354                                   ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4355     &                                  (KMAX-NB_ROWS(i))
4356                                   NB_ROWS(i)=KMAX
4357                                ENDIF
4358                             ELSE
4359                                IF((min(X,J)+NB_ROWS(i)).GE.
4360     &                            KMIN)THEN
4361                                   NB_ROWS(i)=NB_ROWS(i)+min(X,J)
4362                                   ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4363     &                                  min(X,J)
4364                                   ACC=ACC+1
4365                                ENDIF
4366                             ENDIF
4367                          ENDIF
4368                          IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049
4369                       ENDDO
4370                       IF(ACC.GT.0)THEN
4371                          DO i=1,CHOSEN
4372                             X=int(BUF_SIZE/dble(NCB+1))-1
4373                             BANDE_K821=dble(X)*dble(NFRONT)
4374                             IF(HAVE_TYPE1_SON)THEN
4375                                X=int((BUF_SIZE-dble(NFRONT))/
4376     &                               dble(NFRONT+1))
4377                                BANDE_K821=dble(X)*dble(NFRONT)
4378                             ENDIF
4379                             MAX_MEM_ALLOW=BANDE_K821
4380                             IF(BDC_MD)THEN
4381                                MAX_MEM_ALLOW=min(
4382     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
4383     &                               BANDE_K821)
4384                                MAX_MEM_ALLOW=max(dble(0),
4385     &                               MAX_MEM_ALLOW)
4386                             ENDIF
4387                             KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4388                             IF(KMAX-NB_ROWS(i).LT.
4389     &                            ADDITIONNAL_ROWS)THEN
4390                                ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4391     &                               (KMAX-NB_ROWS(i))
4392                                NB_ROWS(i)=KMAX
4393                             ELSE
4394                                IF(NB_ROWS(i).EQ.0)THEN
4395                                   IF(min(KMIN,KMAX).LT.
4396     &                                  ADDITIONNAL_ROWS)THEN
4397                                      NB_ROWS(i)=min(KMIN,KMAX)
4398                                      ADDITIONNAL_ROWS=
4399     &                                     ADDITIONNAL_ROWS-
4400     &                                     min(KMIN,KMAX)
4401                                   ENDIF
4402                                ELSE
4403                                   NB_ROWS(i)=NB_ROWS(i)+
4404     &                                  ADDITIONNAL_ROWS
4405                                   ADDITIONNAL_ROWS=0
4406                                ENDIF
4407                             ENDIF
4408                             IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049
4409                          ENDDO
4410                       ENDIF
4411                       DO i=1,CHOSEN
4412                          IDWLOAD(i)=i
4413                          AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4414                          BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4415                          IF(HAVE_TYPE1_SON)THEN
4416                             AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4417     &                            dble(NFRONT+1))
4418                             BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4419                          ENDIF
4420                          WLOAD(i)=(BANDE_K821-dble(NB_ROWS(i)*NFRONT))
4421                       ENDDO
4422                       CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD,
4423     &                      IDWLOAD)
4424                       NB_SAT=0
4425                       DO i=1,CHOSEN
4426                          X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT))
4427                          X=max(X,1)
4428                          AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4429                          BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4430                          IF(HAVE_TYPE1_SON)THEN
4431                             AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4432     &                            dble(NFRONT+1))
4433                             BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4434                          ENDIF
4435                          IF(BDC_MD)THEN
4436                             MAX_MEM_ALLOW=min(BANDE_K821,
4437     &                            MEM_SIZE_STRONG(i))
4438                             MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4439                          ENDIF
4440                          KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4441                          IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN
4442                             IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN
4443                                NB_ROWS(IDWLOAD(i))=
4444     &                               NB_ROWS(IDWLOAD(i))+X
4445                                ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4446                             ELSE
4447                                ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4448     &                               (KMAX-NB_ROWS(IDWLOAD(i)))
4449                                NB_ROWS(IDWLOAD(i))=KMAX
4450                             ENDIF
4451                          ENDIF
4452                          IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN
4453                             NB_SAT=NB_SAT+1
4454                          ENDIF
4455                          IF(ADDITIONNAL_ROWS.EQ.0) GOTO 049
4456                       ENDDO
4457                       DO i=1,CHOSEN
4458                          X=int(BUF_SIZE/dble(NCB+1))-1
4459                          BANDE_K821=dble(X)*dble(NFRONT)
4460                          IF(HAVE_TYPE1_SON)THEN
4461                             X=int((BUF_SIZE-dble(NFRONT))/
4462     &                            dble(NFRONT+1))
4463                             BANDE_K821=dble(X)*dble(NFRONT)
4464                          ENDIF
4465                          MAX_MEM_ALLOW=BANDE_K821
4466                          IF(BDC_MD)THEN
4467                             MAX_MEM_ALLOW=min(BANDE_K821,
4468     &                            MEM_SIZE_STRONG(i))
4469                             MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4470                          ENDIF
4471                          KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4472                          IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN
4473                             ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4474     &                            (KMAX-NB_ROWS(i))
4475                             NB_ROWS(i)=KMAX
4476                          ELSE
4477                             NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS
4478                             ADDITIONNAL_ROWS=0
4479                          ENDIF
4480                          IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049
4481                       ENDDO
4482                       X=int(ADDITIONNAL_ROWS/CHOSEN)
4483                       X=max(X,1)
4484                       DO i=1,CHOSEN
4485                          ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4486                          NB_ROWS(i)=NB_ROWS(i)+X
4487                          IF(ADDITIONNAL_ROWS.EQ.0)GOTO 049
4488                       ENDDO
4489                       NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS
4490                    ENDIF
4491                 ENDIF
4492 049             CONTINUE
4493              ENDIF
4494 666          CONTINUE
4495              SOMME=dble(0)
4496              X=0
4497              POS=0
4498              DO i=1,CHOSEN
4499                 X=X+NB_ROWS(i)
4500                 SOMME=SOMME+ dble(NB_ROWS(i))
4501              ENDDO
4502              GOTO 890
4503           ELSE IF((KEEP(83).GE.NUMBER_OF_PROCS).AND.FORCE_CAND)THEN
4504              MAX_LOAD=dble(0)
4505              DO i=1,OTHERS
4506                 MAX_LOAD=max(MAX_LOAD,TEMP(i))
4507              ENDDO
4508              ACC=0
4509              CHOSEN=0
4510              X=1
4511              DO i=1,OTHERS
4512              ENDDO
4513              DO i=2,OTHERS
4514                 IF(TEMP(i).EQ.TEMP(1))THEN
4515                    X=X+1
4516                 ELSE
4517                    GOTO 329
4518                 ENDIF
4519              ENDDO
4520 329          CONTINUE
4521              TMP_SUM=TOTAL_COST/dble(X)
4522              TEMP_MAX_LOAD=dble(0)
4523              DO i=1,OTHERS
4524                 IF(K50.EQ.0)THEN
4525                    X=int(BUF_SIZE/dble(NCB+1))-1
4526                    BANDE_K821=dble(X)*dble(NFRONT)
4527                 ELSE
4528                    A=dble(1)
4529                    B=dble(ACC+2)
4530                    C=-BUF_SIZE+dble(ACC+NELIM)
4531                    DELTA=(B*B)-(dble(4)*A*C)
4532                    X=int((-B+sqrt(DELTA))/(dble(2)*A))
4533                    IF(X.GT.NCB-ACC) X=NCB-ACC
4534                    BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4535                 ENDIF
4536                 IF(HAVE_TYPE1_SON)THEN
4537                    IF(K50.EQ.0)THEN
4538                       X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1))
4539                       BANDE_K821=dble(X)*dble(NFRONT)
4540                    ELSE
4541                       A=dble(1)
4542                       B=dble(ACC+2+NELIM)
4543                       C=-BUF_SIZE+dble(ACC+NELIM)
4544                       DELTA=(B*B)-(dble(4)*A*C)
4545                       X=int((-B+sqrt(DELTA))/(dble(2)*A))
4546                       IF(X.GT.NCB-ACC) X=NCB-ACC
4547                       BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4548                    ENDIF
4549                 ENDIF
4550                 MAX_MEM_ALLOW=BANDE_K821
4551                 IF(BDC_MD)THEN
4552                    MAX_MEM_ALLOW=min(BANDE_K821,
4553     &                    min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)))
4554                    MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4555                 ENDIF
4556                 IF(K50.EQ.0)THEN
4557                       KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4558                    IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN
4559                       SOMME=MAX_LOAD-TEMP(i)
4560                    ELSE
4561                       SOMME=TMP_SUM
4562                    ENDIF
4563                    X=int(SOMME/
4564     &                   (dble(NELIM)*dble(2*NFRONT-NELIM)))
4565                    IF(X.GT.KMAX)THEN
4566                       X=KMAX
4567                    ELSE
4568                       IF(X.LT.KMIN)THEN
4569                          X=min(KMIN,KMAX)
4570                       ENDIF
4571                    ENDIF
4572                    IF((ACC+X).GT.NCB) X=NCB-ACC
4573                 ENDIF
4574                 IF(K50.NE.0)THEN
4575                       A=dble(1)
4576                       B=dble(ACC+NELIM)
4577                       C=dble(-MAX_MEM_ALLOW)
4578                       DELTA=((B*B)-(dble(4)*A*C))
4579                       KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
4580                    A=dble(NELIM)
4581                    B=dble(NELIM)*dble(NELIM+2*ACC+1)
4582                    IF(TMP_SUM+TEMP(i).GT.MAX_LOAD)THEN
4583                       C=-(MAX_LOAD-TEMP(i))
4584                    ELSE
4585                       C=-TMP_SUM
4586                    ENDIF
4587                    DELTA=(B*B-(dble(4)*A*C))
4588                    X=int((-B+sqrt(DELTA))/(dble(2)*A))
4589                    IF(X.LT.0) THEN
4590                       WRITE(*,*)MYID,
4591     &    ': Internal error 14 in SMUMPS_518'
4592                       CALL MUMPS_ABORT()
4593                    ENDIF
4594                    IF(X.GE.KMAX)THEN
4595                       IF(KMAX.GT.KMIN)THEN
4596                          X=KMAX
4597                       ELSE
4598                          X=0
4599                       ENDIF
4600                    ELSE
4601                       IF(X.LE.min(KMIN,KMAX))THEN
4602                          IF(KMAX.LT.KMIN)THEN
4603                             X=0
4604                          ELSE
4605                             X=min(KMIN,KMAX)
4606                          ENDIF
4607                       ENDIF
4608                    ENDIF
4609                    IF((ACC+X).GT.NCB) X=NCB-ACC
4610                 ENDIF
4611                 TEMP_MAX_LOAD=max(TEMP_MAX_LOAD,TEMP(i))
4612                 NB_ROWS(i)=X
4613                 CHOSEN=CHOSEN+1
4614                 ACC=ACC+X
4615                 IF(ACC.EQ.NCB) GOTO 541
4616              ENDDO
4617 541          CONTINUE
4618              IF(ACC.LT.NCB)THEN
4619                 IF(K50.EQ.0)THEN
4620                    ADDITIONNAL_ROWS=NCB-ACC
4621                    DO J=1,CHOSEN
4622                       AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4623                       BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4624                       IF(HAVE_TYPE1_SON)THEN
4625                          AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4626     &                         dble(NFRONT+1))
4627                          BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4628                       ENDIF
4629                       MAX_MEM_ALLOW=BANDE_K821
4630                       IF(BDC_MD)THEN
4631                          MAX_MEM_ALLOW=min(
4632     &                    min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)),
4633     &                         dble(BANDE_K821))
4634                          MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4635                       ENDIF
4636                       KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4637                       IF((NB_ROWS(J)).LT.KMAX)THEN
4638                          IF(ADDITIONNAL_ROWS.GT.(KMAX-NB_ROWS(J)))THEN
4639                             ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4640     &                            (KMAX-NB_ROWS(J))
4641                             NB_ROWS(J)=KMAX
4642                          ELSE
4643                             NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS
4644                             ADDITIONNAL_ROWS=0
4645                          ENDIF
4646                       ENDIF
4647                       IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889
4648                    ENDDO
4649                    X=int(ADDITIONNAL_ROWS/CHOSEN)
4650                    X=max(X,1)
4651                    DO J=1,CHOSEN
4652                       AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4653                       BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4654                       IF(HAVE_TYPE1_SON)THEN
4655                          AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4656     &                         dble(NFRONT+1))
4657                          BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4658                       ENDIF
4659                       MAX_MEM_ALLOW=BANDE_K821
4660                       IF(BDC_MD)THEN
4661                          MAX_MEM_ALLOW=min(BANDE_K821,
4662     &                         MEM_SIZE_STRONG(J))
4663                          MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4664                       ENDIF
4665                       KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4666                       IF((NB_ROWS(J)+X).GT.KMAX)THEN
4667                          ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4668     &                         (KMAX-NB_ROWS(J))
4669                          NB_ROWS(J)=KMAX
4670                       ELSE
4671                          ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4672                          NB_ROWS(J)=NB_ROWS(J)+X
4673                       ENDIF
4674                       IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889
4675                    ENDDO
4676                    DO i=1,CHOSEN
4677                       X=int(BUF_SIZE/dble(NCB+1))-1
4678                       BANDE_K821=dble(X)*dble(NFRONT)
4679                       IF(HAVE_TYPE1_SON)THEN
4680                          X=int((BUF_SIZE-dble(NFRONT))/
4681     &                         dble(NFRONT+1))
4682                          BANDE_K821=dble(X)*dble(NFRONT)
4683                       ENDIF
4684                       MAX_MEM_ALLOW=BANDE_K821
4685                       IF(BDC_MD)THEN
4686                          MAX_MEM_ALLOW=min(BANDE_K821,
4687     &                         MEM_SIZE_STRONG(i))
4688                          MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4689                       ENDIF
4690                       KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4691                       IF(KMAX-NB_ROWS(i).LT.ADDITIONNAL_ROWS)THEN
4692                          ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4693     &                         (KMAX-NB_ROWS(i))
4694                          NB_ROWS(i)=KMAX
4695                       ELSE
4696                          NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS
4697                          ADDITIONNAL_ROWS=0
4698                       ENDIF
4699                       IF(ADDITIONNAL_ROWS.EQ.0)GOTO 889
4700                    ENDDO
4701                    DO i=1,NUMBER_OF_PROCS
4702                       IDWLOAD(i)=i
4703                       AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4704                       BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4705                       IF(HAVE_TYPE1_SON)THEN
4706                          AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4707     &                         dble(NFRONT+1))
4708                          BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4709                       ENDIF
4710                       WLOAD(i)=(BANDE_K821-(dble(NB_ROWS(i))*
4711     &                      dble(NFRONT)))
4712                    ENDDO
4713                    CALL MUMPS_558(NUMBER_OF_PROCS, WLOAD,
4714     &                   IDWLOAD)
4715                    NB_SAT=0
4716                    DO i=1,CHOSEN
4717                       X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT))
4718                       X=max(X,1)
4719                       AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4720                       BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4721                       IF(HAVE_TYPE1_SON)THEN
4722                          AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4723     &                         dble(NFRONT+1))
4724                          BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4725                       ENDIF
4726                       MAX_MEM_ALLOW=BANDE_K821
4727                       KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4728                       IF(NB_ROWS(IDWLOAD(i)).LT.KMAX)THEN
4729                          IF((NB_ROWS(IDWLOAD(i))+X).LT.KMAX)THEN
4730                             NB_ROWS(IDWLOAD(i))=
4731     &                            NB_ROWS(IDWLOAD(i))+X
4732                             ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4733                          ELSE
4734                             ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4735     &                            (KMAX-NB_ROWS(IDWLOAD(i)))
4736                             NB_ROWS(IDWLOAD(i))=KMAX
4737                          ENDIF
4738                       ENDIF
4739                       IF(NB_ROWS(IDWLOAD(i)).EQ.KMAX)THEN
4740                          NB_SAT=NB_SAT+1
4741                       ENDIF
4742                       IF(ADDITIONNAL_ROWS.EQ.0) GOTO 889
4743                    ENDDO
4744                    GOTO 994
4745                 ELSE
4746                    ACC=0
4747                    CHOSEN=0
4748                    DO i=1,OTHERS
4749                       A=dble(1)
4750                       B=dble(ACC+2)
4751                       C=-BUF_SIZE+dble(ACC+NELIM)
4752                       DELTA=(B*B)-(dble(4)*A*C)
4753                       X=int((-B+sqrt(DELTA))/(dble(2)*A))
4754                       IF(X.GT.NCB-ACC) X=NCB-ACC
4755                       BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4756                       IF(HAVE_TYPE1_SON)THEN
4757                          A=dble(1)
4758                          B=dble(ACC+2+NELIM)
4759                          C=-BUF_SIZE+dble(ACC+NELIM)
4760                          DELTA=(B*B)-(dble(4)*A*C)
4761                          X=int((-B+sqrt(DELTA))/(dble(2)*A))
4762                          IF(X.GT.NCB-ACC) X=NCB-ACC
4763                          BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4764                       ENDIF
4765                       MAX_MEM_ALLOW=BANDE_K821
4766                       IF(BDC_MD)THEN
4767                          MAX_MEM_ALLOW=min(BANDE_K821,
4768     &                         MEM_SIZE_STRONG(i))
4769                          MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4770                       ENDIF
4771                       A=dble(1)
4772                       B=dble(ACC+NELIM)
4773                       C=dble(-MAX_MEM_ALLOW)
4774                       DELTA=((B*B)-(dble(4)*A*C))
4775                       KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
4776                       X=KMAX-NB_ROWS(i)
4777                       IF((ACC+NB_ROWS(i)+X).GT.NCB)
4778     &                            X=NCB-(ACC+NB_ROWS(i))
4779                       NB_ROWS(i)=NB_ROWS(i)+X
4780                       ACC=ACC+NB_ROWS(i)
4781                       CHOSEN=CHOSEN+1
4782                       IF(NCB.EQ.ACC) GOTO 889
4783                    ENDDO
4784                    ADDITIONNAL_ROWS=NCB-ACC
4785                 ENDIF
4786                 ACC=0
4787                 CHOSEN=0
4788                 DO i=1,OTHERS
4789                    A=dble(1)
4790                    B=dble(ACC+2)
4791                    C=-BUF_SIZE+dble(ACC+NELIM)
4792                    DELTA=(B*B)-(dble(4)*A*C)
4793                    X=int((-B+sqrt(DELTA))/(dble(2)*A))
4794                    IF(X.GT.NCB-ACC) X=NCB-ACC
4795                    BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4796                    IF(HAVE_TYPE1_SON)THEN
4797                       A=dble(1)
4798                       B=dble(ACC+2+NELIM)
4799                       C=-BUF_SIZE+dble(ACC+NELIM)
4800                       DELTA=(B*B)-(dble(4)*A*C)
4801                       X=int((-B+sqrt(DELTA))/(dble(2)*A))
4802                       IF(X.GT.NCB-ACC) X=NCB-ACC
4803                       BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4804                    ENDIF
4805                    MAX_MEM_ALLOW=BANDE_K821
4806                    A=dble(1)
4807                    B=dble(ACC+NELIM)
4808                    C=dble(-MAX_MEM_ALLOW)
4809                    DELTA=((B*B)-(dble(4)*A*C))
4810                    KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
4811                    X=KMAX-NB_ROWS(i)
4812                    IF((ACC+NB_ROWS(i)+X).GT.NCB)
4813     &                   X=NCB-(ACC+NB_ROWS(i))
4814                    NB_ROWS(i)=NB_ROWS(i)+X
4815                    ACC=ACC+NB_ROWS(i)
4816                    CHOSEN=CHOSEN+1
4817                    IF(NCB.EQ.ACC) GOTO 889
4818                 ENDDO
4819                 ADDITIONNAL_ROWS=NCB-ACC
4820 994             CONTINUE
4821                 X=int(dble(ADDITIONNAL_ROWS)/dble(OTHERS))
4822                 IF((X*OTHERS).LT.ADDITIONNAL_ROWS)THEN
4823                    X=X+1
4824                 ENDIF
4825                 DO i=1,OTHERS
4826                    NB_ROWS(i)=NB_ROWS(i)+X
4827                    ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4828                    IF(ADDITIONNAL_ROWS.LT.X)X=ADDITIONNAL_ROWS
4829                 ENDDO
4830                 CHOSEN=OTHERS
4831              ENDIF
4832           ENDIF
4833 889       CONTINUE
4834           MAX_LOAD=TEMP_MAX_LOAD
4835 890       CONTINUE
4836           J=CHOSEN
4837           X=0
4838              DO i=J,1,-1
4839                 IF(NB_ROWS(i).EQ.0)THEN
4840                    CHOSEN=CHOSEN-1
4841                    ELSE
4842                       IF(NB_ROWS(i).GT.0)THEN
4843                          X=1
4844                       ELSE
4845                          WRITE(*,*)MYID,
4846     &    ': Internal error 15 in SMUMPS_518'
4847                          CALL MUMPS_ABORT()
4848                       ENDIF
4849                    ENDIF
4850                 ENDDO
4851           NSLAVES_NODE=CHOSEN
4852           TAB_POS(NSLAVES_NODE+1)= NCB+1
4853           TAB_POS(SLAVEF+2) = CHOSEN
4854           POS=1
4855           X=1
4856           DO i=1,J
4857              IF(NB_ROWS(i).NE.0)THEN
4858                 SLAVES_LIST(X)=TEMP_ID(i)
4859                 TAB_POS(X)=POS
4860                 POS=POS+NB_ROWS(i)
4861                 IF(NB_ROWS(i).LE.0)THEN
4862                    WRITE(*,*)MYID,
4863     &    ': Internal error 16 in SMUMPS_518'
4864                    CALL MUMPS_ABORT()
4865                 ENDIF
4866                 X=X+1
4867               ENDIF
4868           ENDDO
4869           DO i=CHOSEN+1,NUMBER_OF_PROCS
4870              SLAVES_LIST(i)=TEMP_ID(i)
4871           ENDDO
4872           IF(POS.NE.(NCB+1))THEN
4873              WRITE(*,*)MYID,
4874     &    ': Internal error 17 in SMUMPS_518',
4875     &             POS,NCB+1
4876             CALL MUMPS_ABORT()
4877           ENDIF
4878      END SUBROUTINE SMUMPS_518
4879      SUBROUTINE SMUMPS_520
4880     &      (INODE,UPPER,SLAVEF,KEEP,KEEP8,
4881     &       STEP,POOL,LPOOL,PROCNODE,N)
4882      IMPLICIT NONE
4883      INTEGER INODE, LPOOL, SLAVEF, N
4884      INTEGER KEEP(500)
4885      INTEGER(8) KEEP8(150)
4886      INTEGER STEP(KEEP(28)), POOL(LPOOL), PROCNODE(KEEP(28))
4887      LOGICAL UPPER
4888      INTEGER J
4889      DOUBLE PRECISION MEM_COST
4890      INTEGER NBINSUBTREE,i,NBTOP
4891      EXTERNAL SMUMPS_508,
4892     & MUMPS_170
4893      LOGICAL SMUMPS_508,
4894     & MUMPS_170
4895      NBINSUBTREE = POOL(LPOOL)
4896      NBTOP       = POOL(LPOOL - 1)
4897      IF(KEEP(47).LT.2)THEN
4898         WRITE(*,*)'SMUMPS_520 must
4899     &        be called with K47>=2'
4900         CALL MUMPS_ABORT()
4901      ENDIF
4902      IF((INODE.GT.0).AND.(INODE.LE.N))THEN
4903      MEM_COST=SMUMPS_543(INODE)
4904         IF((DM_MEM(MYID)+dble(MEM_COST)+ PEAK_SBTR_CUR_LOCAL-
4905     &        SBTR_CUR_LOCAL)
4906     &        .GT.MAX_PEAK_STK)THEN
4907            DO i=NBTOP-1,1,-1
4908               INODE = POOL( LPOOL - 2 - i)
4909               MEM_COST=SMUMPS_543(INODE)
4910               IF((INODE.LT.0).OR.(INODE.GT.N)) THEN
4911                  DO J=i+1,NBTOP,-1
4912                     POOL(J-1)=POOL(J)
4913                  ENDDO
4914                  UPPER=.TRUE.
4915                  RETURN
4916               ENDIF
4917               IF((DM_MEM(MYID)+dble(MEM_COST)+PEAK_SBTR_CUR_LOCAL-
4918     &              SBTR_CUR_LOCAL).LE.
4919     &              MAX_PEAK_STK) THEN
4920                  DO J=i+1,NBTOP,-1
4921                     POOL(J-1)=POOL(J)
4922                  ENDDO
4923                  UPPER=.TRUE.
4924                  RETURN
4925               ENDIF
4926            ENDDO
4927            IF(NBINSUBTREE.NE.0)THEN
4928               INODE = POOL( NBINSUBTREE )
4929               IF(.NOT.MUMPS_170(PROCNODE(STEP(INODE)),
4930     &              SLAVEF))THEN
4931                  WRITE(*,*)
4932     &        'Internal error 1 in SMUMPS_520'
4933                  CALL MUMPS_ABORT()
4934               ENDIF
4935               UPPER=.FALSE.
4936               RETURN
4937            ENDIF
4938            INODE=POOL(LPOOL-2-NBTOP)
4939            UPPER=.TRUE.
4940            RETURN
4941         ENDIF
4942      ENDIF
4943      UPPER=.TRUE.
4944      END SUBROUTINE SMUMPS_520
4945      SUBROUTINE SMUMPS_513(WHAT)
4946      IMPLICIT NONE
4947      LOGICAL WHAT
4948      IF(.NOT.BDC_POOL_MNG)THEN
4949         WRITE(*,*)'SMUMPS_513
4950     &        should be called when K81>0 and K47>2'
4951      ENDIF
4952      IF(WHAT)THEN
4953         PEAK_SBTR_CUR_LOCAL=PEAK_SBTR_CUR_LOCAL+
4954     &        dble(MEM_SUBTREE(INDICE_SBTR))
4955         IF(.NOT.BDC_SBTR) INDICE_SBTR=INDICE_SBTR+1
4956      ELSE
4957         PEAK_SBTR_CUR_LOCAL=dble(0)
4958         SBTR_CUR_LOCAL=dble(0)
4959      ENDIF
4960      END SUBROUTINE SMUMPS_513
4961      DOUBLE PRECISION FUNCTION SMUMPS_543( INODE )
4962      IMPLICIT NONE
4963      INTEGER INODE,LEVEL,i,NELIM,NFR
4964      DOUBLE PRECISION COST
4965      EXTERNAL MUMPS_330
4966      INTEGER MUMPS_330
4967      i = INODE
4968      NELIM = 0
4969 10   CONTINUE
4970      IF ( i > 0 ) THEN
4971        NELIM = NELIM + 1
4972        i = FILS_LOAD(i)
4973        GOTO 10
4974      ENDIF
4975      NFR = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253)
4976      LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS )
4977      IF (LEVEL .EQ. 1) THEN
4978        COST =  dble(NFR) * dble(NFR)
4979      ELSE
4980        IF ( K50 == 0 ) THEN
4981           COST =  dble(NFR) * dble(NELIM)
4982        ELSE
4983           COST = dble(NELIM) * dble(NELIM)
4984        ENDIF
4985      ENDIF
4986      SMUMPS_543=COST
4987      RETURN
4988      END FUNCTION SMUMPS_543
4989      RECURSIVE SUBROUTINE SMUMPS_515(FLAG,COST,COMM)
4990      USE SMUMPS_COMM_BUFFER
4991      IMPLICIT NONE
4992      INTEGER COMM,WHAT,IERR
4993      LOGICAL FLAG
4994      DOUBLE PRECISION COST
4995      DOUBLE PRECISION TO_BE_SENT
4996      EXTERNAL MUMPS_330
4997      INTEGER MUMPS_330
4998      IF(FLAG)THEN
4999         WHAT=17
5000         IF(BDC_M2_FLOPS)THEN
5001#if ! defined(OLD_LOAD_MECHANISM)
5002            TO_BE_SENT=DELTA_LOAD-COST
5003            DELTA_LOAD=dble(0)
5004#else
5005            TO_BE_SENT=LAST_LOAD_SENT-COST
5006            LAST_LOAD_SENT=LAST_LOAD_SENT-COST
5007#endif
5008         ELSE IF(BDC_M2_MEM)THEN
5009            IF(BDC_POOL.AND.(.NOT.BDC_MD))THEN
5010               TO_BE_SENT=max(TMP_M2,POOL_LAST_COST_SENT)
5011               POOL_LAST_COST_SENT=TO_BE_SENT
5012            ELSE IF(BDC_MD)THEN
5013#if ! defined(OLD_LOAD_MECHANISM)
5014               DELTA_MEM=DELTA_MEM+TMP_M2
5015               TO_BE_SENT=DELTA_MEM
5016#else
5017               TO_BE_SENT=DM_LAST_MEM_SENT+TMP_M2
5018               DM_LAST_MEM_SENT=DM_LAST_MEM_SENT+TMP_M2
5019#endif
5020            ELSE
5021               TO_BE_SENT=dble(0)
5022            ENDIF
5023         ENDIF
5024      ELSE
5025         WHAT=6
5026         TO_BE_SENT=dble(0)
5027      ENDIF
5028 111  CONTINUE
5029      CALL SMUMPS_460( WHAT,
5030     &         COMM, NPROCS,
5031#if ! defined(OLD_LOAD_MECHANISM)
5032     &               FUTURE_NIV2,
5033#endif
5034     &         COST,
5035     &         TO_BE_SENT,
5036     &         MYID, IERR  )
5037      IF ( IERR == -1 )THEN
5038         CALL SMUMPS_467(COMM_LD, KEEP_LOAD)
5039         GOTO 111
5040      ELSE IF ( IERR .NE. 0 ) THEN
5041         WRITE(*,*) "Internal Error in SMUMPS_500",
5042     &   IERR
5043         CALL MUMPS_ABORT()
5044      ENDIF
5045      RETURN
5046      END SUBROUTINE SMUMPS_515
5047      SUBROUTINE SMUMPS_512(INODE,STEP,NSTEPS,PROCNODE,FRERE,
5048     &     NE,COMM,SLAVEF,MYID,KEEP,KEEP8,N)
5049      USE SMUMPS_COMM_BUFFER
5050      IMPLICIT NONE
5051      INTEGER INODE,NSTEPS,MYID,SLAVEF,COMM,N
5052      INTEGER KEEP(500)
5053      INTEGER(8) KEEP8(150)
5054      INTEGER FRERE(NSTEPS),NE(NSTEPS),STEP(N),PROCNODE(NSTEPS)
5055      EXTERNAL MUMPS_170,MUMPS_275
5056      LOGICAL MUMPS_170
5057      INTEGER i,NCB,NELIM
5058      INTEGER MUMPS_275
5059      INTEGER FATHER_NODE,FATHER,WHAT,IERR
5060      EXTERNAL MUMPS_330
5061      INTEGER MUMPS_330
5062      IF((.NOT.BDC_M2_MEM).AND.(.NOT.BDC_M2_FLOPS))THEN
5063         WRITE(*,*)MYID,': Problem in SMUMPS_512'
5064         CALL MUMPS_ABORT()
5065      ENDIF
5066      IF((INODE.LT.0).OR.(INODE.GT.N)) THEN
5067         RETURN
5068      ENDIF
5069      i=INODE
5070      NELIM = 0
5071 10   CONTINUE
5072      IF ( i > 0 ) THEN
5073         NELIM = NELIM + 1
5074         i = FILS_LOAD(i)
5075         GOTO 10
5076      ENDIF
5077      NCB=ND_LOAD(STEP_LOAD(INODE))-NELIM + KEEP_LOAD(253)
5078      WHAT=5
5079      FATHER_NODE=DAD_LOAD(STEP_LOAD(INODE))
5080      IF (FATHER_NODE.EQ.0) THEN
5081         RETURN
5082      ENDIF
5083      IF((FRERE(STEP(FATHER_NODE)).EQ.0).AND.
5084     &     ((FATHER_NODE.EQ.KEEP(38)).OR.
5085     &     (FATHER_NODE.EQ.KEEP(20))))THEN
5086         RETURN
5087      ENDIF
5088      IF(MUMPS_170(PROCNODE(STEP(FATHER_NODE)),
5089     &            SLAVEF)) THEN
5090         RETURN
5091      ENDIF
5092      FATHER=MUMPS_275(PROCNODE(STEP(FATHER_NODE)),SLAVEF)
5093      IF(FATHER.EQ.MYID)THEN
5094        IF(BDC_M2_MEM)THEN
5095           CALL SMUMPS_816(FATHER_NODE)
5096        ELSEIF(BDC_M2_FLOPS)THEN
5097           CALL SMUMPS_817(FATHER_NODE)
5098        ENDIF
5099        IF((KEEP(81).EQ.2).OR.(KEEP(81).EQ.3))THEN
5100           IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)),
5101     &          NPROCS).EQ.1)THEN
5102              CB_COST_ID(POS_ID)=INODE
5103              CB_COST_ID(POS_ID+1)=1
5104              CB_COST_ID(POS_ID+2)=POS_MEM
5105              POS_ID=POS_ID+3
5106              CB_COST_MEM(POS_MEM)=int(MYID,8)
5107              POS_MEM=POS_MEM+1
5108              CB_COST_MEM(POS_MEM)=int(NCB,8)*int(NCB,8)
5109              POS_MEM=POS_MEM+1
5110           ENDIF
5111        ENDIF
5112        GOTO 666
5113      ENDIF
5114 111  CONTINUE
5115      CALL SMUMPS_519(WHAT, COMM, NPROCS,
5116     &     FATHER_NODE,INODE,NCB, KEEP(81),MYID,
5117     &     FATHER, IERR)
5118      IF (IERR == -1 ) THEN
5119        CALL SMUMPS_467(COMM, KEEP)
5120        GOTO 111
5121      ELSE IF ( IERR .NE. 0 ) THEN
5122        WRITE(*,*) "Internal Error in SMUMPS_512",
5123     &  IERR
5124        CALL MUMPS_ABORT()
5125      ENDIF
5126 666  CONTINUE
5127      END SUBROUTINE SMUMPS_512
5128      SUBROUTINE SMUMPS_514(INODE,NUM_CALL)
5129      IMPLICIT NONE
5130      DOUBLE PRECISION MAXI
5131      INTEGER i,J,IND_MAXI
5132      INTEGER INODE,NUM_CALL
5133      IF(BDC_M2_MEM)THEN
5134         IF(((NUM_CALL.EQ.1).AND.(BDC_MD)).OR.
5135     &       ((NUM_CALL.EQ.2).AND.(.NOT.BDC_MD)))THEN
5136            RETURN
5137         ENDIF
5138      ENDIF
5139      IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0).AND.
5140     &     ((INODE.EQ.KEEP_LOAD(38)).OR.
5141     &     (INODE.EQ.KEEP_LOAD(20)))) THEN
5142         RETURN
5143      ENDIF
5144      DO i=POOL_SIZE,1,-1
5145         IF(POOL_NIV2(i).EQ.INODE) GOTO 666
5146      ENDDO
5147         NB_SON(STEP_LOAD(INODE))=-1
5148      RETURN
5149 666  CONTINUE
5150      IF(BDC_M2_MEM)THEN
5151         IF(POOL_NIV2_COST(i).EQ.MAX_M2)THEN
5152            TMP_M2=MAX_M2
5153            MAXI=dble(0)
5154            IND_MAXI=-9999
5155            DO J=POOL_SIZE,1,-1
5156               IF(J.NE.i) THEN
5157                  IF(POOL_NIV2_COST(J).GT.MAXI)THEN
5158                     MAXI=POOL_NIV2_COST(J)
5159                     IND_MAXI=J
5160                  ENDIF
5161               ENDIF
5162            ENDDO
5163            MAX_M2=MAXI
5164            J=IND_MAXI
5165            REMOVE_NODE_FLAG_MEM=.TRUE.
5166            REMOVE_NODE_COST_MEM=TMP_M2
5167            CALL SMUMPS_515(REMOVE_NODE_FLAG,MAX_M2,COMM_LD)
5168            NIV2(MYID+1)=MAX_M2
5169         ENDIF
5170      ELSEIF(BDC_M2_FLOPS)THEN
5171         REMOVE_NODE_COST=POOL_NIV2_COST(i)
5172         REMOVE_NODE_FLAG=.TRUE.
5173         CALL SMUMPS_515(REMOVE_NODE_FLAG,
5174     &        -POOL_NIV2_COST(i),COMM_LD)
5175         NIV2(MYID+1)=NIV2(MYID+1)-POOL_NIV2_COST(i)
5176      ENDIF
5177      DO J=i+1,POOL_SIZE
5178         POOL_NIV2(J-1)=POOL_NIV2(J)
5179         POOL_NIV2_COST(J-1)=POOL_NIV2_COST(J)
5180      ENDDO
5181      POOL_SIZE=POOL_SIZE-1
5182      END SUBROUTINE SMUMPS_514
5183      RECURSIVE SUBROUTINE SMUMPS_816(INODE)
5184      IMPLICIT NONE
5185      INTEGER INODE
5186      EXTERNAL MUMPS_330
5187      INTEGER MUMPS_330
5188      IF((INODE.EQ.KEEP_LOAD(20)).OR.
5189     &     (INODE.EQ.KEEP_LOAD(38)))THEN
5190         RETURN
5191      ENDIF
5192      IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN
5193         RETURN
5194      ELSE
5195         IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN
5196            WRITE(*,*)
5197     &        'Internal error 1 in SMUMPS_816'
5198            CALL MUMPS_ABORT()
5199         ENDIF
5200      ENDIF
5201      NB_SON(STEP_LOAD(INODE))=
5202     &     NB_SON(STEP_LOAD(INODE))-1
5203      IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN
5204         POOL_NIV2(POOL_SIZE+1)=INODE
5205         POOL_NIV2_COST(POOL_SIZE+1)=
5206     &        SMUMPS_543(INODE)
5207         POOL_SIZE=POOL_SIZE+1
5208         IF(POOL_NIV2_COST(POOL_SIZE).GT.MAX_M2)THEN
5209            MAX_M2=POOL_NIV2_COST(POOL_SIZE)
5210            ID_MAX_M2=POOL_NIV2(POOL_SIZE)
5211            CALL SMUMPS_515(REMOVE_NODE_FLAG_MEM,MAX_M2,COMM_LD)
5212            NIV2(1+MYID)=MAX_M2
5213         ENDIF
5214      ENDIF
5215      RETURN
5216      END SUBROUTINE SMUMPS_816
5217      RECURSIVE SUBROUTINE SMUMPS_817(INODE)
5218      IMPLICIT NONE
5219      INTEGER INODE
5220      EXTERNAL MUMPS_330
5221      INTEGER MUMPS_330
5222      IF((INODE.EQ.KEEP_LOAD(20)).OR.
5223     &     (INODE.EQ.KEEP_LOAD(38)))THEN
5224         RETURN
5225      ENDIF
5226      IF(NB_SON(STEP_LOAD(INODE)).EQ.-1)THEN
5227         RETURN
5228      ELSE
5229         IF(NB_SON(STEP_LOAD(INODE)).LT.0)THEN
5230            WRITE(*,*)
5231     &        'Internal error 1 in SMUMPS_817'
5232            CALL MUMPS_ABORT()
5233         ENDIF
5234      ENDIF
5235      NB_SON(STEP_LOAD(INODE))=
5236     &     NB_SON(STEP_LOAD(INODE))-1
5237      IF(NB_SON(STEP_LOAD(INODE)).EQ.0)THEN
5238         POOL_NIV2(POOL_SIZE+1)=INODE
5239         POOL_NIV2_COST(POOL_SIZE+1)=
5240     &        SMUMPS_542(INODE)
5241         POOL_SIZE=POOL_SIZE+1
5242         MAX_M2=POOL_NIV2_COST(POOL_SIZE)
5243         ID_MAX_M2=POOL_NIV2(POOL_SIZE)
5244         CALL SMUMPS_515(REMOVE_NODE_FLAG,
5245     &           POOL_NIV2_COST(POOL_SIZE),
5246     &        COMM_LD)
5247         NIV2(MYID+1)=POOL_NIV2_COST(POOL_SIZE)+NIV2(MYID+1)
5248      ENDIF
5249      RETURN
5250      END SUBROUTINE SMUMPS_817
5251      DOUBLE PRECISION FUNCTION SMUMPS_542(INODE)
5252      INTEGER INODE
5253      INTEGER NFRONT,NELIM,i,LEVEL
5254      EXTERNAL MUMPS_330
5255      INTEGER MUMPS_330
5256      DOUBLE PRECISION COST
5257      i = INODE
5258      NELIM = 0
5259 10   CONTINUE
5260      IF ( i > 0 ) THEN
5261        NELIM = NELIM + 1
5262        i = FILS_LOAD(i)
5263        GOTO 10
5264      ENDIF
5265      NFRONT = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253)
5266      LEVEL = MUMPS_330( PROCNODE_LOAD(STEP_LOAD(INODE)), NPROCS )
5267      COST=dble(0)
5268      CALL MUMPS_511(NFRONT,NELIM,NELIM,
5269     &                          KEEP_LOAD(50),LEVEL,COST)
5270      SMUMPS_542=COST
5271      RETURN
5272      END FUNCTION SMUMPS_542
5273      INTEGER FUNCTION SMUMPS_541( INODE )
5274      IMPLICIT NONE
5275      INTEGER INODE,NELIM,NFR,SON,IN,i
5276      INTEGER COST_CB
5277      COST_CB=0
5278      i = INODE
5279 10   CONTINUE
5280      IF ( i > 0 ) THEN
5281        i = FILS_LOAD(i)
5282        GOTO 10
5283      ENDIF
5284      SON=-i
5285      DO i=1, NE_LOAD(STEP_LOAD(INODE))
5286         NFR = ND_LOAD( STEP_LOAD(SON) ) + KEEP_LOAD(253)
5287         IN=SON
5288         NELIM = 0
5289 20      CONTINUE
5290         IF ( IN > 0 ) THEN
5291            NELIM = NELIM + 1
5292            IN = FILS_LOAD(IN)
5293            GOTO 20
5294         ENDIF
5295         COST_CB=COST_CB+((NFR-NELIM)*(NFR-NELIM))
5296         SON=FRERE_LOAD(STEP_LOAD(SON))
5297      ENDDO
5298      SMUMPS_541=COST_CB
5299      RETURN
5300      END FUNCTION SMUMPS_541
5301      SUBROUTINE SMUMPS_533(SLAVEF,NMB_OF_CAND,
5302     &     TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES,
5303     &     NSLAVES,INODE)
5304      USE SMUMPS_COMM_BUFFER
5305      IMPLICIT NONE
5306      INTEGER, INTENT (IN) :: SLAVEF, NASS, NSLAVES
5307      INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2)
5308      INTEGER, intent(in) :: NMB_OF_CAND
5309      INTEGER, INTENT (IN) :: LIST_SLAVES( NMB_OF_CAND )
5310      INTEGER KEEP(500),INODE
5311      INTEGER(8) KEEP8(150)
5312      INTEGER allocok
5313      DOUBLE PRECISION MEM_COST,FCT_COST
5314      DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE ::EMPTY_ARRAY,
5315     &     DELTA_MD,EMPTY_ARRAY2
5316      INTEGER NBROWS_SLAVE,i,WHAT,IERR,NPROCS_LOC
5317      LOGICAL FORCE_CAND
5318      MEM_COST=dble(0)
5319      FCT_COST=dble(0)
5320      IF ( KEEP(24) == 0 .OR. KEEP(24) == 1 ) THEN
5321        FORCE_CAND = .FALSE.
5322        NPROCS_LOC=SLAVEF-1
5323      ELSE
5324        FORCE_CAND = (mod(KEEP(24),2).eq.0)
5325        NPROCS_LOC=NMB_OF_CAND
5326      END IF
5327      IF(FORCE_CAND)THEN
5328         CALL SMUMPS_540(INODE,FCT_COST,
5329     &        MEM_COST,NPROCS_LOC,NASS)
5330      ELSE
5331         CALL SMUMPS_540(INODE,FCT_COST,
5332     &        MEM_COST,SLAVEF-1,NASS)
5333      ENDIF
5334      DO i=1,SLAVEF
5335         IDWLOAD(i)=i-1
5336      ENDDO
5337      ALLOCATE(EMPTY_ARRAY(NPROCS_LOC),DELTA_MD(NPROCS_LOC),
5338     &     EMPTY_ARRAY2(NPROCS_LOC),
5339     &    stat=allocok)
5340      DO i = 1, NSLAVES
5341         NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i)
5342         DELTA_MD( i ) = FCT_COST - dble(NBROWS_SLAVE)*
5343     &        dble(NASS)
5344      END DO
5345      IF(FORCE_CAND)THEN
5346         DO i=NSLAVES+1,NPROCS_LOC
5347            DELTA_MD( i ) = FCT_COST
5348         ENDDO
5349      ELSE
5350         DO i=NSLAVES+1,SLAVEF-1
5351            DELTA_MD( i ) = FCT_COST
5352         ENDDO
5353      ENDIF
5354      WHAT=7
5355 111  CONTINUE
5356      CALL SMUMPS_524(.FALSE., COMM_LD, MYID, SLAVEF,
5357#if ! defined(OLD_LOAD_MECHANISM)
5358     &     FUTURE_NIV2,
5359#endif
5360     &     NPROCS_LOC, LIST_SLAVES,0,
5361     &     EMPTY_ARRAY,
5362     &     DELTA_MD,EMPTY_ARRAY2,WHAT, IERR)
5363      IF ( IERR == -1 ) THEN
5364          CALL SMUMPS_467(COMM_LD, KEEP)
5365          GOTO 111
5366      ELSE IF ( IERR .NE. 0 ) THEN
5367         WRITE(*,*) "Internal Error in SMUMPS_533",
5368     &   IERR
5369         CALL MUMPS_ABORT()
5370      ENDIF
5371#if ! defined(OLD_LOAD_MECHANISM)
5372      IF (FUTURE_NIV2(MYID+1) .NE. 0) THEN
5373#endif
5374        DO i = 1, NSLAVES
5375           MD_MEM(LIST_SLAVES(i))=MD_MEM(LIST_SLAVES(i))+
5376     &          int(DELTA_MD( i ),8)
5377#if ! defined(OLD_LOAD_MECHANISM)
5378           IF(FUTURE_NIV2(LIST_SLAVES(i)+1).EQ.0)THEN
5379              MD_MEM(LIST_SLAVES(i))=999999999_8
5380           ENDIF
5381#endif
5382        ENDDO
5383#if ! defined(OLD_LOAD_MECHANISM)
5384      ENDIF
5385#endif
5386      DEALLOCATE(EMPTY_ARRAY)
5387      DEALLOCATE(DELTA_MD)
5388      END SUBROUTINE SMUMPS_533
5389      SUBROUTINE SMUMPS_540(INODE,FCT_COST,
5390     &     MEM_COST,NSLAVES,NELIM)
5391      IMPLICIT NONE
5392      INTEGER INODE,NSLAVES,NFR,NELIM,IN
5393      DOUBLE PRECISION MEM_COST,FCT_COST
5394      NFR=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253)
5395      IN = INODE
5396      FCT_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)*
5397     &     dble(NELIM)
5398      MEM_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)*
5399     &     dble(NFR)
5400      END SUBROUTINE SMUMPS_540
5401      SUBROUTINE SMUMPS_819(INODE)
5402      IMPLICIT NONE
5403      INTEGER INODE
5404      INTEGER i,J,SON,NSLAVES_TEMP,POS_TEMP,K
5405      INTEGER MUMPS_275
5406      EXTERNAL MUMPS_275
5407      IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN
5408         RETURN
5409      ENDIF
5410      IF(POS_ID.GT.1)THEN
5411         i=INODE
5412 10      CONTINUE
5413         IF ( i > 0 ) THEN
5414            i = FILS_LOAD(i)
5415            GOTO 10
5416         ENDIF
5417         SON=-i
5418         IF(POS_ID.LT.NE_LOAD(STEP_LOAD(INODE))*3)THEN
5419            i=1
5420         ENDIF
5421         DO i=1, NE_LOAD(STEP_LOAD(INODE))
5422            J=1
5423            DO WHILE (J.LT.POS_ID)
5424               IF(CB_COST_ID(J).EQ.SON)GOTO 295
5425               J=J+3
5426            ENDDO
5427 295        CONTINUE
5428            IF(J.GE.POS_ID)THEN
5429               IF(MUMPS_275(
5430     &            PROCNODE_LOAD(STEP_LOAD(INODE)),NPROCS).EQ.MYID)THEN
5431                  IF(INODE.EQ.KEEP_LOAD(38))THEN
5432                     GOTO 666
5433#if ! defined(OLD_LOAD_MECHANISM)
5434                  ELSE
5435                     IF(FUTURE_NIV2(MYID+1).NE.0)THEN
5436                        WRITE(*,*)MYID,': i did not find ',SON
5437                        CALL MUMPS_ABORT()
5438                     ENDIF
5439                     GOTO 666
5440#endif
5441                  ENDIF
5442               ELSE
5443                  GOTO 666
5444               ENDIF
5445            ENDIF
5446            NSLAVES_TEMP=CB_COST_ID(J+1)
5447            POS_TEMP=CB_COST_ID(J+2)
5448            DO K=J,POS_ID-1
5449               CB_COST_ID(K)=CB_COST_ID(K+3)
5450            ENDDO
5451            K=POS_TEMP
5452            DO WHILE (K.LE.POS_MEM-1)
5453               CB_COST_MEM(K)=CB_COST_MEM(K+2*NSLAVES_TEMP)
5454               K=K+1
5455            ENDDO
5456            POS_MEM=POS_MEM-2*NSLAVES_TEMP
5457            POS_ID=POS_ID-3
5458            IF((POS_MEM.LT.1).OR.(POS_ID.LT.1))THEN
5459               WRITE(*,*)MYID,': negative pos_mem or pos_id'
5460               CALL MUMPS_ABORT()
5461            ENDIF
5462 666        CONTINUE
5463            SON=FRERE_LOAD(STEP_LOAD(SON))
5464         ENDDO
5465      ENDIF
5466      END SUBROUTINE SMUMPS_819
5467      SUBROUTINE SMUMPS_820(FLAG)
5468      IMPLICIT NONE
5469      LOGICAL FLAG
5470      INTEGER i
5471      DOUBLE PRECISION MEM
5472      FLAG=.FALSE.
5473      DO i=0,NPROCS-1
5474         MEM=DM_MEM(i)+LU_USAGE(i)
5475         IF(BDC_SBTR)THEN
5476            MEM=MEM+SBTR_MEM(i)-SBTR_CUR(i)
5477         ENDIF
5478         IF((MEM/dble(TAB_MAXS(i))).GT.0.8d0)THEN
5479            FLAG=.TRUE.
5480            GOTO 666
5481         ENDIF
5482      ENDDO
5483 666  CONTINUE
5484      END SUBROUTINE SMUMPS_820
5485      SUBROUTINE SMUMPS_554(NBINSUBTREE,INSUBTREE,NBTOP,
5486     &           MIN_COST,SBTR)
5487      IMPLICIT NONE
5488      INTEGER NBINSUBTREE,INSUBTREE,NBTOP
5489      DOUBLE PRECISION MIN_COST
5490      LOGICAL SBTR
5491      INTEGER i
5492      DOUBLE PRECISION TMP_COST,TMP_MIN
5493      TMP_MIN=huge(TMP_MIN)
5494      DO i=0,NPROCS-1
5495         IF(i.NE.MYID)THEN
5496            IF(BDC_SBTR)THEN
5497               TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))-(DM_MEM(i)+
5498     &              LU_USAGE(i))-(SBTR_MEM(i)-SBTR_CUR(i)))
5499            ELSE
5500               TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))-
5501     &              (DM_MEM(i)+LU_USAGE(i)))
5502            ENDIF
5503         ENDIF
5504      ENDDO
5505      IF(NBINSUBTREE.GT.0)THEN
5506         IF(INSUBTREE.EQ.1)THEN
5507            TMP_COST=dble(TAB_MAXS(MYID))-(DM_MEM(MYID)+
5508     &           LU_USAGE(MYID))
5509     &           -(SBTR_MEM(MYID)-SBTR_CUR(MYID))
5510         ELSE
5511            SBTR=.FALSE.
5512            GOTO 777
5513         ENDIF
5514      ENDIF
5515      TMP_MIN=min(TMP_COST,TMP_MIN)
5516      IF(TMP_MIN.GT.MIN_COST) SBTR=.TRUE.
5517 777  CONTINUE
5518      END SUBROUTINE SMUMPS_554
5519      SUBROUTINE SMUMPS_818(INODE,MAX_MEM,PROC)
5520      IMPLICIT NONE
5521      INTEGER INODE,PROC
5522      INTEGER i,POS,NSLAVES,SLAVE,NCAND,J,NELIM,NCB,NFRONT,SON,K
5523      INTEGER allocok
5524      EXTERNAL MUMPS_330
5525      INTEGER  MUMPS_330
5526      DOUBLE PRECISION MAX_MEM
5527      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: MEM_ON_PROCS,
5528     &     RECV_BUF
5529      LOGICAL, DIMENSION(:), ALLOCATABLE :: CONCERNED
5530      DOUBLE PRECISION MAX_SENT_MSG
5531#if  defined(NOT_ATM_POOL_SPECIAL)
5532     DOUBLE PRECISION TMP
5533#endif
5534      IF((FRERE_LOAD(STEP_LOAD(INODE)).EQ.0)
5535     &           .AND.(INODE.EQ.KEEP_LOAD(38)))THEN
5536         RETURN
5537      ENDIF
5538#if  defined(NOT_ATM_POOL_SPECIAL)
5539      IF((INODE.LT.0).OR.(INODE.GT.N_LOAD))THEN
5540         MAX_MEM=huge(MAX_MEM)
5541         DO i=0,NPROCS-1
5542            TMP=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i))
5543            IF(BDC_SBTR)THEN
5544               TMP=TMP-(SBTR_MEM(i)-SBTR_CUR(i))
5545            ENDIF
5546            MAX_MEM=min(MAX_MEM,TMP)
5547         ENDDO
5548         RETURN
5549      ENDIF
5550#endif
5551      ALLOCATE( MEM_ON_PROCS(0:NPROCS-1), stat=allocok)
5552      IF ( allocok > 0 ) THEN
5553        WRITE(*,*) 'PB allocation in SMUMPS_818'
5554        CALL MUMPS_ABORT()
5555      ENDIF
5556      ALLOCATE( CONCERNED(0:NPROCS-1), stat=allocok)
5557      IF ( allocok > 0 ) THEN
5558        WRITE(*,*) 'PB allocation in SMUMPS_818'
5559        CALL MUMPS_ABORT()
5560      ENDIF
5561      ALLOCATE( RECV_BUF(0:NPROCS-1), stat=allocok)
5562      IF ( allocok > 0 ) THEN
5563        WRITE(*,*) 'PB allocation in SMUMPS_818'
5564        CALL MUMPS_ABORT()
5565      ENDIF
5566      RECV_BUF=dble(0)
5567      MAX_SENT_MSG=dble(0)
5568      i = INODE
5569      NELIM = 0
5570 10   CONTINUE
5571      IF ( i > 0 ) THEN
5572        NELIM = NELIM + 1
5573        i = FILS_LOAD(i)
5574        GOTO 10
5575      ENDIF
5576      SON=-i
5577      NFRONT=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253)
5578      NCB=NFRONT-NELIM
5579      IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)),
5580     &     NPROCS).EQ.2)THEN
5581         NCAND=CAND_LOAD(NPROCS+1, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE)))
5582      ENDIF
5583      DO i=0,NPROCS-1
5584         IF(i.EQ.MYID)THEN
5585            MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+
5586     &           LU_USAGE(i)+
5587     &           SMUMPS_543(INODE))
5588            IF(BDC_SBTR)THEN
5589               MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i))
5590            ENDIF
5591            CONCERNED(i)=.TRUE.
5592         ELSE
5593            MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i))
5594            IF(BDC_SBTR)THEN
5595               MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i))
5596            ENDIF
5597            IF(BDC_M2_MEM)THEN
5598               MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-NIV2(i+1)
5599            ENDIF
5600         ENDIF
5601         IF(MUMPS_330(PROCNODE_LOAD(STEP_LOAD(INODE)),
5602     &        NPROCS).EQ.2)THEN
5603            IF(BDC_MD.AND.(KEEP_LOAD(48).EQ.5))THEN
5604               DO J=1,NCAND
5605                  IF(CAND_LOAD(J, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE)))
5606     &                 .EQ.i)THEN
5607                     MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-
5608     &                 ((dble(NFRONT)*dble(NCB))/dble(NCAND))
5609                     CONCERNED(i)=.TRUE.
5610                     GOTO 666
5611                  ENDIF
5612               ENDDO
5613            ENDIF
5614         ENDIF
5615 666     CONTINUE
5616      ENDDO
5617      DO K=1, NE_LOAD(STEP_LOAD(INODE))
5618         i=1
5619         DO WHILE (i.LE.POS_ID)
5620            IF(CB_COST_ID(i).EQ.SON)GOTO 295
5621            i=i+3
5622         ENDDO
5623 295     CONTINUE
5624         IF(i.GE.POS_ID)THEN
5625#if ! defined(OLD_LOAD_MECHANISM)
5626            IF(FUTURE_NIV2(MYID+1).NE.0)THEN
5627               WRITE(*,*)MYID,': ',SON,'has not been found
5628     & in SMUMPS_818'
5629               CALL MUMPS_ABORT()
5630            ENDIF
5631#endif
5632            GOTO 777
5633         ENDIF
5634         NSLAVES=CB_COST_ID(i+1)
5635         POS=CB_COST_ID(i+2)
5636         DO i=1,NSLAVES
5637            SLAVE=int(CB_COST_MEM(POS))
5638            IF(.NOT.CONCERNED(SLAVE))THEN
5639               MEM_ON_PROCS(SLAVE)=MEM_ON_PROCS(SLAVE)+
5640     &              dble(CB_COST_MEM(POS+1))
5641            ENDIF
5642            DO J=0,NPROCS-1
5643               IF(CONCERNED(J))THEN
5644                  IF(SLAVE.NE.J)THEN
5645                     RECV_BUF(J)=max(RECV_BUF(J),
5646     &                    dble(CB_COST_MEM(POS+1)))
5647                  ENDIF
5648               ENDIF
5649            ENDDO
5650            POS=POS+2
5651         ENDDO
5652 777     CONTINUE
5653         SON=FRERE_LOAD(STEP_LOAD(SON))
5654      ENDDO
5655      MAX_MEM=huge(MAX_MEM)
5656      WRITE(*,*)'NPROCS=',NPROCS,MAX_MEM
5657      DO i=0,NPROCS-1
5658         IF(MAX_MEM.GT.MEM_ON_PROCS(i))THEN
5659            PROC=i
5660         ENDIF
5661         MAX_MEM=min(MEM_ON_PROCS(i),MAX_MEM)
5662      ENDDO
5663      DEALLOCATE(MEM_ON_PROCS)
5664      DEALLOCATE(CONCERNED)
5665      DEALLOCATE(RECV_BUF)
5666      END SUBROUTINE SMUMPS_818
5667      SUBROUTINE SMUMPS_553(MIN_PROC,POOL,
5668     &                      LPOOL,INODE)
5669      IMPLICIT NONE
5670      INTEGER INODE,LPOOL,MIN_PROC
5671      INTEGER POOL(LPOOL)
5672      EXTERNAL MUMPS_275
5673      INTEGER MUMPS_275
5674      INTEGER i,NBTOP,INSUBTREE,NBINSUBTREE,NODE,FATHER,SON,J
5675      INTEGER SBTR_NB_LEAF,POS,K,allocok,L
5676      INTEGER, ALLOCATABLE, DIMENSION (:) ::  TMP_SBTR
5677      NBINSUBTREE = POOL(LPOOL)
5678      NBTOP       = POOL(LPOOL - 1)
5679      INSUBTREE   = POOL(LPOOL - 2)
5680      IF((KEEP_LOAD(47).EQ.4).AND.
5681     &     ((NBINSUBTREE.NE.0)))THEN
5682         DO J=INDICE_SBTR,NB_SUBTREES
5683            NODE=MY_ROOT_SBTR(J)
5684            FATHER=DAD_LOAD(STEP_LOAD(NODE))
5685            i=FATHER
5686 110        CONTINUE
5687            IF ( i > 0 ) THEN
5688               i = FILS_LOAD(i)
5689               GOTO 110
5690            ENDIF
5691            SON=-i
5692            i=SON
5693 120        CONTINUE
5694            IF ( i > 0 ) THEN
5695               IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ.
5696     &              MIN_PROC)THEN
5697                  SBTR_NB_LEAF=MY_NB_LEAF(J)
5698                  POS=SBTR_FIRST_POS_IN_POOL(J)
5699                  IF(POOL(POS+SBTR_NB_LEAF).NE.MY_FIRST_LEAF(J))THEN
5700                     WRITE(*,*)MYID,': The first leaf is not ok'
5701                     CALL MUMPS_ABORT()
5702                  ENDIF
5703                  ALLOCATE (TMP_SBTR(SBTR_NB_LEAF), stat=allocok)
5704                  IF (allocok > 0 ) THEN
5705                     WRITE(*,*)MYID,': Not enough space
5706     &                    for allocation'
5707                     CALL MUMPS_ABORT()
5708                  ENDIF
5709                  POS=SBTR_FIRST_POS_IN_POOL(J)
5710                  DO K=1,SBTR_NB_LEAF
5711                     TMP_SBTR(K)=POOL(POS+K-1)
5712                  ENDDO
5713                  DO K=POS+1,NBINSUBTREE-SBTR_NB_LEAF
5714                     POOL(K)=POOL(K+SBTR_NB_LEAF)
5715                  ENDDO
5716                  POS=1
5717                  DO K=NBINSUBTREE-SBTR_NB_LEAF+1,NBINSUBTREE
5718                     POOL(K)=TMP_SBTR(POS)
5719                     POS=POS+1
5720                  ENDDO
5721                  DO K=INDICE_SBTR,J
5722                     SBTR_FIRST_POS_IN_POOL(K)=SBTR_FIRST_POS_IN_POOL(K)
5723     &                    -SBTR_FIRST_POS_IN_POOL(J)
5724                  ENDDO
5725                  SBTR_FIRST_POS_IN_POOL(J)=NBINSUBTREE-SBTR_NB_LEAF
5726                  POS=MY_FIRST_LEAF(J)
5727                  L=MY_NB_LEAF(J)
5728                  DO K=INDICE_SBTR,J
5729                     MY_FIRST_LEAF(J)=MY_FIRST_LEAF(J+1)
5730                     MY_NB_LEAF(J)=MY_NB_LEAF(J+1)
5731                  ENDDO
5732                  MY_FIRST_LEAF(INDICE_SBTR)=POS
5733                  MY_NB_LEAF(INDICE_SBTR)=L
5734                  INODE=POOL(NBINSUBTREE)
5735                  DEALLOCATE(TMP_SBTR)
5736                  RETURN
5737               ENDIF
5738               i = FRERE_LOAD(STEP_LOAD(i))
5739               GOTO 120
5740            ENDIF
5741         ENDDO
5742      ENDIF
5743      DO J=NBTOP,1,-1
5744#if defined(NOT_ATM_POOL_SPECIAL)
5745         IF ( POOL(LPOOL-2-J) < 0 ) THEN
5746            NODE=-POOL(LPOOL-2-J)
5747         ELSE IF ( POOL(LPOOL-2-J) > N_LOAD ) THEN
5748            NODE = POOL(LPOOL-2-J) - N_LOAD
5749         ELSE
5750            NODE = POOL(LPOOL-2-J)
5751         ENDIF
5752#else
5753         NODE=POOL(LPOOL-2-J)
5754#endif
5755         FATHER=DAD_LOAD(STEP_LOAD(NODE))
5756         i=FATHER
5757 11      CONTINUE
5758         IF ( i > 0 ) THEN
5759            i = FILS_LOAD(i)
5760            GOTO 11
5761         ENDIF
5762         SON=-i
5763         i=SON
5764 12      CONTINUE
5765         IF ( i > 0 ) THEN
5766            IF(MUMPS_275(PROCNODE_LOAD(STEP_LOAD(i)),NPROCS).EQ.
5767     &           MIN_PROC)THEN
5768               INODE=NODE
5769               RETURN
5770            ENDIF
5771            i = FRERE_LOAD(STEP_LOAD(i))
5772            GOTO 12
5773         ENDIF
5774      ENDDO
5775      END SUBROUTINE SMUMPS_553
5776      SUBROUTINE SMUMPS_555(POOL, LPOOL,KEEP,KEEP8)
5777      IMPLICIT NONE
5778      INTEGER LPOOL,POOL(LPOOL),KEEP(500)
5779      INTEGER(8) KEEP8(150)
5780      INTEGER i,POS
5781      EXTERNAL MUMPS_283
5782      LOGICAL MUMPS_283
5783      IF(.NOT.BDC_SBTR) RETURN
5784      POS=0
5785      DO i=NB_SUBTREES,1,-1
5786         DO WHILE(MUMPS_283(
5787     &            PROCNODE_LOAD(STEP_LOAD(POOL(POS+1))),
5788     &            NPROCS))
5789            POS=POS+1
5790         ENDDO
5791         SBTR_FIRST_POS_IN_POOL(i)=POS+1
5792         POS=POS+MY_NB_LEAF(i)
5793      ENDDO
5794      END SUBROUTINE SMUMPS_555
5795      END MODULE SMUMPS_LOAD
5796