File: cfac_sol_pool.F

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