1C
2C  This file is part of MUMPS 5.1.2, released
3C  on Mon Oct  2 07:37:01 UTC 2017
4C
5C
6C  Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C  University of Bordeaux.
8C
9C  This version of MUMPS is provided to you free of charge. It is
10C  released under the CeCILL-C license:
11C  http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html
12C
13      SUBROUTINE CMUMPS_INIT_POOL_LAST3(IPOOL, LPOOL, LEAF)
14      USE CMUMPS_LOAD
15      IMPLICIT NONE
16      INTEGER LPOOL, LEAF
17      INTEGER IPOOL(LPOOL)
18      IPOOL(LPOOL-2) = 0
19      IPOOL(LPOOL-1) = 0
20      IPOOL(LPOOL)   = LEAF-1
21      RETURN
22      END SUBROUTINE CMUMPS_INIT_POOL_LAST3
23      SUBROUTINE CMUMPS_INSERT_POOL_N
24     &           (N, POOL, LPOOL, PROCNODE, SLAVEF,
25     &           K28, K76, K80, K47, STEP, INODE)
26      USE CMUMPS_LOAD
27      IMPLICIT NONE
28      INTEGER N, INODE, LPOOL, K28, SLAVEF, K76, K80, K47
29      INTEGER STEP(N), POOL(LPOOL), PROCNODE(K28)
30      EXTERNAL MUMPS_IN_OR_ROOT_SSARBR
31      LOGICAL MUMPS_IN_OR_ROOT_SSARBR, ATM_CURRENT_NODE
32      INTEGER NBINSUBTREE, NBTOP, INODE_EFF,POS_TO_INSERT
33      INTEGER IPOS1, IPOS2, ISWAP
34      INTEGER NODE,J,I
35      ATM_CURRENT_NODE = ( K76 == 2 .OR. K76 ==3 .OR.
36     &     K76==4 .OR. K76==5)
37      NBINSUBTREE = POOL(LPOOL)
38      NBTOP       = POOL(LPOOL - 1)
39      IF (INODE > N ) THEN
40        INODE_EFF = INODE - N
41      ELSE IF (INODE < 0) THEN
42        INODE_EFF = - INODE
43      ELSE
44        INODE_EFF = INODE
45      ENDIF
46      IF(((INODE.GT.0).AND.(INODE.LE.N)).AND.(.NOT.
47     &     MUMPS_IN_OR_ROOT_SSARBR(PROCNODE(STEP(INODE_EFF)),
48     &               SLAVEF))
49     &  ) THEN
50         IF ((K80 == 1 .AND. K47 .GE. 1) .OR.
51     &     (( K80 == 2 .OR. K80==3 ) .AND.
52     &          ( K47 == 4 ))) THEN
53            CALL CMUMPS_REMOVE_NODE(INODE,1)
54         ENDIF
55      ENDIF
56      IF ( MUMPS_IN_OR_ROOT_SSARBR(PROCNODE(STEP(INODE_EFF)),
57     &                             SLAVEF) ) THEN
58        POOL(NBINSUBTREE + 1 ) = INODE
59        NBINSUBTREE = NBINSUBTREE + 1
60      ELSE
61         POS_TO_INSERT=NBTOP+1
62         IF((K76.EQ.4).OR.(K76.EQ.5).OR.(K76.EQ.6))THEN
63#if defined(NOT_ATM_POOL_SPECIAL)
64            J=NBTOP
65#else
66            IF((INODE.GT.N).OR.(INODE.LE.0))THEN
67               DO J=NBTOP,1,-1
68                  IF((POOL(LPOOL-2-J).GT.0)
69     &                 .AND.(POOL(LPOOL-2-J).LE.N))THEN
70                     GOTO 333
71                  ENDIF
72                  IF ( POOL(LPOOL-2-J) < 0 ) THEN
73                     NODE=-POOL(LPOOL-2-J)
74                  ELSE IF ( POOL(LPOOL-2-J) > N ) THEN
75                     NODE = POOL(LPOOL-2-J) - N
76                  ELSE
77                     NODE = POOL(LPOOL-2-J)
78                  ENDIF
79                  IF((K76.EQ.4).OR.(K76.EQ.6))THEN
80                     IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE.
81     &                    DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN
82                        GOTO 333
83                     ENDIF
84                  ENDIF
85                  IF(K76.EQ.5)THEN
86                     IF(COST_TRAV(STEP(NODE)).LE.
87     &                    COST_TRAV(STEP(INODE_EFF)))THEN
88                        GOTO 333
89                     ENDIF
90                  ENDIF
91                  POS_TO_INSERT=POS_TO_INSERT-1
92               ENDDO
93               IF(J.EQ.0) J=1
94 333           CONTINUE
95               DO I=NBTOP,POS_TO_INSERT,-1
96                  POOL(LPOOL-2-I-1)=POOL(LPOOL-2-I)
97               ENDDO
98               POOL(LPOOL-2-POS_TO_INSERT)=INODE
99               NBTOP = NBTOP + 1
100               GOTO 20
101            ENDIF
102            DO J=NBTOP,1,-1
103               IF((POOL(LPOOL-2-J).GT.0).AND.(POOL(LPOOL-2-J).LE.N))THEN
104                  GOTO 888
105               ENDIF
106               POS_TO_INSERT=POS_TO_INSERT-1
107            ENDDO
108 888        CONTINUE
109#endif
110            DO I=J,1,-1
111#if defined(NOT_ATM_POOL_SPECIAL)
112               IF ( POOL(LPOOL-2-I) < 0 ) THEN
113                  NODE=-POOL(LPOOL-2-I)
114               ELSE IF ( POOL(LPOOL-2-I) > N ) THEN
115                  NODE = POOL(LPOOL-2-I) - N
116               ELSE
117                  NODE = POOL(LPOOL-2-I)
118               ENDIF
119#else
120               NODE=POOL(LPOOL-2-I)
121#endif
122               IF((K76.EQ.4).OR.(K76.EQ.6))THEN
123                  IF(DEPTH_FIRST_LOAD(STEP(NODE)).GE.
124     &                 DEPTH_FIRST_LOAD(STEP(INODE_EFF)))THEN
125                     GOTO 999
126                  ENDIF
127               ENDIF
128               IF(K76.EQ.5)THEN
129                  IF(COST_TRAV(STEP(NODE)).LE.
130     &                 COST_TRAV(STEP(INODE_EFF)))THEN
131                     GOTO 999
132                  ENDIF
133               ENDIF
134               POS_TO_INSERT=POS_TO_INSERT-1
135            ENDDO
136            IF(I.EQ.0) I=1
137 999        CONTINUE
138            DO J=NBTOP,POS_TO_INSERT,-1
139               POOL(LPOOL-2-J-1)=POOL(LPOOL-2-J)
140            ENDDO
141            POOL(LPOOL-2-POS_TO_INSERT)=INODE
142            NBTOP = NBTOP + 1
143            GOTO 20
144         ENDIF
145         POOL( LPOOL - 2 - ( NBTOP + 1 ) ) = INODE
146         NBTOP = NBTOP + 1
147        IPOS1 = LPOOL - 2 - NBTOP
148        IPOS2 = LPOOL - 2 - NBTOP + 1
149 10     CONTINUE
150        IF ( IPOS2 == LPOOL - 2 ) GOTO 20
151        IF ( POOL(IPOS1) < 0 ) GOTO 20
152        IF ( POOL(IPOS2) < 0 ) GOTO 30
153        IF ( ATM_CURRENT_NODE ) THEN
154          IF ( POOL(IPOS1) > N ) GOTO 20
155          IF ( POOL(IPOS2) > N ) GOTO 30
156        END IF
157        GOTO 20
158 30     CONTINUE
159        ISWAP = POOL(IPOS1)
160        POOL(IPOS1) = POOL(IPOS2)
161        POOL(IPOS2) = ISWAP
162        IPOS1 = IPOS1 + 1
163        IPOS2 = IPOS2 + 1
164        GOTO 10
165 20     CONTINUE
166      ENDIF
167      POOL(LPOOL) = NBINSUBTREE
168      POOL(LPOOL - 1) = NBTOP
169      RETURN
170      END SUBROUTINE CMUMPS_INSERT_POOL_N
171      LOGICAL FUNCTION CMUMPS_POOL_EMPTY(POOL, LPOOL)
172      IMPLICIT NONE
173      INTEGER LPOOL
174      INTEGER POOL(LPOOL)
175      INTEGER NBINSUBTREE, NBTOP
176      NBINSUBTREE = POOL(LPOOL)
177      NBTOP       = POOL(LPOOL - 1)
178      CMUMPS_POOL_EMPTY = (NBINSUBTREE + NBTOP == 0)
179      RETURN
180      END FUNCTION CMUMPS_POOL_EMPTY
181      SUBROUTINE CMUMPS_EXTRACT_POOL( N, POOL, LPOOL, PROCNODE, SLAVEF,
182     &           STEP, INODE, KEEP,KEEP8, MYID, ND,
183     &           FORCE_EXTRACT_TOP_SBTR )
184      USE CMUMPS_LOAD
185      IMPLICIT NONE
186      INTEGER INODE, LPOOL, SLAVEF, N
187      INTEGER KEEP(500)
188      INTEGER(8) KEEP8(150)
189      INTEGER STEP(N), POOL(LPOOL), PROCNODE(KEEP(28)),
190     &        ND(KEEP(28))
191      EXTERNAL MUMPS_INSSARBR, MUMPS_ROOTSSARBR, CMUMPS_POOL_EMPTY
192      LOGICAL MUMPS_INSSARBR, MUMPS_ROOTSSARBR, CMUMPS_POOL_EMPTY
193      EXTERNAL MUMPS_PROCNODE
194      INTEGER MUMPS_PROCNODE
195      INTEGER NBINSUBTREE, NBTOP, INSUBTREE, INODE_EFF, MYID
196      LOGICAL LEFT, ATOMIC_SUBTREE,UPPER,FLAG_MEM,SBTR_FLAG,PROC_FLAG
197      LOGICAL FORCE_EXTRACT_TOP_SBTR
198      INTEGER NODE_TO_EXTRACT,I,J,MIN_PROC
199      NBINSUBTREE = POOL(LPOOL)
200      NBTOP       = POOL(LPOOL - 1)
201      INSUBTREE   = POOL(LPOOL - 2)
202      IF ( KEEP(76) > 6 .OR. KEEP(76) < 0 ) THEN
203         WRITE(*,*) "Error 2 in CMUMPS_EXTRACT_POOL: unknown strategy"
204         CALL MUMPS_ABORT()
205      ENDIF
206      ATOMIC_SUBTREE =  ( KEEP(76) == 1 .OR. KEEP(76) == 3)
207      IF ( CMUMPS_POOL_EMPTY(POOL, LPOOL) ) THEN
208         WRITE(*,*) "Error 1 in CMUMPS_EXTRACT_POOL"
209         CALL MUMPS_ABORT()
210      ENDIF
211      IF ( .NOT. ATOMIC_SUBTREE ) THEN
212         LEFT = (NBTOP == 0)
213         IF(.NOT.LEFT)THEN
214            IF((KEEP(76).EQ.4).OR.(KEEP(76).EQ.5))THEN
215               IF(NBINSUBTREE.EQ.0)THEN
216                  LEFT=.FALSE.
217               ELSE
218                  IF ( POOL(NBINSUBTREE) < 0 ) THEN
219                     I = -POOL(NBINSUBTREE)
220                  ELSE IF ( POOL(NBINSUBTREE) > N ) THEN
221                     I = POOL(NBINSUBTREE) - N
222                  ELSE
223                     I = POOL(NBINSUBTREE)
224                  ENDIF
225                  IF ( POOL(LPOOL-2-NBTOP) < 0 ) THEN
226                     J = -POOL(LPOOL-2-NBTOP)
227                  ELSE IF ( POOL(LPOOL-2-NBTOP) > N ) THEN
228                     J = POOL(LPOOL-2-NBTOP) - N
229                  ELSE
230                     J = POOL(LPOOL-2-NBTOP)
231                  ENDIF
232                  IF(KEEP(76).EQ.4)THEN
233                     IF(DEPTH_FIRST_LOAD(STEP(J)).GE.
234     &                    DEPTH_FIRST_LOAD(STEP(I)))THEN
235                        LEFT=.TRUE.
236                     ELSE
237                        LEFT=.FALSE.
238                     ENDIF
239                  ENDIF
240                  IF(KEEP(76).EQ.5)THEN
241                     IF(COST_TRAV(STEP(J)).LE.
242     &                    COST_TRAV(STEP(I)))THEN
243                        LEFT=.TRUE.
244                     ELSE
245                        LEFT=.FALSE.
246                     ENDIF
247                  ENDIF
248               ENDIF
249            ENDIF
250         ENDIF
251      ELSE
252         IF ( INSUBTREE == 1 ) THEN
253            IF (NBINSUBTREE == 0) THEN
254               WRITE(*,*) "Error 3 in CMUMPS_EXTRACT_POOL"
255               CALL MUMPS_ABORT()
256            ENDIF
257            LEFT = .TRUE.
258         ELSE
259            LEFT = ( NBTOP == 0)
260         ENDIF
261      ENDIF
262 222  CONTINUE
263      IF ( LEFT ) THEN
264         INODE = POOL( NBINSUBTREE )
265         IF(KEEP(81).EQ.2)THEN
266#if ! defined(NOT_ATM_POOL_SPECIAL)
267            IF((INODE.GE.0).AND.(INODE.LE.N))THEN
268#endif
269               CALL CMUMPS_MEM_NODE_SELECT(INODE,POOL,LPOOL,N,
270     &              STEP,KEEP,KEEP8,PROCNODE,SLAVEF,MYID,SBTR_FLAG,
271     &              PROC_FLAG,MIN_PROC)
272               IF(.NOT.SBTR_FLAG)THEN
273                  WRITE(*,*)MYID,': ca a change pour moi'
274                  LEFT=.FALSE.
275                  GOTO 222
276               ENDIF
277#if ! defined(NOT_ATM_POOL_SPECIAL)
278            ENDIF
279#endif
280         ELSEIF(KEEP(81).EQ.3)THEN
281#if ! defined(NOT_ATM_POOL_SPECIAL)
282            IF((INODE.GE.0).AND.(INODE.LE.N))THEN
283#endif
284               NODE_TO_EXTRACT=INODE
285               FLAG_MEM=.FALSE.
286               CALL CMUMPS_LOAD_CHK_MEMCST_POOL(FLAG_MEM)
287               IF(FLAG_MEM)THEN
288                  CALL CMUMPS_MEM_NODE_SELECT(INODE,POOL,LPOOL,N,
289     &                 STEP,KEEP,KEEP8,
290     &                 PROCNODE,SLAVEF,MYID,SBTR_FLAG,
291     &                 PROC_FLAG,MIN_PROC)
292                  IF(.NOT.SBTR_FLAG)THEN
293                     LEFT=.FALSE.
294                     WRITE(*,*)MYID,': ca a change pour moi (2)'
295                     GOTO 222
296                  ENDIF
297               ENDIF
298#if ! defined(NOT_ATM_POOL_SPECIAL)
299            ENDIF
300#endif
301         ENDIF
302         NBINSUBTREE = NBINSUBTREE - 1
303         IF ( INODE < 0 ) THEN
304            INODE_EFF = -INODE
305         ELSE IF ( INODE > N ) THEN
306            INODE_EFF = INODE - N
307         ELSE
308            INODE_EFF = INODE
309         ENDIF
310         IF ( MUMPS_INSSARBR( PROCNODE(STEP(INODE_EFF)), SLAVEF) ) THEN
311            IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND.
312     &           (INSUBTREE.EQ.0))THEN
313               CALL CMUMPS_LOAD_SET_SBTR_MEM(.TRUE.)
314            ENDIF
315            INSUBTREE = 1
316         ELSE IF ( MUMPS_ROOTSSARBR( PROCNODE(STEP(INODE_EFF)),
317     &           SLAVEF)) THEN
318            IF((KEEP(47).GE.2.AND.KEEP(81).EQ.1).AND.
319     &           (INSUBTREE.EQ.1))THEN
320               CALL CMUMPS_LOAD_SET_SBTR_MEM(.FALSE.)
321            ENDIF
322            INSUBTREE = 0
323         END IF
324      ELSE
325         IF (NBTOP < 1 ) THEN
326            WRITE(*,*) "Error 5 in CMUMPS_EXTRACT_POOL", NBTOP
327            CALL MUMPS_ABORT()
328         ENDIF
329         INODE = POOL( LPOOL - 2 - NBTOP )
330         IF(KEEP(81).EQ.1)THEN
331            CALL CMUMPS_LOAD_POOL_CHECK_MEM
332     &           (INODE,UPPER,SLAVEF,KEEP,KEEP8,
333     &            STEP,POOL,LPOOL,PROCNODE,N)
334            IF(UPPER)THEN
335               GOTO 666
336            ELSE
337               NBINSUBTREE=NBINSUBTREE-1
338               IF ( MUMPS_INSSARBR( PROCNODE(STEP(INODE)),
339     &              SLAVEF) ) THEN
340                  INSUBTREE = 1
341               ELSE IF ( MUMPS_ROOTSSARBR( PROCNODE(STEP(INODE)),
342     &                 SLAVEF)) THEN
343                  INSUBTREE = 0
344               ENDIF
345               GOTO 777
346            ENDIF
347         ENDIF
348         IF(KEEP(81).EQ.2)THEN
349            CALL CMUMPS_MEM_NODE_SELECT(INODE,POOL,LPOOL,N,STEP,
350     &           KEEP,KEEP8,
351     &           PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC)
352            IF(SBTR_FLAG)THEN
353               LEFT=.TRUE.
354               WRITE(*,*)MYID,': ca a change pour moi (3)'
355               GOTO 222
356            ENDIF
357         ELSE
358            IF(KEEP(81).EQ.3)THEN
359#if ! defined(NOT_ATM_POOL_SPECIAL)
360               IF((INODE.GE.0).AND.(INODE.LE.N))THEN
361#endif
362                  NODE_TO_EXTRACT=INODE
363                  FLAG_MEM=.FALSE.
364                  CALL CMUMPS_LOAD_CHK_MEMCST_POOL(FLAG_MEM)
365                  IF(FLAG_MEM)THEN
366                     CALL CMUMPS_MEM_NODE_SELECT(INODE,POOL,LPOOL,N,
367     &                    STEP,KEEP,KEEP8,
368     &                    PROCNODE,SLAVEF,MYID,SBTR_FLAG,
369     &                    PROC_FLAG,MIN_PROC)
370                     IF(SBTR_FLAG)THEN
371                        LEFT=.TRUE.
372                        WRITE(*,*)MYID,': ca a change pour moi (4)'
373                        GOTO 222
374                     ENDIF
375                  ELSE
376                     CALL CMUMPS_LOAD_CLEAN_MEMINFO_POOL(INODE)
377                  ENDIF
378#if ! defined(NOT_ATM_POOL_SPECIAL)
379               ENDIF
380#endif
381            ENDIF
382         ENDIF
383 666     CONTINUE
384         NBTOP = NBTOP - 1
385         IF((INODE.GT.0).AND.(INODE.LE.N))THEN
386            IF ((( KEEP(80) == 2 .OR. KEEP(80)==3 ) .AND.
387     &           ( KEEP(47) == 4 ))) THEN
388               CALL CMUMPS_REMOVE_NODE(INODE,2)
389            ENDIF
390         ENDIF
391         IF ( INODE < 0 ) THEN
392            INODE_EFF = -INODE
393         ELSE IF ( INODE > N ) THEN
394            INODE_EFF = INODE - N
395         ELSE
396            INODE_EFF = INODE
397         ENDIF
398      END IF
399 777  CONTINUE
400      POOL(LPOOL)     = NBINSUBTREE
401      POOL(LPOOL - 1) = NBTOP
402      POOL(LPOOL - 2) = INSUBTREE
403      RETURN
404      END SUBROUTINE CMUMPS_EXTRACT_POOL
405      SUBROUTINE CMUMPS_MEM_CONS_MNG(INODE,POOL,LPOOL,N,STEP,
406     &     KEEP,KEEP8,
407     &     PROCNODE,SLAVEF,MYID,SBTR,FLAG_SAME_PROC,MIN_PROC)
408      USE CMUMPS_LOAD
409      IMPLICIT NONE
410      INTEGER INODE,LPOOL,N,MYID,SLAVEF,PROC,MIN_PROC
411      INTEGER POOL(LPOOL),KEEP(500),STEP(N),PROCNODE(KEEP(28))
412      INTEGER(8) KEEP8(150)
413      INTEGER MUMPS_PROCNODE
414      EXTERNAL MUMPS_PROCNODE
415      LOGICAL SBTR,FLAG_SAME_PROC
416      INTEGER POS_TO_EXTRACT,NODE_TO_EXTRACT,NBTOP,I,INSUBTREE,
417     &     NBINSUBTREE
418      DOUBLE PRECISION MIN_COST, TMP_COST
419      NBINSUBTREE = POOL(LPOOL)
420      NBTOP       = POOL(LPOOL - 1)
421      INSUBTREE   = POOL(LPOOL - 2)
422      MIN_COST=huge(MIN_COST)
423      TMP_COST=huge(TMP_COST)
424      FLAG_SAME_PROC=.FALSE.
425      SBTR=.FALSE.
426      MIN_PROC=-9999
427#if ! defined(NOT_ATM_POOL_SPECIAL)
428      IF((INODE.GT.0).AND.(INODE.LE.N))THEN
429#endif
430         POS_TO_EXTRACT=-1
431         NODE_TO_EXTRACT=-1
432         DO I=NBTOP,1,-1
433            IF(NODE_TO_EXTRACT.LT.0)THEN
434               POS_TO_EXTRACT=I
435               NODE_TO_EXTRACT=POOL(LPOOL-2-I)
436               CALL CMUMPS_LOAD_COMP_MAXMEM_POOL(NODE_TO_EXTRACT,
437     &                                       TMP_COST,PROC)
438               MIN_COST=TMP_COST
439               MIN_PROC=PROC
440            ELSE
441               CALL CMUMPS_LOAD_COMP_MAXMEM_POOL(POOL(LPOOL-2-I),
442     &                                       TMP_COST,PROC)
443               IF((PROC.NE.MIN_PROC).OR.(TMP_COST.NE.MIN_COST))THEN
444                  FLAG_SAME_PROC=.TRUE.
445               ENDIF
446               IF(TMP_COST.GT.MIN_COST)THEN
447                  POS_TO_EXTRACT=I
448                  NODE_TO_EXTRACT=POOL(LPOOL-2-I)
449                  MIN_COST=TMP_COST
450                  MIN_PROC=PROC
451               ENDIF
452            ENDIF
453         ENDDO
454         IF((KEEP(47).EQ.4).AND.(NBINSUBTREE.NE.0))THEN
455            CALL CMUMPS_CHECK_SBTR_COST(NBINSUBTREE,INSUBTREE,NBTOP,
456     &           MIN_COST,SBTR)
457            IF(SBTR)THEN
458               WRITE(*,*)MYID,': selecting from subtree'
459               RETURN
460            ENDIF
461         ENDIF
462         IF((.NOT.SBTR).AND.(.NOT.FLAG_SAME_PROC))THEN
463            WRITE(*,*)MYID,': I must search for a task
464     &           to save My friend'
465            RETURN
466         ENDIF
467         INODE = NODE_TO_EXTRACT
468         DO I=POS_TO_EXTRACT,NBTOP
469            IF(I.NE.NBTOP)THEN
470               POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1)
471            ENDIF
472         ENDDO
473         POOL(LPOOL-2-NBTOP)=INODE
474         CALL CMUMPS_LOAD_CLEAN_MEMINFO_POOL(INODE)
475#if ! defined(NOT_ATM_POOL_SPECIAL)
476      ELSE
477      ENDIF
478#endif
479      END SUBROUTINE CMUMPS_MEM_CONS_MNG
480      SUBROUTINE CMUMPS_MEM_NODE_SELECT(INODE,POOL,LPOOL,N,STEP,
481     &     KEEP,KEEP8,
482     &     PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC)
483      USE CMUMPS_LOAD
484      IMPLICIT NONE
485      INTEGER INODE,LPOOL,N,SLAVEF,MYID,MIN_PROC
486      INTEGER POOL(LPOOL),KEEP(500),PROCNODE(KEEP(28)),STEP(N)
487      INTEGER(8) KEEP8(150)
488      LOGICAL SBTR_FLAG,PROC_FLAG
489      EXTERNAL MUMPS_INSSARBR
490      LOGICAL MUMPS_INSSARBR
491      INTEGER NODE_TO_EXTRACT,I,POS_TO_EXTRACT,NBTOP,NBINSUBTREE
492      NBTOP= POOL(LPOOL - 1)
493      NBINSUBTREE = POOL(LPOOL)
494      IF(NBTOP.GT.0)THEN
495         WRITE(*,*)MYID,': NBTOP=',NBTOP
496      ENDIF
497      SBTR_FLAG=.FALSE.
498      PROC_FLAG=.FALSE.
499      CALL CMUMPS_MEM_CONS_MNG(INODE,POOL,LPOOL,N,STEP,KEEP,KEEP8,
500     &     PROCNODE,SLAVEF,MYID,SBTR_FLAG,PROC_FLAG,MIN_PROC)
501      IF(SBTR_FLAG)THEN
502         RETURN
503      ENDIF
504      IF(MIN_PROC.EQ.-9999)THEN
505#if ! defined(NOT_ATM_POOL_SPECIAL)
506         IF((INODE.GT.0).AND.(INODE.LT.N))THEN
507#endif
508            SBTR_FLAG=(NBINSUBTREE.NE.0)
509#if ! defined(NOT_ATM_POOL_SPECIAL)
510         ENDIF
511#endif
512         RETURN
513      ENDIF
514      IF(.NOT.PROC_FLAG)THEN
515         NODE_TO_EXTRACT=INODE
516         IF((INODE.GE.0).AND.(INODE.LE.N))THEN
517            CALL CMUMPS_FIND_BEST_NODE_FOR_MEM(MIN_PROC,POOL,
518     &           LPOOL,INODE)
519            IF(MUMPS_INSSARBR(PROCNODE(STEP(INODE)),
520     &           SLAVEF))THEN
521               WRITE(*,*)MYID,': Extracting from a subtree
522     &              for helping',MIN_PROC
523               SBTR_FLAG=.TRUE.
524               RETURN
525            ELSE
526               IF(NODE_TO_EXTRACT.NE.INODE)THEN
527                  WRITE(*,*)MYID,': Extracting from top
528     &                 inode=',INODE,'for helping',MIN_PROC
529               ENDIF
530               CALL CMUMPS_LOAD_CLEAN_MEMINFO_POOL(INODE)
531            ENDIF
532         ENDIF
533         DO I=1,NBTOP
534            IF (POOL(LPOOL-2-I).EQ.INODE)THEN
535               GOTO 452
536            ENDIF
537         ENDDO
538 452     CONTINUE
539         POS_TO_EXTRACT=I
540         DO I=POS_TO_EXTRACT,NBTOP-1
541            POOL(LPOOL-2-I)=POOL(LPOOL-2-I-1)
542         ENDDO
543         POOL(LPOOL-2-NBTOP)=INODE
544      ENDIF
545      END SUBROUTINE CMUMPS_MEM_NODE_SELECT
546      SUBROUTINE CMUMPS_GET_INODE_FROM_POOL
547     &           ( IPOOL, LPOOL, III, LEAF,
548     &             INODE, STRATEGIE )
549            IMPLICIT NONE
550      INTEGER, INTENT(IN) :: STRATEGIE, LPOOL
551      INTEGER IPOOL (LPOOL)
552      INTEGER III,LEAF
553      INTEGER, INTENT(OUT) :: INODE
554         LEAF  = LEAF - 1
555         INODE = IPOOL( LEAF )
556      RETURN
557      END SUBROUTINE CMUMPS_GET_INODE_FROM_POOL
558