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_OOC
49      USE MUMPS_OOC_COMMON
50      IMPLICIT NONE
51      INTEGER NOT_IN_MEM,BEING_READ,NOT_USED,PERMUTED,USED,
52     &     USED_NOT_PERMUTED,ALREADY_USED
53      PARAMETER (NOT_IN_MEM=0,BEING_READ=-1,NOT_USED=-2,
54     &     PERMUTED=-3,USED=-4,USED_NOT_PERMUTED=-5,ALREADY_USED=-6)
55      INTEGER OOC_NODE_NOT_IN_MEM,OOC_NODE_PERMUTED,
56     &     OOC_NODE_NOT_PERMUTED
57      PARAMETER (OOC_NODE_NOT_IN_MEM=-20,
58     &     OOC_NODE_PERMUTED=-21,OOC_NODE_NOT_PERMUTED=-22)
59      INTEGER(8), DIMENSION(:,:),POINTER :: SIZE_OF_BLOCK
60      INTEGER, DIMENSION(:),POINTER :: TOTAL_NB_OOC_NODES
61      INTEGER :: OOC_SOLVE_TYPE_FCT
62      INTEGER, DIMENSION(:),ALLOCATABLE :: IO_REQ
63      INTEGER(8), DIMENSION(:), ALLOCATABLE:: LRLUS_SOLVE
64      INTEGER(8), DIMENSION(:), ALLOCATABLE:: SIZE_SOLVE_Z,
65     & LRLU_SOLVE_T, POSFAC_SOLVE, IDEB_SOLVE_Z, LRLU_SOLVE_B
66      INTEGER, DIMENSION(:),ALLOCATABLE :: PDEB_SOLVE_Z
67      INTEGER (8),SAVE :: FACT_AREA_SIZE,
68     &     SIZE_ZONE_SOLVE,SIZE_SOLVE_EMM,TMP_SIZE_FACT,
69     &     MAX_SIZE_FACTOR_OOC
70      INTEGER(8), SAVE :: MIN_SIZE_READ
71      INTEGER, SAVE :: TMP_NB_NODES, MAX_NB_NODES_FOR_ZONE,MAX_NB_REQ,
72     &     CURRENT_SOLVE_READ_ZONE,
73     &     CUR_POS_SEQUENCE,NB_Z,SOLVE_STEP,
74     &     NB_ZONE_REQ,MTYPE_OOC,NB_ACT
75#if defined (NEW_PREF_SCHEME)
76      INTEGER,SAVE :: MAX_PREF_SIZE
77#endif
78     &     ,NB_CALLED,REQ_ACT,NB_CALL
79      INTEGER(8), SAVE :: OOC_VADDR_PTR
80      INTEGER(8), SAVE :: SIZE_ZONE_REQ
81      DOUBLE PRECISION,SAVE :: MAX_OOC_FILE_SIZE
82      INTEGER(8), DIMENSION(:), ALLOCATABLE :: SIZE_OF_READ, READ_DEST
83      INTEGER,DIMENSION(:),ALLOCATABLE :: FIRST_POS_IN_READ,
84     &     READ_MNG,REQ_TO_ZONE,POS_HOLE_T,
85     &     POS_HOLE_B,REQ_ID,OOC_STATE_NODE
86      INTEGER SMUMPS_ELEMENTARY_DATA_SIZE,N_OOC
87      INTEGER, DIMENSION(:), ALLOCATABLE :: POS_IN_MEM, INODE_TO_POS
88      INTEGER, DIMENSION(:), ALLOCATABLE :: CURRENT_POS_T,CURRENT_POS_B
89      LOGICAL IS_ROOT_SPECIAL
90      INTEGER SPECIAL_ROOT_NODE
91      PUBLIC :: SMUMPS_575,SMUMPS_576,
92     &     SMUMPS_577,
93     &     SMUMPS_578,
94     &     SMUMPS_579,
95     &     SMUMPS_582,
96     &     SMUMPS_583,SMUMPS_584,
97     &     SMUMPS_585,SMUMPS_586
98         INTEGER, PARAMETER, PUBLIC :: TYPEF_BOTH_LU = -99976
99         PUBLIC SMUMPS_688,
100     &        SMUMPS_690
101         PRIVATE SMUMPS_695,
102     &        SMUMPS_697
103      CONTAINS
104      SUBROUTINE SMUMPS_711( STRAT_IO_ARG,
105     & STRAT_IO_ASYNC_ARG, WITH_BUF_ARG, LOW_LEVEL_STRAT_IO_ARG )
106      IMPLICIT NONE
107      INTEGER, intent(out) :: LOW_LEVEL_STRAT_IO_ARG
108      LOGICAL, intent(out) :: STRAT_IO_ASYNC_ARG, WITH_BUF_ARG
109      INTEGER, intent(in)  :: STRAT_IO_ARG
110      INTEGER TMP
111      CALL MUMPS_OOC_IS_ASYNC_AVAIL(TMP)
112      STRAT_IO_ASYNC_ARG=.FALSE.
113      WITH_BUF_ARG=.FALSE.
114      IF(TMP.EQ.1)THEN
115         IF((STRAT_IO_ARG.EQ.1).OR.(STRAT_IO_ARG.EQ.2))THEN
116            STRAT_IO_ASYNC=.TRUE.
117            WITH_BUF=.FALSE.
118         ELSEIF((STRAT_IO_ARG.EQ.4).OR.(STRAT_IO_ARG.EQ.5))THEN
119            STRAT_IO_ASYNC_ARG=.TRUE.
120            WITH_BUF_ARG=.TRUE.
121         ELSEIF(STRAT_IO_ARG.EQ.3)THEN
122            STRAT_IO_ASYNC_ARG=.FALSE.
123            WITH_BUF_ARG=.TRUE.
124         ENDIF
125         LOW_LEVEL_STRAT_IO_ARG=mod(STRAT_IO_ARG,3)
126      ELSE
127         LOW_LEVEL_STRAT_IO_ARG=0
128         IF(STRAT_IO_ARG.GE.3)THEN
129            WITH_BUF_ARG=.TRUE.
130         ENDIF
131      ENDIF
132      RETURN
133      END SUBROUTINE SMUMPS_711
134      FUNCTION SMUMPS_579(INODE,ZONE)
135      IMPLICIT NONE
136      INTEGER INODE,ZONE
137      LOGICAL SMUMPS_579
138      SMUMPS_579=(LRLUS_SOLVE(ZONE).GE.
139     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE))
140      RETURN
141      END FUNCTION SMUMPS_579
142      SUBROUTINE SMUMPS_590(LA)
143      IMPLICIT NONE
144      INTEGER(8) :: LA
145      FACT_AREA_SIZE=LA
146      END SUBROUTINE SMUMPS_590
147      SUBROUTINE SMUMPS_575(id, MAXS)
148      USE SMUMPS_STRUC_DEF
149      USE SMUMPS_OOC_BUFFER
150      IMPLICIT NONE
151      INTEGER TMPDIR_MAX_LENGTH, PREFIX_MAX_LENGTH
152      PARAMETER (TMPDIR_MAX_LENGTH=255, PREFIX_MAX_LENGTH=63)
153      INTEGER(8), intent(in) :: MAXS
154      TYPE(SMUMPS_STRUC), TARGET :: id
155      INTEGER IERR
156      INTEGER allocok
157      INTEGER ASYNC
158      CHARACTER*1 TMP_DIR(TMPDIR_MAX_LENGTH),
159     &            TMP_PREFIX(PREFIX_MAX_LENGTH)
160      INTEGER DIM_DIR,DIM_PREFIX
161      INTEGER, DIMENSION(:), ALLOCATABLE :: FILE_FLAG_TAB
162      INTEGER TMP
163      INTEGER K211_LOC
164      ICNTL1=id%ICNTL(1)
165      MAX_SIZE_FACTOR_OOC=0_8
166      N_OOC=id%N
167      ASYNC=0
168      SOLVE=.FALSE.
169      IERR=0
170      IF(allocated(IO_REQ))THEN
171         DEALLOCATE(IO_REQ)
172      ENDIF
173      IF(associated(KEEP_OOC))THEN
174         NULLIFY(KEEP_OOC)
175      ENDIF
176      IF(associated(STEP_OOC))THEN
177         NULLIFY(STEP_OOC)
178      ENDIF
179      IF(associated(PROCNODE_OOC))THEN
180         NULLIFY(PROCNODE_OOC)
181      ENDIF
182      IF(associated(OOC_INODE_SEQUENCE))THEN
183         NULLIFY(OOC_INODE_SEQUENCE)
184      ENDIF
185      IF(associated(TOTAL_NB_OOC_NODES))THEN
186         NULLIFY(TOTAL_NB_OOC_NODES)
187      ENDIF
188      IF(associated(SIZE_OF_BLOCK))THEN
189         NULLIFY(SIZE_OF_BLOCK)
190      ENDIF
191      IF(associated(OOC_VADDR))THEN
192         NULLIFY(OOC_VADDR)
193      ENDIF
194      IF(allocated(I_CUR_HBUF_NEXTPOS))THEN
195         DEALLOCATE(I_CUR_HBUF_NEXTPOS)
196      ENDIF
197      CALL SMUMPS_588(id,IERR)
198      IF(IERR.LT.0)THEN
199         IF (ICNTL1 > 0)
200     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
201         id%INFO(1) = IERR
202         id%INFO(2) = 0
203         RETURN
204      ENDIF
205      CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB,
206     &     id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID )
207      IF (id%KEEP(201).EQ.2) THEN
208        OOC_FCT_TYPE=1
209      ENDIF
210      STEP_OOC=>id%STEP
211      PROCNODE_OOC=>id%PROCNODE_STEPS
212      MYID_OOC=id%MYID
213      SLAVEF_OOC=id%NSLAVES
214      KEEP_OOC => id%KEEP
215      SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK
216      OOC_VADDR=>id%OOC_VADDR
217      IF(id%KEEP(107).GT.0)THEN
218         SIZE_SOLVE_EMM=max(id%KEEP8(19),int(dble(MAXS)*
219     &        0.9d0*0.2d0,8))
220         SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM,
221     &        int((dble(MAXS)*0.9d0-
222     &        dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8))
223         IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN
224            SIZE_SOLVE_EMM=id%KEEP8(19)
225            SIZE_ZONE_SOLVE=int((dble(MAXS)*0.9d0-
226     &           dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)
227         ENDIF
228      ELSE
229         SIZE_ZONE_SOLVE=int(dble(MAXS)*0.9d0,8)
230         SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE
231      ENDIF
232      SMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35)
233      SIZE_OF_BLOCK=0_8
234      ALLOCATE(id%OOC_NB_FILES(OOC_NB_FILE_TYPE), stat=allocok)
235      IF (allocok .GT. 0) THEN
236         IF (ICNTL1.GT.0)
237     &   WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC'
238         id%INFO(1) = -13
239         id%INFO(2) = OOC_NB_FILE_TYPE
240         RETURN
241      ENDIF
242      id%OOC_NB_FILES=0
243      OOC_VADDR_PTR=0_8
244      CALL SMUMPS_711( id%KEEP(99), STRAT_IO_ASYNC,
245     &                                WITH_BUF, LOW_LEVEL_STRAT_IO )
246      TMP_SIZE_FACT=0_8
247      TMP_NB_NODES=0
248      MAX_NB_NODES_FOR_ZONE=0
249      OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE
250      ALLOCATE(I_CUR_HBUF_NEXTPOS(OOC_NB_FILE_TYPE),
251     &     stat=allocok)
252      IF (allocok .GT. 0) THEN
253         IF (ICNTL1.GT.0)
254     &   WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC'
255         id%INFO(1) = -13
256         id%INFO(2) = OOC_NB_FILE_TYPE
257         RETURN
258      ENDIF
259      I_CUR_HBUF_NEXTPOS = 1
260      IF(WITH_BUF)THEN
261         CALL SMUMPS_669(id%INFO(1),id%INFO(2),IERR)
262         IF(IERR.LT.0)THEN
263            RETURN
264         ENDIF
265      ENDIF
266      IF(STRAT_IO_ASYNC)THEN
267         ASYNC=1
268      ENDIF
269      DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN
270      CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC)
271      DIM_DIR=len(trim(id%OOC_TMPDIR))
272      DIM_PREFIX=len(trim(id%OOC_PREFIX))
273      CALL SMUMPS_589(TMP_DIR(1),
274     &     id%OOC_TMPDIR, TMPDIR_MAX_LENGTH, DIM_DIR )
275      CALL SMUMPS_589(TMP_PREFIX(1),
276     &     id%OOC_PREFIX, PREFIX_MAX_LENGTH, DIM_PREFIX)
277      CALL MUMPS_LOW_LEVEL_INIT_PREFIX(DIM_PREFIX, TMP_PREFIX)
278      CALL MUMPS_LOW_LEVEL_INIT_TMPDIR(DIM_DIR, TMP_DIR)
279      ALLOCATE(FILE_FLAG_TAB(OOC_NB_FILE_TYPE),
280     &     stat=allocok)
281      IF (allocok .GT. 0) THEN
282         IF (ICNTL1 .GT. 0)
283     &   WRITE(ICNTL1,*) 'PB allocation in SMUMPS_INIT_OOC'
284         id%INFO(1) = -13
285         id%INFO(2) = OOC_NB_FILE_TYPE
286         RETURN
287      ENDIF
288      FILE_FLAG_TAB(1:OOC_NB_FILE_TYPE)=0
289      IERR=0
290      TMP=int(id%KEEP8(11)/1000000_8,kind=4)+1
291      IF((id%KEEP(201).EQ.1).AND.(id%KEEP(50).EQ.0)
292     &   ) THEN
293         TMP=max(1,TMP/2)
294      ENDIF
295      CALL MUMPS_LOW_LEVEL_INIT_OOC_C(MYID_OOC,TMP,
296     &     id%KEEP(35),LOW_LEVEL_STRAT_IO,K211_LOC,OOC_NB_FILE_TYPE,
297     &     FILE_FLAG_TAB,IERR)
298      IF(IERR.LT.0)THEN
299         IF (ICNTL1 .GT. 0 ) THEN
300           WRITE(ICNTL1,*)MYID_OOC,': PB in MUMPS_LOW_LEVEL_INIT_OOC_C'
301           WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
302         ENDIF
303         id%INFO(1) = IERR
304         id%INFO(2) = 0
305         RETURN
306      ENDIF
307      CALL MUMPS_GET_MAX_FILE_SIZE_C(MAX_OOC_FILE_SIZE)
308      DEALLOCATE(FILE_FLAG_TAB)
309      RETURN
310      END SUBROUTINE SMUMPS_575
311      SUBROUTINE SMUMPS_576(INODE,PTRFAC,KEEP,KEEP8,
312     &           A,LA,SIZE,IERR)
313      USE SMUMPS_OOC_BUFFER
314      IMPLICIT NONE
315      INTEGER INODE,KEEP(500)
316      INTEGER(8) :: LA
317      INTEGER(8) KEEP8(150)
318      INTEGER(8) :: PTRFAC(KEEP(28)), SIZE
319      REAL A(LA)
320      INTEGER IERR,NODE,ASYNC,REQUEST
321      LOGICAL IO_C
322      INTEGER ADDR_INT1,ADDR_INT2
323      INTEGER TYPE
324      INTEGER SIZE_INT1,SIZE_INT2
325      TYPE=FCT
326      IF(STRAT_IO_ASYNC)THEN
327         ASYNC=1
328      ELSE
329         ASYNC=0
330      ENDIF
331      IERR=0
332      IO_C=.TRUE.
333      SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)=SIZE
334      MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,SIZE)
335      OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)=OOC_VADDR_PTR
336      OOC_VADDR_PTR=OOC_VADDR_PTR+SIZE
337      TMP_SIZE_FACT=TMP_SIZE_FACT+SIZE
338      TMP_NB_NODES=TMP_NB_NODES+1
339      IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN
340         MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,TMP_NB_NODES)
341         TMP_SIZE_FACT=0_8
342         TMP_NB_NODES=0
343      ENDIF
344      IF (.NOT. WITH_BUF) THEN
345         CALL MUMPS_677(ADDR_INT1,ADDR_INT2,
346     &        OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE))
347         CALL MUMPS_677(SIZE_INT1,SIZE_INT2,
348     &        SIZE)
349         CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO,
350     &       A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2,
351     &       INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR)
352        IF(IERR.LT.0)THEN
353           IF (ICNTL1.GT.0)
354     &     WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
355           RETURN
356        ENDIF
357        IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN
358             WRITE(*,*)MYID_OOC,': Internal error (37) in OOC '
359           CALL MUMPS_ABORT()
360        ENDIF
361        OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE),
362     &       OOC_FCT_TYPE)=INODE
363        I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)=
364     &       I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1
365      ELSE
366         IF(SIZE.LE.HBUF_SIZE)THEN
367            CALL SMUMPS_678
368     &           (A(PTRFAC(STEP_OOC(INODE))),SIZE,IERR)
369            OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE),
370     &           OOC_FCT_TYPE) = INODE
371            I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) =
372     &           I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) + 1
373#if ! defined (OOC_DEBUG)
374            PTRFAC(STEP_OOC(INODE))=-777777_8
375#endif
376            RETURN
377         ELSE
378            CALL SMUMPS_707(OOC_FCT_TYPE,IERR)
379            IF(IERR.LT.0)THEN
380               RETURN
381            ENDIF
382            CALL SMUMPS_707(OOC_FCT_TYPE,IERR)
383            IF(IERR.LT.0)THEN
384               RETURN
385            ENDIF
386            CALL MUMPS_677(ADDR_INT1,ADDR_INT2,
387     &           OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE))
388            CALL MUMPS_677(SIZE_INT1,SIZE_INT2,
389     &           SIZE)
390            CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO,
391     &           A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2,
392     &           INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR)
393            IF(IERR.LT.0)THEN
394               IF (ICNTL1.GT.0)
395     &         WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
396               RETURN
397            ENDIF
398            IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN
399             WRITE(*,*)MYID_OOC,': Internal error (38) in OOC '
400               CALL MUMPS_ABORT()
401            ENDIF
402            OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE),
403     &           OOC_FCT_TYPE)=INODE
404            I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)=
405     &           I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1
406            CALL SMUMPS_689(OOC_FCT_TYPE)
407         ENDIF
408      END IF
409      NODE=-9999
410#if ! defined (OOC_DEBUG)
411      PTRFAC(STEP_OOC(INODE))=-777777_8
412#endif
413      IF(STRAT_IO_ASYNC)THEN
414         IERR=0
415         CALL MUMPS_WAIT_REQUEST(REQUEST,IERR)
416         IF(IERR.LT.0)THEN
417            IF (ICNTL1 .GT. 0)
418     &      WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
419            RETURN
420         ENDIF
421      ENDIF
422      RETURN
423      END SUBROUTINE SMUMPS_576
424      SUBROUTINE SMUMPS_577(DEST,INODE,IERR
425     &  )
426      IMPLICIT NONE
427      INCLUDE 'mpif.h'
428      INTEGER IERR,INODE
429      REAL DEST
430      INTEGER ASYNC
431      LOGICAL IO_C
432#if defined(OLD_READ)
433      INTEGER REQUEST
434#endif
435      INTEGER ADDR_INT1,ADDR_INT2
436      INTEGER TYPE
437      INTEGER SIZE_INT1,SIZE_INT2
438      TYPE=OOC_SOLVE_TYPE_FCT
439      IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
440     &     .EQ.0_8)THEN
441         GOTO 555
442      ENDIF
443      IF(STRAT_IO_ASYNC)THEN
444        ASYNC=1
445      ELSE
446        ASYNC=0
447      ENDIF
448      IERR=0
449      IO_C=.TRUE.
450#if ! defined(OLD_READ)
451      OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
452      CALL MUMPS_677(ADDR_INT1,ADDR_INT2,
453     &     OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE))
454      CALL MUMPS_677(SIZE_INT1,SIZE_INT2,
455     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE))
456      CALL MUMPS_LOW_LEVEL_DIRECT_READ(DEST,
457     &     SIZE_INT1,SIZE_INT2,
458     &     TYPE,ADDR_INT1,ADDR_INT2,IERR)
459      IF(IERR.LT.0)THEN
460         IF (ICNTL1.GT.0) THEN
461           WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
462           WRITE(ICNTL1,*)MYID_OOC,
463     &     ': Problem in MUMPS_LOW_LEVEL_DIRECT_READ'
464         ENDIF
465         RETURN
466      ENDIF
467#else
468      OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
469      CALL MUMPS_677(ADDR_INT1,ADDR_INT2,
470     &     OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE))
471      CALL MUMPS_677(SIZE_INT1,SIZE_INT2,
472     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE))
473      CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO,
474     &     DEST,SIZE_INT1,SIZE_INT2,
475     &     INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR)
476      IF(IERR.LT.0)THEN
477         IF (ICNTL1 .GT. 0 ) THEN
478           WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
479           WRITE(ICNTL1,*)MYID_OOC,
480     &     ': Problem in MUMPS_LOW_LEVEL_READ_OOC'
481         ENDIF
482         RETURN
483      ENDIF
484      IF(STRAT_IO_ASYNC)THEN
485         IERR=0
486         CALL MUMPS_WAIT_REQUEST(REQUEST,IERR)
487         IF(IERR.LT.0)THEN
488            IF (ICNTL1 .GT. 0 )
489     &      WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
490            RETURN
491         ENDIF
492      ENDIF
493#endif
494 555  CONTINUE
495      IF(.NOT.SMUMPS_727())THEN
496         IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ.
497     &        INODE)THEN
498            IF(SOLVE_STEP.EQ.0)THEN
499               CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
500            ELSEIF(SOLVE_STEP.EQ.1)THEN
501               CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
502            ENDIF
503            CALL SMUMPS_728()
504         ENDIF
505      ENDIF
506      RETURN
507      END SUBROUTINE SMUMPS_577
508      SUBROUTINE SMUMPS_591(IERR)
509      USE SMUMPS_OOC_BUFFER
510      IMPLICIT NONE
511      INTEGER, intent(out):: IERR
512      IERR=0
513      IF (WITH_BUF) THEN
514        CALL SMUMPS_675(IERR)
515        IF(IERR.LT.0)THEN
516           RETURN
517        ENDIF
518      END IF
519      RETURN
520      END SUBROUTINE SMUMPS_591
521      SUBROUTINE SMUMPS_592(id,IERR)
522      USE SMUMPS_OOC_BUFFER
523      USE SMUMPS_STRUC_DEF
524      IMPLICIT NONE
525      TYPE(SMUMPS_STRUC), TARGET :: id
526      INTEGER, intent(out) :: IERR
527      INTEGER I,SOLVE_OR_FACTO
528      IERR=0
529      IF(WITH_BUF)THEN
530         CALL SMUMPS_659()
531      ENDIF
532      IF(associated(KEEP_OOC))THEN
533         NULLIFY(KEEP_OOC)
534      ENDIF
535      IF(associated(STEP_OOC))THEN
536         NULLIFY(STEP_OOC)
537      ENDIF
538      IF(associated(PROCNODE_OOC))THEN
539         NULLIFY(PROCNODE_OOC)
540      ENDIF
541      IF(associated(OOC_INODE_SEQUENCE))THEN
542         NULLIFY(OOC_INODE_SEQUENCE)
543      ENDIF
544      IF(associated(TOTAL_NB_OOC_NODES))THEN
545         NULLIFY(TOTAL_NB_OOC_NODES)
546      ENDIF
547      IF(associated(SIZE_OF_BLOCK))THEN
548         NULLIFY(SIZE_OF_BLOCK)
549      ENDIF
550      IF(associated(OOC_VADDR))THEN
551         NULLIFY(OOC_VADDR)
552      ENDIF
553      CALL MUMPS_OOC_END_WRITE_C(IERR)
554      IF(IERR.LT.0)THEN
555         IF (ICNTL1 .GT. 0)
556     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
557         GOTO 500
558      ENDIF
559      id%OOC_MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,
560     &     TMP_NB_NODES)
561      IF(allocated(I_CUR_HBUF_NEXTPOS))THEN
562         DO I=1,OOC_NB_FILE_TYPE
563            id%OOC_TOTAL_NB_NODES(I)=I_CUR_HBUF_NEXTPOS(I)-1
564         ENDDO
565         DEALLOCATE(I_CUR_HBUF_NEXTPOS)
566      ENDIF
567      id%KEEP8(20)=MAX_SIZE_FACTOR_OOC
568      CALL SMUMPS_613(id,IERR)
569      IF(IERR.LT.0)THEN
570         GOTO 500
571      ENDIF
572 500  CONTINUE
573      SOLVE_OR_FACTO=0
574      CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR)
575      IF(IERR.LT.0)THEN
576         IF (ICNTL1.GT.0)
577     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
578         RETURN
579      ENDIF
580      RETURN
581      END SUBROUTINE SMUMPS_592
582      SUBROUTINE SMUMPS_588(id,IERR)
583      USE SMUMPS_STRUC_DEF
584      IMPLICIT NONE
585      EXTERNAL MUMPS_OOC_REMOVE_FILE_C
586      TYPE(SMUMPS_STRUC), TARGET :: id
587      INTEGER IERR
588      INTEGER I,J,I1,K
589      CHARACTER*1 TMP_NAME(350)
590      IERR=0
591      K=1
592      IF(associated(id%OOC_FILE_NAMES).AND.
593     &     associated(id%OOC_FILE_NAME_LENGTH))THEN
594         DO I1=1,OOC_NB_FILE_TYPE
595            DO I=1,id%OOC_NB_FILES(I1)
596               DO J=1,id%OOC_FILE_NAME_LENGTH(K)
597                  TMP_NAME(J)=id%OOC_FILE_NAMES(K,J)
598               ENDDO
599               CALL MUMPS_OOC_REMOVE_FILE_C(IERR, TMP_NAME(1))
600               IF(IERR.LT.0)THEN
601                  IF (ICNTL1.GT.0)THEN
602                     WRITE(ICNTL1,*)MYID_OOC,': ',
603     &                    ERR_STR_OOC(1:DIM_ERR_STR_OOC)
604                     RETURN
605                  ENDIF
606               ENDIF
607               K=K+1
608            ENDDO
609         ENDDO
610      ENDIF
611      IF(associated(id%OOC_FILE_NAMES))THEN
612         DEALLOCATE(id%OOC_FILE_NAMES)
613         NULLIFY(id%OOC_FILE_NAMES)
614      ENDIF
615      IF(associated(id%OOC_FILE_NAME_LENGTH))THEN
616         DEALLOCATE(id%OOC_FILE_NAME_LENGTH)
617         NULLIFY(id%OOC_FILE_NAME_LENGTH)
618      ENDIF
619      IF(associated(id%OOC_NB_FILES))THEN
620         DEALLOCATE(id%OOC_NB_FILES)
621         NULLIFY(id%OOC_NB_FILES)
622      ENDIF
623      RETURN
624      END SUBROUTINE SMUMPS_588
625      SUBROUTINE SMUMPS_587(id,IERR)
626      USE SMUMPS_STRUC_DEF
627      IMPLICIT NONE
628      TYPE(SMUMPS_STRUC), TARGET :: id
629      INTEGER IERR
630      IERR=0
631      CALL SMUMPS_588(id,IERR)
632      IF(associated(id%OOC_TOTAL_NB_NODES))THEN
633         DEALLOCATE(id%OOC_TOTAL_NB_NODES)
634         NULLIFY(id%OOC_TOTAL_NB_NODES)
635      ENDIF
636      IF(associated(id%OOC_INODE_SEQUENCE))THEN
637         DEALLOCATE(id%OOC_INODE_SEQUENCE)
638         NULLIFY(id%OOC_INODE_SEQUENCE)
639      ENDIF
640      IF(associated(id%OOC_SIZE_OF_BLOCK))THEN
641         DEALLOCATE(id%OOC_SIZE_OF_BLOCK)
642         NULLIFY(id%OOC_SIZE_OF_BLOCK)
643      ENDIF
644      IF(associated(id%OOC_VADDR))THEN
645         DEALLOCATE(id%OOC_VADDR)
646         NULLIFY(id%OOC_VADDR)
647      ENDIF
648      RETURN
649      END SUBROUTINE SMUMPS_587
650      SUBROUTINE SMUMPS_586(id)
651      USE SMUMPS_STRUC_DEF
652      IMPLICIT NONE
653      INCLUDE 'mpif.h'
654      TYPE(SMUMPS_STRUC), TARGET :: id
655      INTEGER TMP,I,J
656      INTEGER(8) :: TMP_SIZE8
657      INTEGER allocok,IERR
658      EXTERNAL MUMPS_275
659      INTEGER MUMPS_275
660      INTEGER MASTER_ROOT
661      IERR=0
662      ICNTL1=id%ICNTL(1)
663      SOLVE=.TRUE.
664      N_OOC=id%N
665      IF(allocated(LRLUS_SOLVE))THEN
666         DEALLOCATE(LRLUS_SOLVE)
667      ENDIF
668      IF(allocated(LRLU_SOLVE_T))THEN
669         DEALLOCATE(LRLU_SOLVE_T)
670      ENDIF
671      IF(allocated(LRLU_SOLVE_B))THEN
672         DEALLOCATE(LRLU_SOLVE_B)
673      ENDIF
674      IF(allocated(POSFAC_SOLVE))THEN
675         DEALLOCATE(POSFAC_SOLVE)
676      ENDIF
677      IF(allocated(IDEB_SOLVE_Z))THEN
678         DEALLOCATE(IDEB_SOLVE_Z)
679      ENDIF
680      IF(allocated(PDEB_SOLVE_Z))THEN
681         DEALLOCATE(PDEB_SOLVE_Z)
682      ENDIF
683      IF(allocated(SIZE_SOLVE_Z))THEN
684         DEALLOCATE(SIZE_SOLVE_Z)
685      ENDIF
686      IF(allocated(CURRENT_POS_T))THEN
687         DEALLOCATE(CURRENT_POS_T)
688      ENDIF
689      IF(allocated(CURRENT_POS_B))THEN
690         DEALLOCATE(CURRENT_POS_B)
691      ENDIF
692      IF(allocated(POS_HOLE_T))THEN
693         DEALLOCATE(POS_HOLE_T)
694      ENDIF
695      IF(allocated(POS_HOLE_B))THEN
696         DEALLOCATE(POS_HOLE_B)
697      ENDIF
698      IF(allocated(OOC_STATE_NODE))THEN
699         DEALLOCATE(OOC_STATE_NODE)
700      ENDIF
701      IF(allocated(POS_IN_MEM))THEN
702         DEALLOCATE(POS_IN_MEM)
703      ENDIF
704      IF(allocated(INODE_TO_POS))THEN
705         DEALLOCATE(INODE_TO_POS)
706      ENDIF
707      IF(allocated(SIZE_OF_READ))THEN
708         DEALLOCATE(SIZE_OF_READ)
709      ENDIF
710      IF(allocated(FIRST_POS_IN_READ))THEN
711         DEALLOCATE(FIRST_POS_IN_READ)
712      ENDIF
713      IF(allocated(READ_DEST))THEN
714         DEALLOCATE(READ_DEST)
715      ENDIF
716      IF(allocated(READ_MNG))THEN
717         DEALLOCATE(READ_MNG)
718      ENDIF
719      IF(allocated(REQ_TO_ZONE))THEN
720         DEALLOCATE(REQ_TO_ZONE)
721      ENDIF
722      IF(allocated(REQ_ID))THEN
723         DEALLOCATE(REQ_ID)
724      ENDIF
725      IF(allocated(IO_REQ))THEN
726         DEALLOCATE(IO_REQ)
727      ENDIF
728      IF(associated(KEEP_OOC))THEN
729         NULLIFY(KEEP_OOC)
730      ENDIF
731      IF(associated(STEP_OOC))THEN
732         NULLIFY(STEP_OOC)
733      ENDIF
734      IF(associated(PROCNODE_OOC))THEN
735         NULLIFY(PROCNODE_OOC)
736      ENDIF
737      IF(associated(TOTAL_NB_OOC_NODES))THEN
738         NULLIFY(TOTAL_NB_OOC_NODES)
739      ENDIF
740      IF(associated(SIZE_OF_BLOCK))THEN
741         NULLIFY(SIZE_OF_BLOCK)
742      ENDIF
743      IF(associated(OOC_INODE_SEQUENCE))THEN
744         NULLIFY(OOC_VADDR)
745      ENDIF
746      CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB,
747     &     id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID )
748      DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN
749      CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC)
750      CALL SMUMPS_614(id)
751      IF(id%INFO(1).LT.0)THEN
752         RETURN
753      ENDIF
754      STEP_OOC=>id%STEP
755      PROCNODE_OOC=>id%PROCNODE_STEPS
756      SLAVEF_OOC=id%NSLAVES
757      MYID_OOC=id%MYID
758      KEEP_OOC => id%KEEP
759      SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK
760      OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE
761      OOC_VADDR=>id%OOC_VADDR
762      ALLOCATE(IO_REQ(id%KEEP(28)),
763     &     stat=allocok)
764      IF (allocok .GT. 0) THEN
765         IF (ICNTL1.GT.0)
766     &   WRITE(ICNTL1,*) 'PB allocation in SMUMPS_586'
767         id%INFO(1) = -13
768         id%INFO(2) = id%KEEP(28)
769         RETURN
770      ENDIF
771      SMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35)
772      MAX_NB_NODES_FOR_ZONE=id%OOC_MAX_NB_NODES_FOR_ZONE
773      TOTAL_NB_OOC_NODES=>id%OOC_TOTAL_NB_NODES
774      CALL SMUMPS_711( id%KEEP(204), STRAT_IO_ASYNC,
775     & WITH_BUF, LOW_LEVEL_STRAT_IO)
776      IF(id%KEEP(107).GT.0)THEN
777         SIZE_SOLVE_EMM=max(id%KEEP8(20),
778     &        FACT_AREA_SIZE / 5_8)
779         SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM,
780     &        int((dble(FACT_AREA_SIZE)-
781     &        dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8))
782         SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8)
783         IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN
784            SIZE_SOLVE_EMM=id%KEEP8(20)
785            SIZE_ZONE_SOLVE=int((real(FACT_AREA_SIZE)-
786     &           real(SIZE_SOLVE_EMM))/real(id%KEEP(107)),8)
787            SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8)
788         ENDIF
789      ELSE
790         SIZE_ZONE_SOLVE=FACT_AREA_SIZE
791         SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE
792      ENDIF
793      IF(SIZE_SOLVE_EMM.LT.id%KEEP8(20))THEN
794         IF (ICNTL1.GT.0)
795     &   WRITE(ICNTL1,*)MYID_OOC,': More space needed for
796     & solution step in SMUMPS_586'
797         id%INFO(1) = -11
798         CALL MUMPS_731(id%KEEP8(20), id%INFO(2))
799      ENDIF
800      TMP=MAX_NB_NODES_FOR_ZONE
801      CALL MPI_ALLREDUCE(TMP,MAX_NB_NODES_FOR_ZONE,1,
802     &     MPI_INTEGER,MPI_MAX,id%COMM_NODES, IERR)
803      NB_Z=KEEP_OOC(107)+1
804      ALLOCATE(POS_IN_MEM(MAX_NB_NODES_FOR_ZONE*NB_Z),
805     &     INODE_TO_POS(KEEP_OOC(28)),
806     &     stat=allocok)
807      IF (allocok .GT. 0) THEN
808         IF (ICNTL1.GT.0)
809     &   WRITE(ICNTL1,*) 'PB allocation in SMUMPS_586'
810         id%INFO(1) = -13
811         id%INFO(2) = id%KEEP(28)+(MAX_NB_NODES_FOR_ZONE*NB_Z)
812         RETURN
813      ENDIF
814      ALLOCATE(OOC_STATE_NODE(KEEP_OOC(28)),stat=allocok)
815      IF (allocok .GT. 0) THEN
816         IF (ICNTL1.GT.0)
817     &   WRITE(ICNTL1,*) 'PB allocation in SMUMPS_586'
818         id%INFO(1) = -13
819         id%INFO(2) = id%KEEP(28)
820         RETURN
821      ENDIF
822      OOC_STATE_NODE(1:KEEP_OOC(28))=0
823      INODE_TO_POS=0
824      POS_IN_MEM=0
825      ALLOCATE(LRLUS_SOLVE(NB_Z), LRLU_SOLVE_T(NB_Z),LRLU_SOLVE_B(NB_Z),
826     &     POSFAC_SOLVE(NB_Z),IDEB_SOLVE_Z(NB_Z),
827     &     PDEB_SOLVE_Z(NB_Z),SIZE_SOLVE_Z(NB_Z),
828     &     CURRENT_POS_T(NB_Z),CURRENT_POS_B(NB_Z),
829     &     POS_HOLE_T(NB_Z),POS_HOLE_B(NB_Z),
830     &     stat=allocok)
831      IF (allocok .GT. 0) THEN
832         IF (ICNTL1.GT.0)
833     &   WRITE(ICNTL1,*) 'PB allocation in SMUMPS_586'
834         id%INFO(1) = -13
835         id%INFO(2) = 9*(NB_Z+1)
836         RETURN
837      ENDIF
838      IERR=0
839      CALL MUMPS_GET_MAX_NB_REQ_C(MAX_NB_REQ,IERR)
840      ALLOCATE(SIZE_OF_READ(MAX_NB_REQ),FIRST_POS_IN_READ(MAX_NB_REQ),
841     &     READ_DEST(MAX_NB_REQ),READ_MNG(MAX_NB_REQ),
842     &     REQ_TO_ZONE(MAX_NB_REQ),REQ_ID(MAX_NB_REQ),stat=allocok)
843      SIZE_OF_READ=-9999_8
844      FIRST_POS_IN_READ=-9999
845      READ_DEST=-9999_8
846      READ_MNG=-9999
847      REQ_TO_ZONE=-9999
848      REQ_ID=-9999
849      IF (allocok .GT. 0) THEN
850         IF (ICNTL1.GT.0)
851     &   WRITE(ICNTL1,*) 'PB allocation in SMUMPS_586'
852         id%INFO(1) = -13
853         id%INFO(2) = 6*(NB_Z+1)
854         RETURN
855      ENDIF
856      MIN_SIZE_READ=min(max((1024_8*1024_8)/int(id%KEEP(35),8),
857     &                       SIZE_ZONE_SOLVE/3_8),
858     &                  SIZE_ZONE_SOLVE)
859      TMP_SIZE8=1_8
860      J=1
861      DO I=1,NB_Z-1
862         IDEB_SOLVE_Z(I)=TMP_SIZE8
863         POSFAC_SOLVE(I)=TMP_SIZE8
864         LRLUS_SOLVE(I)=SIZE_ZONE_SOLVE
865         LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE
866         LRLU_SOLVE_B(I)=0_8
867         SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE
868         CURRENT_POS_T(I)=J
869         CURRENT_POS_B(I)=J
870         PDEB_SOLVE_Z(I)=J
871         POS_HOLE_T(I)=J
872         POS_HOLE_B(I)=J
873         J=J+MAX_NB_NODES_FOR_ZONE
874         TMP_SIZE8=TMP_SIZE8+SIZE_ZONE_SOLVE
875      ENDDO
876      IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8
877      PDEB_SOLVE_Z(NB_Z)=J
878      POSFAC_SOLVE(NB_Z)=TMP_SIZE8
879      LRLUS_SOLVE(NB_Z)=SIZE_SOLVE_EMM
880      LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM
881      LRLU_SOLVE_B(NB_Z)=0_8
882      SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM
883      CURRENT_POS_T(NB_Z)=J
884      CURRENT_POS_B(NB_Z)=J
885      POS_HOLE_T(NB_Z)=J
886      POS_HOLE_B(NB_Z)=J
887      IO_REQ=-77777
888      REQ_ACT=0
889      OOC_STATE_NODE(1:KEEP_OOC(28))=NOT_IN_MEM
890      IF(KEEP_OOC(38).NE.0)THEN
891         MASTER_ROOT=MUMPS_275(
892     &                  PROCNODE_OOC(STEP_OOC( KEEP_OOC(38))),
893     &                  SLAVEF_OOC )
894         SPECIAL_ROOT_NODE=KEEP_OOC(38)
895      ELSEIF(KEEP_OOC(20).NE.0)THEN
896         MASTER_ROOT=MUMPS_275(
897     &                  PROCNODE_OOC(STEP_OOC( KEEP_OOC(20))),
898     &                  SLAVEF_OOC )
899         SPECIAL_ROOT_NODE=KEEP_OOC(20)
900      ELSE
901         MASTER_ROOT=-111111
902         SPECIAL_ROOT_NODE=-2222222
903      ENDIF
904      IF ( KEEP_OOC(60).EQ.0 .AND.
905     &     (
906     &     (KEEP_OOC(38).NE.0 .AND.  id%root%yes)
907     &     .OR.
908     &     (KEEP_OOC(20).NE.0 .AND. MYID_OOC.EQ.MASTER_ROOT))
909     &     )
910     &     THEN
911        IS_ROOT_SPECIAL = .TRUE.
912      ELSE
913        IS_ROOT_SPECIAL = .FALSE.
914      ENDIF
915      NB_ZONE_REQ=0
916      SIZE_ZONE_REQ=0_8
917      CURRENT_SOLVE_READ_ZONE=0
918      NB_CALLED=0
919      NB_CALL=0
920      SOLVE_STEP=-9999
921#if defined (NEW_PREF_SCHEME)
922      MAX_PREF_SIZE=(1024*1024*2)/8
923#endif
924      RETURN
925      END SUBROUTINE SMUMPS_586
926      SUBROUTINE SMUMPS_585(A,LA,PTRFAC,NSTEPS,IERR)
927      IMPLICIT NONE
928      INTEGER NSTEPS,IERR
929      INTEGER(8) :: LA
930      REAL A(LA)
931      INTEGER(8) :: PTRFAC(NSTEPS)
932      INTEGER I
933      IERR=0
934      IF(NB_Z.GT.1)THEN
935         IF(STRAT_IO_ASYNC)THEN
936            DO I=1,NB_Z-1
937               CALL SMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR)
938               IF(IERR.LT.0)THEN
939                  RETURN
940               ENDIF
941            ENDDO
942         ELSE
943            CALL SMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR)
944            IF(IERR.LT.0)THEN
945               RETURN
946            ENDIF
947         ENDIF
948      ENDIF
949      RETURN
950      END SUBROUTINE SMUMPS_585
951      SUBROUTINE SMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR)
952      IMPLICIT NONE
953      INTEGER NSTEPS,IERR
954      INTEGER(8) :: LA
955      REAL A(LA)
956      INTEGER(8) :: PTRFAC(NSTEPS)
957      INTEGER ZONE
958      CALL SMUMPS_603(ZONE)
959      IERR=0
960      CALL SMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR)
961      RETURN
962      END SUBROUTINE SMUMPS_594
963      SUBROUTINE SMUMPS_595(DEST,INDICE,SIZE,
964     &     ZONE,PTRFAC,NSTEPS,POS_SEQ,NB_NODES,FLAG,IERR)
965      IMPLICIT NONE
966      INCLUDE 'mpif.h'
967      INTEGER ZONE,NSTEPS,FLAG,POS_SEQ,NB_NODES
968      REAL DEST
969      INTEGER (8) :: INDICE, SIZE, PTRFAC(NSTEPS)
970      INTEGER REQUEST,INODE,IERR
971      INTEGER ADDR_INT1,ADDR_INT2
972      INTEGER TYPE
973      INTEGER SIZE_INT1,SIZE_INT2
974      TYPE=OOC_SOLVE_TYPE_FCT
975      IERR=0
976      INODE=OOC_INODE_SEQUENCE(POS_SEQ,OOC_FCT_TYPE)
977      CALL MUMPS_677(ADDR_INT1,ADDR_INT2,
978     &     OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE))
979      CALL MUMPS_677(SIZE_INT1,SIZE_INT2,
980     &     SIZE)
981      CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO,
982     &     DEST,SIZE_INT1,SIZE_INT2,
983     &     INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR)
984      IF(IERR.LT.0)THEN
985         IF (ICNTL1.GT.0)
986     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
987         RETURN
988      ENDIF
989      IF(STRAT_IO_ASYNC)THEN
990         CALL SMUMPS_597(INODE,SIZE,INDICE,ZONE,
991     &        REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR)
992         IF(IERR.LT.0)THEN
993            RETURN
994         ENDIF
995      ELSE
996         CALL SMUMPS_597(INODE,SIZE,INDICE,ZONE,
997     &        REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR)
998         IF(IERR.LT.0)THEN
999            RETURN
1000         ENDIF
1001         CALL SMUMPS_596(IO_REQ(STEP_OOC(INODE)),
1002     &        PTRFAC,NSTEPS)
1003         REQ_ACT=REQ_ACT-1
1004      ENDIF
1005      END SUBROUTINE SMUMPS_595
1006      SUBROUTINE SMUMPS_596(REQUEST,PTRFAC,
1007     &     NSTEPS)
1008      IMPLICIT NONE
1009      INTEGER NSTEPS,REQUEST
1010      INTEGER (8) :: PTRFAC(NSTEPS)
1011      INTEGER (8) :: LAST, POS_IN_S, J
1012      INTEGER ZONE
1013      INTEGER POS_REQ,I,TMP_NODE,POS_IN_MANAGE
1014      INTEGER (8) SIZE
1015      LOGICAL DONT_USE
1016      EXTERNAL MUMPS_330,MUMPS_275
1017      INTEGER MUMPS_330,MUMPS_275
1018      POS_REQ=mod(REQUEST,MAX_NB_REQ)+1
1019      SIZE=SIZE_OF_READ(POS_REQ)
1020      I=FIRST_POS_IN_READ(POS_REQ)
1021      POS_IN_S=READ_DEST(POS_REQ)
1022      POS_IN_MANAGE=READ_MNG(POS_REQ)
1023      ZONE=REQ_TO_ZONE(POS_REQ)
1024      DONT_USE=.FALSE.
1025      J=0_8
1026      DO WHILE((J.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)))
1027         TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
1028         LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
1029         IF(LAST.EQ.0_8)THEN
1030            I=I+1
1031            CYCLE
1032         ENDIF
1033         IF((INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0).AND.
1034     &        (INODE_TO_POS(STEP_OOC(TMP_NODE)).LT.
1035     &        -((N_OOC+1)*NB_Z)))THEN
1036            DONT_USE=
1037     &           (((MTYPE_OOC.EQ.1).AND.(KEEP_OOC(50).EQ.0).AND.
1038     &           (SOLVE_STEP.EQ.1).AND.
1039     &           ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)),
1040     &           SLAVEF_OOC).EQ.2).AND.(MUMPS_275(
1041     &           PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE.
1042     &           MYID_OOC)))
1043     &           .OR.
1044     &           ((MTYPE_OOC.NE.1).AND.(KEEP_OOC(50).EQ.0).AND.
1045     &           (SOLVE_STEP.EQ.0).AND.
1046     &           ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)),
1047     &           SLAVEF_OOC).EQ.2).AND.(MUMPS_275(
1048     &           PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE.
1049     &           MYID_OOC)))).OR.
1050     &           (OOC_STATE_NODE(STEP_OOC(TMP_NODE)).EQ.ALREADY_USED)
1051            IF(DONT_USE)THEN
1052               PTRFAC(STEP_OOC(TMP_NODE))=-POS_IN_S
1053            ELSE
1054               PTRFAC(STEP_OOC(TMP_NODE))=POS_IN_S
1055            ENDIF
1056            IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).LT.
1057     &           IDEB_SOLVE_Z(ZONE))THEN
1058               WRITE(*,*)MYID_OOC,': Inernal error (42) in OOC ',
1059     &              PTRFAC(STEP_OOC(TMP_NODE)),IDEB_SOLVE_Z(ZONE)
1060               CALL MUMPS_ABORT()
1061            ENDIF
1062            IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).GT.
1063     &           (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN
1064               WRITE(*,*)MYID_OOC,': Inernal error (43) in OOC '
1065               CALL MUMPS_ABORT()
1066            ENDIF
1067            IF(DONT_USE)THEN
1068               POS_IN_MEM(POS_IN_MANAGE)=-TMP_NODE
1069               INODE_TO_POS(STEP_OOC(TMP_NODE))=-POS_IN_MANAGE
1070               IF(OOC_STATE_NODE(STEP_OOC(TMP_NODE)).NE.
1071     &              ALREADY_USED)THEN
1072                  OOC_STATE_NODE(STEP_OOC(TMP_NODE))=USED_NOT_PERMUTED
1073               ENDIF
1074               LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+LAST
1075            ELSE
1076               POS_IN_MEM(POS_IN_MANAGE)=TMP_NODE
1077               INODE_TO_POS(STEP_OOC(TMP_NODE))=POS_IN_MANAGE
1078               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED
1079            ENDIF
1080            IO_REQ(STEP_OOC(TMP_NODE))=-7777
1081         ELSE
1082            POS_IN_MEM(POS_IN_MANAGE)=0
1083         ENDIF
1084         POS_IN_S=POS_IN_S+LAST
1085         POS_IN_MANAGE=POS_IN_MANAGE+1
1086         J=J+LAST
1087         I=I+1
1088      ENDDO
1089      SIZE_OF_READ(POS_REQ)=-9999_8
1090      FIRST_POS_IN_READ(POS_REQ)=-9999
1091      READ_DEST(POS_REQ)=-9999_8
1092      READ_MNG(POS_REQ)=-9999
1093      REQ_TO_ZONE(POS_REQ)=-9999
1094      REQ_ID(POS_REQ)=-9999
1095      RETURN
1096      END SUBROUTINE SMUMPS_596
1097      SUBROUTINE SMUMPS_597(INODE,SIZE,DEST,ZONE,
1098     &     REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR)
1099      IMPLICIT NONE
1100      INTEGER INODE,ZONE,REQUEST,FLAG,POS_SEQ,NB_NODES,NSTEPS
1101      INTEGER(8) :: SIZE
1102      INTEGER(8) :: PTRFAC(NSTEPS)
1103      INTEGER(8) :: DEST, LOCAL_DEST, J8
1104      INTEGER I,TMP_NODE,LOC_I,POS_REQ,NB
1105      INTEGER(8)::LAST
1106      INTEGER, intent(out) :: IERR
1107      IERR=0
1108      IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN
1109         RETURN
1110      ENDIF
1111      NB=0
1112      LOCAL_DEST=DEST
1113      I=POS_SEQ
1114      POS_REQ=mod(REQUEST,MAX_NB_REQ)+1
1115      IF(REQ_ID(POS_REQ).NE.-9999)THEN
1116         CALL MUMPS_WAIT_REQUEST(REQ_ID(POS_REQ),IERR)
1117         IF(IERR.LT.0)THEN
1118            IF (ICNTL1.GT.0)
1119     &      WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
1120            RETURN
1121         ENDIF
1122         CALL SMUMPS_596(REQUEST,PTRFAC,NSTEPS)
1123         REQ_ACT=REQ_ACT-1
1124      ENDIF
1125      SIZE_OF_READ(POS_REQ)=SIZE
1126      FIRST_POS_IN_READ(POS_REQ)=I
1127      READ_DEST(POS_REQ)=DEST
1128      IF(FLAG.EQ.0)THEN
1129         READ_MNG(POS_REQ)=CURRENT_POS_B(ZONE)-NB_NODES+1
1130      ELSEIF(FLAG.EQ.1)THEN
1131         READ_MNG(POS_REQ)=CURRENT_POS_T(ZONE)
1132      ENDIF
1133      REQ_TO_ZONE(POS_REQ)=ZONE
1134      REQ_ID(POS_REQ)=REQUEST
1135      J8=0_8
1136      IF(FLAG.EQ.0)THEN
1137         LOC_I=CURRENT_POS_B(ZONE)-NB_NODES+1
1138      ENDIF
1139      DO WHILE((J8.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)))
1140         TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
1141         LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
1142         IF(LAST.EQ.0_8)THEN
1143            INODE_TO_POS(STEP_OOC(TMP_NODE))=1
1144            OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED
1145            I=I+1
1146            CYCLE
1147         ENDIF
1148         IF((IO_REQ(STEP_OOC(TMP_NODE)).GE.0).OR.
1149     &        (INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0))THEN
1150            IF(FLAG.EQ.1)THEN
1151               POS_IN_MEM(CURRENT_POS_T(ZONE))=0
1152            ELSEIF(FLAG.EQ.0)THEN
1153               POS_IN_MEM(CURRENT_POS_B(ZONE))=0
1154            ENDIF
1155         ELSE
1156            IO_REQ(STEP_OOC(TMP_NODE))=REQUEST
1157            LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-LAST
1158            IF(FLAG.EQ.1)THEN
1159               IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN
1160                  POS_HOLE_B(ZONE)=-9999
1161                  CURRENT_POS_B(ZONE)=-9999
1162                  LRLU_SOLVE_B(ZONE)=0_8
1163               ENDIF
1164               POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+LAST
1165               LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)-LAST
1166               POS_IN_MEM(CURRENT_POS_T(ZONE))=-TMP_NODE-
1167     &              ((N_OOC+1)*NB_Z)
1168               INODE_TO_POS(STEP_OOC(TMP_NODE))=-CURRENT_POS_T(ZONE)-
1169     &              ((N_OOC+1)*NB_Z)
1170               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ
1171               PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST
1172               LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
1173     &              OOC_FCT_TYPE)
1174            ELSEIF(FLAG.EQ.0)THEN
1175               LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)-LAST
1176               POS_IN_MEM(LOC_I)=-TMP_NODE-((N_OOC+1)*NB_Z)
1177               IF(LOC_I.EQ.POS_HOLE_T(ZONE))THEN
1178                  IF(POS_HOLE_T(ZONE).LT.CURRENT_POS_T(ZONE))THEN
1179                     POS_HOLE_T(ZONE)=POS_HOLE_T(ZONE)+1
1180                  ENDIF
1181               ENDIF
1182               INODE_TO_POS(STEP_OOC(TMP_NODE))=-LOC_I-((N_OOC+1)*NB_Z)
1183               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ
1184               PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST
1185               LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
1186     &              OOC_FCT_TYPE)
1187            ELSE
1188             WRITE(*,*)MYID_OOC,': Internal error (39) in OOC ',
1189     &                 ' Invalid Flag Value in ',
1190     &                 ' SMUMPS_597',FLAG
1191               CALL MUMPS_ABORT()
1192            ENDIF
1193         ENDIF
1194         IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).NE.0)THEN
1195            IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).EQ.
1196     &           POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))THEN
1197               IF(CURRENT_POS_T(ZONE).NE.PDEB_SOLVE_Z(ZONE))THEN
1198             WRITE(*,*)MYID_OOC,': Internal error (40) in OOC ',
1199     &                      CURRENT_POS_T(ZONE),
1200     &                 PDEB_SOLVE_Z(ZONE),
1201     &                 POS_IN_MEM(CURRENT_POS_T(ZONE)),
1202     &                 POS_IN_MEM(PDEB_SOLVE_Z(ZONE))
1203                  CALL MUMPS_ABORT()
1204               ENDIF
1205            ENDIF
1206         ENDIF
1207         J8=J8+LAST
1208         IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
1209             WRITE(*,*)MYID_OOC,': Internal error (41) in OOC ',
1210     &           ' LRLUS_SOLVE must be (1) > 0',
1211     &           LRLUS_SOLVE(ZONE)
1212            CALL MUMPS_ABORT()
1213         ENDIF
1214         I=I+1
1215         IF(FLAG.EQ.1)THEN
1216            CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1
1217            IF(CURRENT_POS_T(ZONE).GT.
1218     &           MAX_NB_NODES_FOR_ZONE+PDEB_SOLVE_Z(ZONE))THEN
1219               WRITE(*,*)MYID_OOC,': Internal error (1) in OOC '
1220               CALL MUMPS_ABORT()
1221            ENDIF
1222            POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE)
1223         ELSEIF(FLAG.EQ.0)THEN
1224            IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN
1225               WRITE(*,*)MYID_OOC,': Internal error (2) in OOC ',
1226     &              POS_HOLE_B(ZONE),LOC_I
1227               CALL MUMPS_ABORT()
1228            ENDIF
1229            CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1
1230            POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE)
1231            IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN
1232               POS_HOLE_B(ZONE)=-9999
1233               LRLU_SOLVE_B(ZONE)=0_8
1234            ENDIF
1235         ELSE
1236            WRITE(*,*)MYID_OOC,': Internal error (3) in OOC ',
1237     &       ' Invalid Flag Value in ',
1238     &       ' SMUMPS_597',FLAG
1239            CALL MUMPS_ABORT()
1240         ENDIF
1241         IF(FLAG.EQ.0)THEN
1242            LOC_I=LOC_I+1
1243         ENDIF
1244         NB=NB+1
1245      ENDDO
1246      IF(NB.NE.NB_NODES)THEN
1247         WRITE(*,*)MYID_OOC,': Internal error (4) in OOC ',
1248     &        ' SMUMPS_597 ',NB,NB_NODES
1249      ENDIF
1250      IF(SOLVE_STEP.EQ.0)THEN
1251         CUR_POS_SEQUENCE=I
1252      ELSE
1253         CUR_POS_SEQUENCE=POS_SEQ-1
1254      ENDIF
1255      RETURN
1256      END SUBROUTINE SMUMPS_597
1257      SUBROUTINE SMUMPS_598(INODE,PTRFAC,NSTEPS,A,
1258     &     LA,FLAG,IERR)
1259      IMPLICIT NONE
1260      INTEGER(8) :: LA
1261      INTEGER, intent(out):: IERR
1262      REAL A(LA)
1263      INTEGER INODE,NSTEPS
1264      INTEGER(8) :: PTRFAC(NSTEPS)
1265      LOGICAL FLAG
1266      INTEGER(8) FREE_SIZE
1267      INTEGER TMP,TMP_NODE,I,ZONE,J, FREE_HOLE_FLAG
1268      INTEGER WHICH
1269      INTEGER(8) :: DUMMY_SIZE
1270      DUMMY_SIZE=1_8
1271      IERR = 0
1272      WHICH=-1
1273      IF(INODE_TO_POS(STEP_OOC(INODE)).LE.0)THEN
1274         WRITE(*,*)MYID_OOC,': Internal error (5) in OOC ',
1275     &            ' Problem in SMUMPS_598',
1276     &        INODE, STEP_OOC(INODE), INODE_TO_POS(STEP_OOC(INODE))
1277         CALL MUMPS_ABORT()
1278      ENDIF
1279      IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE).EQ.0_8)THEN
1280         INODE_TO_POS(STEP_OOC(INODE))=0
1281         OOC_STATE_NODE(STEP_OOC(INODE))=ALREADY_USED
1282         RETURN
1283      ENDIF
1284      CALL SMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS)
1285      TMP=INODE_TO_POS(STEP_OOC(INODE))
1286      INODE_TO_POS(STEP_OOC(INODE))=-TMP
1287      POS_IN_MEM(TMP)=-INODE
1288      PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE))
1289      IF (KEEP_OOC(237).eq.0) THEN
1290       IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.PERMUTED)THEN
1291         WRITE(*,*)MYID_OOC,': INTERNAL ERROR (53) in OOC',INODE,
1292     &        OOC_STATE_NODE(STEP_OOC(INODE))
1293         CALL MUMPS_ABORT()
1294       ENDIF
1295      ENDIF
1296      OOC_STATE_NODE(STEP_OOC(INODE))=USED
1297      LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+
1298     &        SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
1299      IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
1300         WRITE(*,*)MYID_OOC,': Internal error (6) in OOC ',
1301     &        ': LRLUS_SOLVE must be (2) > 0'
1302         CALL MUMPS_ABORT()
1303      ENDIF
1304      IF(ZONE.EQ.NB_Z)THEN
1305         IF(INODE.NE.SPECIAL_ROOT_NODE)THEN
1306            CALL SMUMPS_608(A,FACT_AREA_SIZE,
1307     &           DUMMY_SIZE,PTRFAC,KEEP_OOC(28),ZONE,IERR)
1308         ENDIF
1309      ELSE
1310         FREE_HOLE_FLAG=0
1311         IF(SOLVE_STEP.EQ.0)THEN
1312            IF(TMP.GT.POS_HOLE_B(ZONE))THEN
1313               WHICH=0
1314            ELSEIF(TMP.LT.POS_HOLE_T(ZONE))THEN
1315               WHICH=1
1316            ENDIF
1317         ELSEIF(SOLVE_STEP.EQ.1)THEN
1318            IF(TMP.LT.POS_HOLE_T(ZONE))THEN
1319               WHICH=1
1320            ELSEIF(TMP.GT.POS_HOLE_B(ZONE))THEN
1321               WHICH=0
1322            ENDIF
1323         ENDIF
1324         IF(WHICH.EQ.1)THEN
1325            J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE))
1326            J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)
1327            FREE_SIZE=0_8
1328            DO I=J,TMP,-1
1329               IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT.
1330     &              -(N_OOC+1)*NB_Z))THEN
1331                  TMP_NODE=-POS_IN_MEM(I)
1332                  FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
1333     &                 OOC_FCT_TYPE)
1334               ELSEIF(POS_IN_MEM(I).NE.0)THEN
1335                  GOTO 666
1336               ENDIF
1337            ENDDO
1338            POS_HOLE_T(ZONE)=TMP
1339 666        CONTINUE
1340         ELSEIF(WHICH.EQ.0)THEN
1341            J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE))
1342            J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)
1343            FREE_SIZE=0_8
1344            DO I=J,TMP
1345               IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT.
1346     &              -(N_OOC+1)*NB_Z))THEN
1347                  TMP_NODE=-POS_IN_MEM(I)
1348                  FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
1349     &                 OOC_FCT_TYPE)
1350               ELSEIF(POS_IN_MEM(I).NE.0)THEN
1351                  IF(J.EQ.PDEB_SOLVE_Z(ZONE))THEN
1352                     POS_HOLE_B(ZONE)=-9999
1353                     LRLU_SOLVE_B(ZONE)=0_8
1354                     CURRENT_POS_B(ZONE)=-9999
1355                  ENDIF
1356                  GOTO 777
1357               ENDIF
1358            ENDDO
1359            POS_HOLE_B(ZONE)=TMP
1360 777        CONTINUE
1361         ENDIF
1362      IERR=0
1363      ENDIF
1364      IF((NB_Z.GT.1).AND.FLAG)THEN
1365         CALL SMUMPS_601(ZONE)
1366         IF((LRLUS_SOLVE(ZONE).GE.MIN_SIZE_READ).OR.
1367     &        (LRLUS_SOLVE(ZONE).GE.
1368     &        int(0.3E0*real(SIZE_SOLVE_Z(ZONE)),8)))THEN
1369            CALL SMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR)
1370            IF(IERR.LT.0)THEN
1371               RETURN
1372            ENDIF
1373         ELSE
1374            CALL SMUMPS_603(ZONE)
1375         ENDIF
1376      ENDIF
1377      RETURN
1378      END SUBROUTINE SMUMPS_598
1379      FUNCTION SMUMPS_726(INODE,PTRFAC,NSTEPS,A,LA,
1380     &     IERR)
1381      IMPLICIT NONE
1382      INTEGER INODE,NSTEPS
1383      INTEGER(8) :: LA
1384      INTEGER, INTENT(out)::IERR
1385      REAL A(LA)
1386      INTEGER (8) :: PTRFAC(NSTEPS)
1387      INTEGER SMUMPS_726
1388      IERR=0
1389      IF(INODE_TO_POS(STEP_OOC(INODE)).GT.0)THEN
1390         IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN
1391            SMUMPS_726=OOC_NODE_PERMUTED
1392         ELSE
1393            SMUMPS_726=OOC_NODE_NOT_PERMUTED
1394         ENDIF
1395         IF(.NOT.SMUMPS_727())THEN
1396            IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE)
1397     &           .EQ.INODE)THEN
1398               IF(SOLVE_STEP.EQ.0)THEN
1399                  CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
1400               ELSEIF(SOLVE_STEP.EQ.1)THEN
1401                  CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
1402               ENDIF
1403               CALL SMUMPS_728()
1404            ENDIF
1405         ENDIF
1406      ELSEIF(INODE_TO_POS(STEP_OOC(INODE)).LT.0)THEN
1407         IF(INODE_TO_POS(STEP_OOC(INODE)).LT.-((N_OOC+1)*NB_Z))THEN
1408            CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(INODE)),IERR)
1409            IF(IERR.LT.0)THEN
1410               IF (ICNTL1.GT.0)
1411     &         WRITE(ICNTL1,*)MYID_OOC,': Internal error (7) in OOC ',
1412     &                   ERR_STR_OOC(1:DIM_ERR_STR_OOC)
1413               RETURN
1414            ENDIF
1415            CALL SMUMPS_596(IO_REQ(STEP_OOC(INODE)),
1416     &           PTRFAC,NSTEPS)
1417            REQ_ACT=REQ_ACT-1
1418         ELSE
1419            CALL SMUMPS_599(INODE,PTRFAC,NSTEPS)
1420            IF(.NOT.SMUMPS_727())THEN
1421               IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ.
1422     &              INODE)THEN
1423                  IF(SOLVE_STEP.EQ.0)THEN
1424                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
1425                  ELSEIF(SOLVE_STEP.EQ.1)THEN
1426                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
1427                  ENDIF
1428                  CALL SMUMPS_728()
1429               ENDIF
1430            ENDIF
1431         ENDIF
1432         IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN
1433            SMUMPS_726=OOC_NODE_PERMUTED
1434         ELSE
1435            SMUMPS_726=OOC_NODE_NOT_PERMUTED
1436         ENDIF
1437      ELSE
1438         SMUMPS_726=OOC_NODE_NOT_IN_MEM
1439      ENDIF
1440      RETURN
1441      END FUNCTION SMUMPS_726
1442      SUBROUTINE SMUMPS_682(INODE)
1443      IMPLICIT NONE
1444      INTEGER INODE
1445      IF ( (KEEP_OOC(237).EQ.0)
1446     &     .AND. (KEEP_OOC(235).EQ.0) ) THEN
1447       IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.NOT_USED)THEN
1448         WRITE(*,*)MYID_OOC,': INTERNAL ERROR (51) in OOC',INODE,
1449     &        OOC_STATE_NODE(STEP_OOC(INODE))
1450         CALL MUMPS_ABORT()
1451       ENDIF
1452      ENDIF
1453      OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED
1454      END SUBROUTINE SMUMPS_682
1455      SUBROUTINE SMUMPS_599(INODE,PTRFAC,NSTEPS)
1456      IMPLICIT NONE
1457      INTEGER INODE,NSTEPS
1458      INTEGER (8) :: PTRFAC(NSTEPS)
1459      INTEGER ZONE
1460      INODE_TO_POS(STEP_OOC(INODE))=-INODE_TO_POS(STEP_OOC(INODE))
1461      POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE)))=
1462     &     -POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE)))
1463      PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE))
1464      IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED_NOT_PERMUTED)THEN
1465         OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
1466      ELSEIF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED)THEN
1467         OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED
1468      ELSE
1469         WRITE(*,*)MYID_OOC,': Internal error (52) in OOC',INODE,
1470     &        OOC_STATE_NODE(STEP_OOC(INODE)),
1471     &        INODE_TO_POS(STEP_OOC(INODE))
1472         CALL MUMPS_ABORT()
1473      ENDIF
1474      CALL SMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE)
1475      IF(INODE_TO_POS(STEP_OOC(INODE)).LE.POS_HOLE_B(ZONE))THEN
1476         IF(INODE_TO_POS(STEP_OOC(INODE)).GT.
1477     &        PDEB_SOLVE_Z(ZONE))THEN
1478            POS_HOLE_B(ZONE)=
1479     &           INODE_TO_POS(STEP_OOC(INODE))-1
1480         ELSE
1481            CURRENT_POS_B(ZONE)=-9999
1482            POS_HOLE_B(ZONE)=-9999
1483            LRLU_SOLVE_B(ZONE)=0_8
1484         ENDIF
1485      ENDIF
1486      IF(INODE_TO_POS(STEP_OOC(INODE)).GE.POS_HOLE_T(ZONE))THEN
1487         IF(INODE_TO_POS(STEP_OOC(INODE)).LT.
1488     &        CURRENT_POS_T(ZONE)-1)THEN
1489            POS_HOLE_T(ZONE)=INODE_TO_POS(STEP_OOC(INODE))+1
1490         ELSE
1491            POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE)
1492         ENDIF
1493      ENDIF
1494      CALL SMUMPS_609(INODE,PTRFAC,NSTEPS,1)
1495      END SUBROUTINE SMUMPS_599
1496      SUBROUTINE SMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS)
1497      IMPLICIT NONE
1498      INTEGER INODE,ZONE,NSTEPS
1499      INTEGER (8) :: PTRFAC(NSTEPS)
1500      ZONE=1
1501      DO WHILE (ZONE.LE.NB_Z)
1502         IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN
1503            ZONE=ZONE-1
1504            EXIT
1505         ENDIF
1506         ZONE=ZONE+1
1507      ENDDO
1508      IF(ZONE.EQ.NB_Z+1)THEN
1509         ZONE=ZONE-1
1510      ENDIF
1511      END SUBROUTINE SMUMPS_600
1512      SUBROUTINE SMUMPS_601(ZONE)
1513      IMPLICIT NONE
1514      INTEGER ZONE
1515      ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1)+1
1516      END SUBROUTINE SMUMPS_601
1517      SUBROUTINE SMUMPS_603(ZONE)
1518      IMPLICIT NONE
1519      INTEGER ZONE
1520      IF(NB_Z.GT.1)THEN
1521         CURRENT_SOLVE_READ_ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1)
1522         ZONE=CURRENT_SOLVE_READ_ZONE+1
1523      ELSE
1524         ZONE=NB_Z
1525      ENDIF
1526      END SUBROUTINE SMUMPS_603
1527      SUBROUTINE SMUMPS_578(INODE,PTRFAC,
1528     &     KEEP,KEEP8,
1529     &     A,IERR)
1530      IMPLICIT NONE
1531      INTEGER INODE,KEEP(500)
1532      INTEGER, intent(out)::IERR
1533      INTEGER(8) KEEP8(150)
1534      INTEGER(8) :: PTRFAC(KEEP(28))
1535      REAL A(FACT_AREA_SIZE)
1536      INTEGER(8) :: REQUESTED_SIZE
1537      INTEGER ZONE,IFLAG
1538      IERR=0
1539      IFLAG=0
1540      IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
1541     &     .EQ.0_8)THEN
1542         INODE_TO_POS(STEP_OOC(INODE))=1
1543         OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
1544         PTRFAC(STEP_OOC(INODE))=1_8
1545         RETURN
1546      ENDIF
1547      REQUESTED_SIZE=SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
1548      ZONE=NB_Z
1549      IF(CURRENT_POS_T(ZONE).GT.
1550     &     (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1))THEN
1551         CALL SMUMPS_608(A,FACT_AREA_SIZE,
1552     &        REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR)
1553         IF(IERR.LT.0)THEN
1554            RETURN
1555         ENDIF
1556      ENDIF
1557      IF((LRLU_SOLVE_T(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE),
1558     &     OOC_FCT_TYPE)).AND.
1559     &     (CURRENT_POS_T(ZONE).LE.
1560     &     (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN
1561         CALL SMUMPS_606(INODE,PTRFAC,
1562     &        KEEP,KEEP8,A,ZONE)
1563      ELSEIF(LRLU_SOLVE_B(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE),
1564     &        OOC_FCT_TYPE).AND.
1565     &        (CURRENT_POS_B(ZONE).GT.0))THEN
1566         CALL SMUMPS_607(INODE,PTRFAC,
1567     &        KEEP,KEEP8,A,ZONE)
1568      ELSE
1569         IF(SMUMPS_579(INODE,ZONE))THEN
1570            IF(SOLVE_STEP.EQ.0)THEN
1571               CALL SMUMPS_604(A,FACT_AREA_SIZE,
1572     &              REQUESTED_SIZE,PTRFAC,
1573     &              KEEP(28),ZONE,IFLAG,IERR)
1574               IF(IERR.LT.0)THEN
1575                  RETURN
1576               ENDIF
1577               IF(IFLAG.EQ.1)THEN
1578                  CALL SMUMPS_606(INODE,PTRFAC,
1579     &                 KEEP,KEEP8,A,ZONE)
1580               ELSEIF(IFLAG.EQ.0)THEN
1581                  CALL SMUMPS_605(A,FACT_AREA_SIZE,
1582     &                 REQUESTED_SIZE,PTRFAC,
1583     &                 KEEP(28),ZONE,IFLAG,IERR)
1584                  IF(IERR.LT.0)THEN
1585                     RETURN
1586                  ENDIF
1587                  IF(IFLAG.EQ.1)THEN
1588                     CALL SMUMPS_607(INODE,PTRFAC,
1589     &                    KEEP,KEEP8,A,ZONE)
1590                  ENDIF
1591               ENDIF
1592            ELSE
1593               CALL SMUMPS_605(A,FACT_AREA_SIZE,
1594     &              REQUESTED_SIZE,PTRFAC,
1595     &              KEEP(28),ZONE,IFLAG,IERR)
1596               IF(IERR.LT.0)THEN
1597                  RETURN
1598               ENDIF
1599               IF(IFLAG.EQ.1)THEN
1600                  CALL SMUMPS_607(INODE,PTRFAC,
1601     &                 KEEP,KEEP8,A,ZONE)
1602               ELSEIF(IFLAG.EQ.0)THEN
1603                  CALL SMUMPS_604(A,FACT_AREA_SIZE,
1604     &                 REQUESTED_SIZE,PTRFAC,
1605     &                 KEEP(28),ZONE,IFLAG,IERR)
1606                  IF(IERR.LT.0)THEN
1607                     RETURN
1608                  ENDIF
1609                  IF(IFLAG.EQ.1)THEN
1610                     CALL SMUMPS_606(INODE,PTRFAC,
1611     &                    KEEP,KEEP8,A,ZONE)
1612                  ENDIF
1613               ENDIF
1614            ENDIF
1615            IF(IFLAG.EQ.0)THEN
1616               CALL SMUMPS_608(A,FACT_AREA_SIZE,
1617     &              REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR)
1618               IF(IERR.LT.0)THEN
1619                  RETURN
1620               ENDIF
1621               CALL SMUMPS_606(INODE,PTRFAC,
1622     &              KEEP,KEEP8,A,ZONE)
1623            ENDIF
1624         ELSE
1625            WRITE(*,*)MYID_OOC,': Internal error (8) in OOC ',
1626     &                         ' Not enough space for Solve',INODE,
1627     &           SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE),
1628     &           LRLUS_SOLVE(ZONE)
1629            CALL MUMPS_ABORT()
1630         ENDIF
1631      ENDIF
1632      IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
1633         WRITE(*,*)MYID_OOC,': Internal error (9) in OOC ',
1634     &                      ' LRLUS_SOLVE must be (3) > 0'
1635         CALL MUMPS_ABORT()
1636      ENDIF
1637      RETURN
1638      END SUBROUTINE SMUMPS_578
1639      SUBROUTINE SMUMPS_604(A,LA,REQUESTED_SIZE,PTRFAC,
1640     &     NSTEPS,ZONE,FLAG,IERR)
1641      IMPLICIT NONE
1642      INTEGER NSTEPS,ZONE,FLAG
1643      INTEGER(8) :: REQUESTED_SIZE, LA
1644      INTEGER(8) :: PTRFAC(NSTEPS)
1645      INTEGER(8) :: FREE_SIZE, FREE_HOLE, FREE_HOLE_POS
1646      REAL A(LA)
1647      INTEGER I,TMP_NODE,FREE_HOLE_FLAG, J
1648      INTEGER, intent(out)::IERR
1649      IERR=0
1650      FLAG=0
1651      IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE).AND.
1652     &     (.NOT.(CURRENT_POS_T(ZONE)
1653     &     .GT.PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN
1654         GOTO 50
1655      ENDIF
1656      J=max(POS_HOLE_B(ZONE),PDEB_SOLVE_Z(ZONE))
1657      J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)
1658      DO I=POS_HOLE_T(ZONE)-1,J,-1
1659         IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT.
1660     &        -(N_OOC+1)*NB_Z))THEN
1661            TMP_NODE=-POS_IN_MEM(I)
1662         ELSEIF(POS_IN_MEM(I).NE.0)THEN
1663            EXIT
1664         ENDIF
1665      ENDDO
1666      POS_HOLE_T(ZONE)=I+1
1667      IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR.
1668     &     (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR.
1669     &     (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN
1670         CURRENT_POS_B(ZONE)=-9999
1671         POS_HOLE_B(ZONE)=-9999
1672         LRLU_SOLVE_B(ZONE)=0_8
1673         POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE)
1674      ENDIF
1675      FREE_HOLE=0_8
1676      FREE_SIZE=0_8
1677      FREE_HOLE_FLAG=0
1678      FREE_HOLE_POS=POSFAC_SOLVE(ZONE)
1679      DO I=CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),-1
1680         IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT.
1681     &        -(N_OOC+1)*NB_Z))THEN
1682            TMP_NODE=-POS_IN_MEM(I)
1683            IF(FREE_HOLE_FLAG.EQ.1)THEN
1684               FREE_HOLE=FREE_HOLE_POS-
1685     &              (abs(PTRFAC(STEP_OOC(TMP_NODE)))+
1686     &              SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
1687               FREE_HOLE_FLAG=0
1688               FREE_SIZE=FREE_SIZE+FREE_HOLE
1689            ENDIF
1690            FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))
1691            PTRFAC(STEP_OOC(TMP_NODE))=-777777_8
1692            INODE_TO_POS(STEP_OOC(TMP_NODE))=0
1693            OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED
1694            POS_IN_MEM(I)=0
1695            FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
1696     &           OOC_FCT_TYPE)
1697         ELSEIF(POS_IN_MEM(I).EQ.0)THEN
1698            FREE_HOLE_FLAG=1
1699         ELSEIF(POS_IN_MEM(I).NE.0)THEN
1700            WRITE(*,*)MYID_OOC,': Internal error (10) in OOC ',
1701     &            ' SMUMPS_604',
1702     &           CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),I
1703            CALL MUMPS_ABORT()
1704         ENDIF
1705      ENDDO
1706      IF(POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE))THEN
1707         IF(FREE_HOLE_FLAG.EQ.0)THEN
1708            FREE_HOLE_FLAG=1
1709         ENDIF
1710      ENDIF
1711      IF(FREE_HOLE_FLAG.EQ.1)THEN
1712         IF(POS_HOLE_T(ZONE)-1.GT.PDEB_SOLVE_Z(ZONE))THEN
1713            I=POS_HOLE_T(ZONE)-1
1714            TMP_NODE=abs(POS_IN_MEM(I))
1715            IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN
1716               TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z
1717               CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR)
1718               IF(IERR.LT.0)THEN
1719                  WRITE(*,*)MYID_OOC,': Internal error (11) in OOC ',
1720     &                               ERR_STR_OOC(1:DIM_ERR_STR_OOC)
1721                  CALL MUMPS_ABORT()
1722                  RETURN
1723               ENDIF
1724               REQ_ACT=REQ_ACT-1
1725               CALL SMUMPS_596(
1726     &              IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
1727               FREE_HOLE=FREE_HOLE_POS-
1728     &              (abs(PTRFAC(STEP_OOC(TMP_NODE)))+
1729     &              SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
1730            ELSEIF(TMP_NODE.EQ.0)THEN
1731               DO J=I,PDEB_SOLVE_Z(ZONE),-1
1732                  IF(POS_IN_MEM(J).NE.0) EXIT
1733               ENDDO
1734               IF(POS_IN_MEM(J).LT.0)THEN
1735                  WRITE(*,*)MYID_OOC,': Internal error (12) in OOC ',
1736     &                 ' SMUMPS_604'
1737                  CALL MUMPS_ABORT()
1738               ENDIF
1739               IF(J.GE.PDEB_SOLVE_Z(ZONE))THEN
1740                  TMP_NODE=POS_IN_MEM(J)
1741                  FREE_HOLE=FREE_HOLE_POS-
1742     &                 (abs(PTRFAC(STEP_OOC(TMP_NODE)))+
1743     &                 SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
1744               ELSE
1745                  FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE)
1746               ENDIF
1747            ELSEIF(TMP_NODE.LT.0)THEN
1748               WRITE(*,*)MYID_OOC,': Internal error (13) in OOC',
1749     &           ' SMUMPS_604'
1750               CALL MUMPS_ABORT()
1751            ELSE
1752               FREE_HOLE=FREE_HOLE_POS-
1753     &              (abs(PTRFAC(STEP_OOC(TMP_NODE)))+
1754     &              SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
1755            ENDIF
1756         ELSE
1757            FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE)
1758         ENDIF
1759         FREE_SIZE=FREE_SIZE+FREE_HOLE
1760      ENDIF
1761      CURRENT_POS_T(ZONE)=POS_HOLE_T(ZONE)
1762      LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+FREE_SIZE
1763      POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-FREE_SIZE
1764 50   CONTINUE
1765      IF(REQUESTED_SIZE.LE.LRLU_SOLVE_T(ZONE))THEN
1766         FLAG=1
1767      ELSE
1768         FLAG=0
1769      ENDIF
1770      RETURN
1771      END SUBROUTINE SMUMPS_604
1772      SUBROUTINE SMUMPS_605(A,LA,REQUESTED_SIZE,
1773     &     PTRFAC,NSTEPS,ZONE,FLAG,IERR)
1774      IMPLICIT NONE
1775      INTEGER NSTEPS,ZONE,FLAG
1776      INTEGER (8) :: REQUESTED_SIZE
1777      INTEGER (8) :: LA
1778      INTEGER (8) :: PTRFAC(NSTEPS)
1779      REAL A(LA)
1780      INTEGER(8) :: FREE_SIZE, FREE_HOLE_POS, FREE_HOLE
1781      INTEGER I,J,TMP_NODE,FREE_HOLE_FLAG
1782      INTEGER, intent(out) :: IERR
1783      IERR=0
1784      FLAG=0
1785      IF(LRLU_SOLVE_B(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN
1786         GOTO 50
1787      ENDIF
1788      IF(POS_HOLE_B(ZONE).EQ.-9999)THEN
1789         GOTO 50
1790      ENDIF
1791      J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE))
1792      J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)
1793      DO I=POS_HOLE_B(ZONE)+1,J
1794         IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT.
1795     &        -(N_OOC+1)*NB_Z))THEN
1796            TMP_NODE=-POS_IN_MEM(I)
1797            FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
1798     &           OOC_FCT_TYPE)
1799         ELSEIF(POS_IN_MEM(I).NE.0)THEN
1800            EXIT
1801         ENDIF
1802      ENDDO
1803      POS_HOLE_B(ZONE)=I-1
1804      IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR.
1805     &     (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR.
1806     &     (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN
1807         CURRENT_POS_B(ZONE)=-9999
1808         POS_HOLE_B(ZONE)=-9999
1809         LRLU_SOLVE_B(ZONE)=0_8
1810         POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE)
1811      ENDIF
1812      FREE_HOLE=0_8
1813      FREE_SIZE=0_8
1814      FREE_HOLE_FLAG=0
1815      FREE_HOLE_POS=IDEB_SOLVE_Z(ZONE)
1816      IF(POS_HOLE_B(ZONE).EQ.-9999)THEN
1817         GOTO 50
1818      ENDIF
1819      DO I=PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE)
1820         IF((POS_IN_MEM(I).LE.0).AND.(POS_IN_MEM(I).GT.
1821     &        -(N_OOC+1)*NB_Z))THEN
1822            TMP_NODE=-POS_IN_MEM(I)
1823            IF(TMP_NODE.NE.0)THEN
1824               IF(I.EQ.PDEB_SOLVE_Z(ZONE))THEN
1825                  IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE.
1826     &                 IDEB_SOLVE_Z(ZONE))THEN
1827                     FREE_SIZE=FREE_SIZE+abs(PTRFAC(STEP_OOC(TMP_NODE)))
1828     &                    -IDEB_SOLVE_Z(ZONE)
1829                  ENDIF
1830               ENDIF
1831               IF(FREE_HOLE_FLAG.EQ.1)THEN
1832                  FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
1833     &                 FREE_HOLE_POS
1834                  FREE_HOLE_FLAG=0
1835                  FREE_SIZE=FREE_SIZE+FREE_HOLE
1836               ENDIF
1837               FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+
1838     &              SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
1839               PTRFAC(STEP_OOC(TMP_NODE))=-777777_8
1840               INODE_TO_POS(STEP_OOC(TMP_NODE))=0
1841               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED
1842               FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
1843     &              OOC_FCT_TYPE)
1844            ELSE
1845               FREE_HOLE_FLAG=1
1846            ENDIF
1847            POS_IN_MEM(I)=0
1848         ELSEIF(POS_IN_MEM(I).NE.0)THEN
1849            WRITE(*,*)MYID_OOC,': Internal error (14) in OOC ',
1850     &            ' SMUMPS_605',
1851     &           CURRENT_POS_T(ZONE)-1,POS_HOLE_B(ZONE),I,POS_IN_MEM(I)
1852            CALL MUMPS_ABORT()
1853         ENDIF
1854      ENDDO
1855      IF(FREE_HOLE_FLAG.EQ.1)THEN
1856         IF(POS_HOLE_B(ZONE)+1.LT.CURRENT_POS_T(ZONE)-1)THEN
1857            I=POS_HOLE_B(ZONE)+1
1858            TMP_NODE=abs(POS_IN_MEM(I))
1859            IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN
1860               TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z
1861               CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR)
1862               IF(IERR.LT.0)THEN
1863                 WRITE(*,*)MYID_OOC,': Internal error (15) in OOC ',
1864     &                               ERR_STR_OOC(1:DIM_ERR_STR_OOC)
1865                 CALL MUMPS_ABORT()
1866                  RETURN
1867               ENDIF
1868               REQ_ACT=REQ_ACT-1
1869               CALL SMUMPS_596(
1870     &              IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
1871               FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-FREE_HOLE_POS
1872            ELSEIF(TMP_NODE.EQ.0)THEN
1873               DO J=I,CURRENT_POS_T(ZONE)-1
1874                  IF(POS_IN_MEM(J).NE.0) EXIT
1875               ENDDO
1876               IF(POS_IN_MEM(J).LT.0)THEN
1877                  WRITE(*,*)MYID_OOC,': Internal error (16) in OOC ',
1878     &                  ' SMUMPS_605'
1879                  CALL MUMPS_ABORT()
1880               ENDIF
1881               IF(J.LE.CURRENT_POS_T(ZONE)-1)THEN
1882                  TMP_NODE=POS_IN_MEM(J)
1883                  FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
1884     &                 FREE_HOLE_POS
1885               ELSE
1886                  FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS
1887               ENDIF
1888            ELSEIF(TMP_NODE.LT.0)THEN
1889               WRITE(*,*)MYID_OOC,': Internal error (17) in OOC ',
1890     &           ' SMUMPS_605'
1891               CALL MUMPS_ABORT()
1892            ELSE
1893               FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
1894     &              FREE_HOLE_POS
1895            ENDIF
1896         ELSE
1897            FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS
1898         ENDIF
1899         FREE_SIZE=FREE_SIZE+FREE_HOLE
1900      ENDIF
1901      LRLU_SOLVE_B(ZONE)=FREE_SIZE
1902      IF(POS_HOLE_B(ZONE).LT.CURRENT_POS_T(ZONE)-1)THEN
1903         TMP_NODE=POS_IN_MEM(POS_HOLE_B(ZONE)+1)
1904         IF(TMP_NODE.LT.-(N_OOC+1)*NB_Z)THEN
1905            TMP_NODE=abs(TMP_NODE)-(N_OOC+1)*NB_Z
1906            CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR)
1907            IF(IERR.LT.0)THEN
1908               WRITE(*,*)MYID_OOC,': Internal error (18) in OOC ',
1909     &                            ERR_STR_OOC(1:DIM_ERR_STR_OOC)
1910               CALL MUMPS_ABORT()
1911               RETURN
1912            ENDIF
1913            REQ_ACT=REQ_ACT-1
1914            CALL SMUMPS_596(
1915     &           IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
1916         ENDIF
1917         LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)+
1918     &        (abs(PTRFAC(STEP_OOC(abs(TMP_NODE))))-IDEB_SOLVE_Z(ZONE)-
1919     &        LRLU_SOLVE_B(ZONE))
1920      ENDIF
1921      CURRENT_POS_B(ZONE)=POS_HOLE_B(ZONE)
1922 50   CONTINUE
1923      IF((POS_HOLE_B(ZONE).EQ.-9999).AND.
1924     &   (LRLU_SOLVE_B(ZONE).NE.0_8))THEN
1925         WRITE(*,*)MYID_OOC,': Internal error (19) in OOC ',
1926     &             'SMUMPS_605'
1927         CALL MUMPS_ABORT()
1928      ENDIF
1929      IF((REQUESTED_SIZE.LE.LRLU_SOLVE_B(ZONE)).AND.
1930     &     (POS_HOLE_B(ZONE).NE.-9999))THEN
1931         FLAG=1
1932      ELSE
1933         FLAG=0
1934      ENDIF
1935      END SUBROUTINE SMUMPS_605
1936      SUBROUTINE SMUMPS_606(INODE,PTRFAC,
1937     &           KEEP,KEEP8, A,ZONE)
1938      IMPLICIT NONE
1939      INTEGER INODE,KEEP(500)
1940      INTEGER(8) KEEP8(150)
1941      INTEGER(8) :: PTRFAC(KEEP(28))
1942      REAL A(FACT_AREA_SIZE)
1943      INTEGER ZONE
1944      LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)-
1945     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
1946      LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-
1947     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
1948      PTRFAC(STEP_OOC(INODE))=POSFAC_SOLVE(ZONE)
1949      OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
1950      IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN
1951         POS_HOLE_B(ZONE)=-9999
1952         CURRENT_POS_B(ZONE)=-9999
1953         LRLU_SOLVE_B(ZONE)=0_8
1954      ENDIF
1955      IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN
1956         WRITE(*,*)MYID_OOC,': Internal error (20) in OOC ',
1957     &                      ' Problem avec debut (2)',INODE,
1958     &              PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE),ZONE
1959         CALL MUMPS_ABORT()
1960      ENDIF
1961      INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_T(ZONE)
1962      POS_IN_MEM(CURRENT_POS_T(ZONE))=INODE
1963      IF(CURRENT_POS_T(ZONE).GT.(PDEB_SOLVE_Z(ZONE)+
1964     &     MAX_NB_NODES_FOR_ZONE-1))THEN
1965         WRITE(*,*)MYID_OOC,': Internal error (21) in OOC ',
1966     &                      ' Problem with CURRENT_POS_T',
1967     &        CURRENT_POS_T(ZONE),ZONE
1968         CALL MUMPS_ABORT()
1969      ENDIF
1970      CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1
1971      POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE)
1972      POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE)
1973      POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+
1974     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
1975      END SUBROUTINE SMUMPS_606
1976      SUBROUTINE SMUMPS_607(INODE,PTRFAC,
1977     &     KEEP,KEEP8,
1978     &     A,ZONE)
1979      IMPLICIT NONE
1980      INTEGER INODE,KEEP(500)
1981      INTEGER(8) KEEP8(150)
1982      INTEGER(8) :: PTRFAC(KEEP(28))
1983      REAL A(FACT_AREA_SIZE)
1984      INTEGER ZONE
1985      IF(POS_HOLE_B(ZONE).EQ.-9999)THEN
1986         WRITE(*,*)MYID_OOC,': Internal error (22) in OOC ',
1987     &        ' SMUMPS_607'
1988         CALL MUMPS_ABORT()
1989      ENDIF
1990      LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-
1991     &     SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
1992      LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)-
1993     &        SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
1994      PTRFAC(STEP_OOC(INODE))=IDEB_SOLVE_Z(ZONE)+
1995     &     LRLU_SOLVE_B(ZONE)
1996      OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED
1997      IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN
1998         WRITE(*,*)MYID_OOC,': Internal error (23) in OOC ',
1999     &              PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE)
2000         CALL MUMPS_ABORT()
2001      ENDIF
2002      INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_B(ZONE)
2003      IF(CURRENT_POS_B(ZONE).EQ.0)THEN
2004         WRITE(*,*)MYID_OOC,': Internal error (23b) in OOC '
2005         CALL MUMPS_ABORT()
2006      ENDIF
2007      POS_IN_MEM(CURRENT_POS_B(ZONE))=INODE
2008      CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1
2009      POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE)
2010      END SUBROUTINE SMUMPS_607
2011      SUBROUTINE SMUMPS_608(A,LA,REQUESTED_SIZE,PTRFAC,
2012     &     NSTEPS,ZONE,IERR)
2013      IMPLICIT NONE
2014      INTEGER(8) :: LA, REQUESTED_SIZE
2015      INTEGER NSTEPS,ZONE
2016      INTEGER, intent(out) :: IERR
2017      INTEGER(8) :: PTRFAC(NSTEPS)
2018      REAL A(LA)
2019      INTEGER (8) :: APOS_FIRST_FREE,
2020     &               SIZE_HOLE,
2021     &               FREE_HOLE,
2022     &               FREE_HOLE_POS
2023      INTEGER J,I,TMP_NODE, NB_FREE, IPOS_FIRST_FREE
2024      INTEGER(8) :: K8, AREA_POINTER
2025      INTEGER FREE_HOLE_FLAG
2026      IERR=0
2027      IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN
2028         RETURN
2029      ENDIF
2030      AREA_POINTER=IDEB_SOLVE_Z(ZONE)
2031      SIZE_HOLE=0_8
2032      DO I=PDEB_SOLVE_Z(ZONE),CURRENT_POS_T(ZONE)-1
2033         IF((POS_IN_MEM(I).LE.0).AND.
2034     &        (POS_IN_MEM(I).GT.-((N_OOC+1)*NB_Z))) GOTO 666
2035         TMP_NODE=abs(POS_IN_MEM(I))
2036         IF(TMP_NODE.GT.((N_OOC+1)*NB_Z))THEN
2037            TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z)
2038         ENDIF
2039         AREA_POINTER=AREA_POINTER+
2040     &        abs(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
2041      ENDDO
2042 666  CONTINUE
2043      IF((I.EQ.CURRENT_POS_T(ZONE)-1).AND.
2044     &     (PDEB_SOLVE_Z(ZONE).NE.CURRENT_POS_T(ZONE)-1))THEN
2045         IF((POS_IN_MEM(I).GT.0).OR.
2046     &        (POS_IN_MEM(I).LT.-((N_OOC+1)*NB_Z)))THEN
2047            WRITE(*,*)MYID_OOC,': Internal error (25) in OOC ',
2048     &                      ': There are no free blocks ',
2049     &         'in SMUMPS_608',PDEB_SOLVE_Z(ZONE),
2050     &           CURRENT_POS_T(ZONE)
2051            CALL MUMPS_ABORT()
2052         ENDIF
2053      ENDIF
2054      IF(POS_IN_MEM(I).EQ.0)THEN
2055         APOS_FIRST_FREE=AREA_POINTER
2056         FREE_HOLE_POS=AREA_POINTER
2057      ELSE
2058         TMP_NODE=abs(POS_IN_MEM(I))
2059         APOS_FIRST_FREE=abs(PTRFAC(STEP_OOC(TMP_NODE)))
2060      ENDIF
2061      IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).NE.0)THEN
2062         IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).LT.-((N_OOC+1)*NB_Z))THEN
2063            TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))-
2064     &           ((N_OOC+1)*NB_Z)
2065            CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR)
2066            IF(IERR.LT.0)THEN
2067               RETURN
2068            ENDIF
2069            REQ_ACT=REQ_ACT-1
2070            CALL SMUMPS_596(
2071     &           IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
2072         ELSE
2073            TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))
2074         ENDIF
2075         IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE.IDEB_SOLVE_Z(ZONE))THEN
2076            IF((POS_IN_MEM(I).NE.0).OR.(I.EQ.CURRENT_POS_T(ZONE)))THEN
2077               SIZE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
2078     &              IDEB_SOLVE_Z(ZONE)
2079            ENDIF
2080            APOS_FIRST_FREE=IDEB_SOLVE_Z(ZONE)
2081            IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).GT.0)THEN
2082               DO J=PDEB_SOLVE_Z(ZONE),I-1
2083                  TMP_NODE=POS_IN_MEM(J)
2084                  IF(TMP_NODE.LE.0)THEN
2085                     IF(TMP_NODE.LT.-((N_OOC+1)*NB_Z))THEN
2086                        TMP_NODE=abs(POS_IN_MEM(J))-((N_OOC+1)*NB_Z)
2087                        CALL MUMPS_WAIT_REQUEST(
2088     &                       IO_REQ(STEP_OOC(TMP_NODE)),IERR)
2089                        IF(IERR.LT.0)THEN
2090                           RETURN
2091                        ENDIF
2092                        REQ_ACT=REQ_ACT-1
2093                        CALL SMUMPS_596(
2094     &                       IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
2095                        TMP_NODE=POS_IN_MEM(J)
2096                     ELSE
2097                    WRITE(*,*)MYID_OOC,': Internal error (26) in OOC ',
2098     &                      ' SMUMPS_608',TMP_NODE,
2099     &                       J,I-1,(N_OOC+1)*NB_Z
2100                        CALL MUMPS_ABORT()
2101                     ENDIF
2102                  ENDIF
2103                  DO K8=1_8,
2104     &                  SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
2105                     A(APOS_FIRST_FREE+K8-1_8)=
2106     &                    A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8)
2107                  ENDDO
2108                  PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE
2109                  APOS_FIRST_FREE=APOS_FIRST_FREE+
2110     &                 SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
2111               ENDDO
2112            ENDIF
2113         ENDIF
2114      ENDIF
2115      NB_FREE=0
2116      FREE_HOLE=0_8
2117      FREE_HOLE_FLAG=0
2118      DO J=I,CURRENT_POS_T(ZONE)-1
2119         TMP_NODE=abs(POS_IN_MEM(J))
2120         IF(POS_IN_MEM(J).LT.-((N_OOC+1)*NB_Z))THEN
2121            TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z)
2122            CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR)
2123            IF(IERR.LT.0)THEN
2124               RETURN
2125            ENDIF
2126            REQ_ACT=REQ_ACT-1
2127            CALL SMUMPS_596(
2128     &           IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS)
2129            TMP_NODE=abs(POS_IN_MEM(J))
2130         ENDIF
2131         IF(POS_IN_MEM(J).GT.0)THEN
2132            DO K8=1_8,SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
2133               A(APOS_FIRST_FREE+K8-1_8)=
2134     &         A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8)
2135            ENDDO
2136            IF(FREE_HOLE_FLAG.EQ.1)THEN
2137               FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
2138     &              FREE_HOLE_POS
2139               FREE_HOLE_FLAG=0
2140               SIZE_HOLE=SIZE_HOLE+FREE_HOLE
2141            ENDIF
2142            FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+
2143     &           SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
2144            PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE
2145            APOS_FIRST_FREE=APOS_FIRST_FREE+
2146     &           SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
2147         ELSEIF(POS_IN_MEM(J).EQ.0)THEN
2148            FREE_HOLE_FLAG=1
2149            NB_FREE=NB_FREE+1
2150         ELSE
2151            NB_FREE=NB_FREE+1
2152            IF(FREE_HOLE_FLAG.EQ.1)THEN
2153               FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-
2154     &              FREE_HOLE_POS
2155               FREE_HOLE_FLAG=0
2156               SIZE_HOLE=SIZE_HOLE+FREE_HOLE
2157            ENDIF
2158            FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+
2159     &           SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
2160            SIZE_HOLE=SIZE_HOLE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),
2161     &           OOC_FCT_TYPE)
2162            PTRFAC(STEP_OOC(abs(POS_IN_MEM(J))))=-77777_8
2163         ENDIF
2164      ENDDO
2165      IF(FREE_HOLE_FLAG.EQ.1)THEN
2166         FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS
2167         FREE_HOLE_FLAG=0
2168         SIZE_HOLE=SIZE_HOLE+FREE_HOLE
2169      ENDIF
2170      IPOS_FIRST_FREE=I
2171      DO J=I,CURRENT_POS_T(ZONE)-1
2172         IF(POS_IN_MEM(J).LT.0)THEN
2173            TMP_NODE=abs(POS_IN_MEM(J))
2174            INODE_TO_POS(STEP_OOC(TMP_NODE))=0
2175            POS_IN_MEM(J)=0
2176            OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED
2177          ELSEIF(POS_IN_MEM(J).GT.0)THEN
2178             TMP_NODE=abs(POS_IN_MEM(J))
2179             POS_IN_MEM(IPOS_FIRST_FREE)=POS_IN_MEM(J)
2180             INODE_TO_POS(STEP_OOC(TMP_NODE))=IPOS_FIRST_FREE
2181             IPOS_FIRST_FREE=IPOS_FIRST_FREE+1
2182         ENDIF
2183      ENDDO
2184      LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+SIZE_HOLE
2185      POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-SIZE_HOLE
2186      CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)-NB_FREE
2187      POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE)
2188      LRLU_SOLVE_B(ZONE)=0_8
2189      POS_HOLE_B(ZONE)=-9999
2190      CURRENT_POS_B(ZONE)=-9999
2191      LRLU_SOLVE_B(ZONE)=0_8
2192      IF(LRLU_SOLVE_T(ZONE).NE.LRLUS_SOLVE(ZONE))THEN
2193         WRITE(*,*)MYID_OOC,': Internal error (27) in OOC ',
2194     &                 LRLU_SOLVE_T(ZONE),
2195     &                 LRLUS_SOLVE(ZONE)
2196         CALL MUMPS_ABORT()
2197      ENDIF
2198      LRLU_SOLVE_T(ZONE)=LRLUS_SOLVE(ZONE)
2199      IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
2200         WRITE(*,*)MYID_OOC,': Internal error (28) in OOC ',
2201     &                      ' LRLUS_SOLVE must be (4) > 0'
2202         CALL MUMPS_ABORT()
2203      ENDIF
2204      IF(POSFAC_SOLVE(ZONE).LT.IDEB_SOLVE_Z(ZONE))THEN
2205         WRITE(*,*)MYID_OOC,': Internal error (29) in OOC ',
2206     &        POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE)
2207         CALL MUMPS_ABORT()
2208      ENDIF
2209      IF(POSFAC_SOLVE(ZONE).NE.(IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-
2210     &     LRLUS_SOLVE(ZONE)))THEN
2211         WRITE(*,*)MYID_OOC,': Internal error (30) in OOC ',
2212     &                      ' Problem avec debut POSFAC_SOLVE',
2213     &        POSFAC_SOLVE(ZONE),(SIZE_SOLVE_Z(ZONE)-
2214     &     LRLUS_SOLVE(ZONE))+IDEB_SOLVE_Z(ZONE),LRLUS_SOLVE(ZONE)
2215         CALL MUMPS_ABORT()
2216      ENDIF
2217      IF(POSFAC_SOLVE(ZONE).GT.
2218     &     (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN
2219         WRITE(*,*)MYID_OOC,': Internal error (31) in OOC ',
2220     &        POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE)+
2221     &        SIZE_SOLVE_Z(ZONE)-1_8
2222         CALL MUMPS_ABORT()
2223      ENDIF
2224      RETURN
2225      END SUBROUTINE SMUMPS_608
2226      SUBROUTINE SMUMPS_609(INODE,PTRFAC,NSTEPS,FLAG)
2227      IMPLICIT NONE
2228      INTEGER INODE,NSTEPS,FLAG
2229      INTEGER (8) :: PTRFAC(NSTEPS)
2230      INTEGER ZONE
2231      IF((FLAG.LT.0).OR.(FLAG.GT.1))THEN
2232         WRITE(*,*)MYID_OOC,': Internal error (32) in OOC ',
2233     &        ' SMUMPS_609'
2234         CALL MUMPS_ABORT()
2235      ENDIF
2236      CALL SMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE)
2237      IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
2238         WRITE(*,*)MYID_OOC,': Internal error (33) in OOC ',
2239     &        ' LRLUS_SOLVE must be (5) ++ > 0'
2240         CALL MUMPS_ABORT()
2241      ENDIF
2242      IF(FLAG.EQ.0)THEN
2243         LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+
2244     &        SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
2245      ELSE
2246         LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-
2247     &        SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)
2248      ENDIF
2249      IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN
2250         WRITE(*,*)MYID_OOC,': Internal error (34) in OOC ',
2251     &                      ' LRLUS_SOLVE must be (5) > 0'
2252         CALL MUMPS_ABORT()
2253      ENDIF
2254      END SUBROUTINE SMUMPS_609
2255      SUBROUTINE SMUMPS_610(ADDR,ZONE)
2256      IMPLICIT NONE
2257      INTEGER (8) :: ADDR
2258      INTEGER ZONE
2259      INTEGER I
2260      I=1
2261      DO WHILE (I.LE.NB_Z)
2262         IF(ADDR.LT.IDEB_SOLVE_Z(I))THEN
2263            EXIT
2264         ENDIF
2265         I=I+1
2266      ENDDO
2267      ZONE=I-1
2268      END SUBROUTINE SMUMPS_610
2269      FUNCTION SMUMPS_727()
2270      IMPLICIT NONE
2271      LOGICAL SMUMPS_727
2272      SMUMPS_727=.FALSE.
2273      IF(SOLVE_STEP.EQ.0)THEN
2274         IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN
2275            SMUMPS_727=.TRUE.
2276         ENDIF
2277      ELSEIF(SOLVE_STEP.EQ.1)THEN
2278         IF(CUR_POS_SEQUENCE.LT.1)THEN
2279            SMUMPS_727=.TRUE.
2280         ENDIF
2281      ENDIF
2282      RETURN
2283      END FUNCTION SMUMPS_727
2284      SUBROUTINE SMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR)
2285      IMPLICIT NONE
2286      INTEGER NSTEPS,ZONE
2287      INTEGER(8), INTENT(IN) :: LA
2288      INTEGER, intent(out) :: IERR
2289      REAL A(LA)
2290      INTEGER(8) :: PTRFAC(NSTEPS)
2291      INTEGER(8) :: SIZE, DEST
2292      INTEGER(8) :: NEEDED_SIZE
2293      INTEGER FLAG,TMP_FLAG,POS_SEQ,TMP_NODE,
2294     &     NB_NODES
2295      IERR=0
2296      TMP_FLAG=0
2297      FLAG=0
2298      IF(SMUMPS_727())THEN
2299         RETURN
2300      ENDIF
2301      IF(SOLVE_STEP.EQ.0)THEN
2302         IF(CUR_POS_SEQUENCE.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN
2303            TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
2304     &           OOC_FCT_TYPE)
2305            DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT.
2306     &           SIZE_SOLVE_Z(ZONE))
2307               CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
2308               IF(SMUMPS_727())THEN
2309                  RETURN
2310               ENDIF
2311               TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
2312     &              OOC_FCT_TYPE)
2313            ENDDO
2314            CALL SMUMPS_728()
2315            NEEDED_SIZE=max(MIN_SIZE_READ,
2316     &           SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
2317         ELSE
2318            NEEDED_SIZE=MIN_SIZE_READ
2319         ENDIF
2320      ELSEIF(SOLVE_STEP.EQ.1)THEN
2321         IF(CUR_POS_SEQUENCE.GE.1)THEN
2322            TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
2323     &           OOC_FCT_TYPE)
2324            DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT.
2325     &           SIZE_SOLVE_Z(ZONE))
2326               CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
2327               IF(SMUMPS_727())THEN
2328                  RETURN
2329               ENDIF
2330               TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
2331     &              OOC_FCT_TYPE)
2332            ENDDO
2333            CALL SMUMPS_728()
2334            NEEDED_SIZE=max(MIN_SIZE_READ,
2335     &           SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE))
2336         ELSE
2337            NEEDED_SIZE=MIN_SIZE_READ
2338         ENDIF
2339      ENDIF
2340      IF(LRLUS_SOLVE(ZONE).LT.NEEDED_SIZE)THEN
2341         RETURN
2342      ELSEIF((LRLU_SOLVE_T(ZONE).LT.NEEDED_SIZE).AND.
2343     &        (LRLU_SOLVE_B(ZONE).LT.NEEDED_SIZE).AND.
2344     &        (dble(LRLUS_SOLVE(ZONE)).LT.0.3d0*
2345     &         dble(SIZE_SOLVE_Z(ZONE)))) THEN
2346         RETURN
2347      ENDIF
2348      IF((LRLU_SOLVE_T(ZONE).GT.NEEDED_SIZE).AND.(SOLVE_STEP.EQ.0).AND.
2349     &     ((CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1).LT.
2350     &     MAX_NB_NODES_FOR_ZONE))THEN
2351         FLAG=1
2352      ELSE
2353         IF(SOLVE_STEP.EQ.0)THEN
2354            CALL SMUMPS_604(A,FACT_AREA_SIZE,
2355     &           NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR)
2356            IF(IERR.LT.0)THEN
2357               RETURN
2358            ENDIF
2359            FLAG=1
2360            IF(TMP_FLAG.EQ.0)THEN
2361               CALL SMUMPS_605(A,FACT_AREA_SIZE,
2362     &              NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR)
2363               IF(IERR.LT.0)THEN
2364                  RETURN
2365               ENDIF
2366               FLAG=0
2367            ENDIF
2368         ELSE
2369            CALL SMUMPS_605(A,FACT_AREA_SIZE,
2370     &           NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR)
2371            IF(IERR.LT.0)THEN
2372               RETURN
2373            ENDIF
2374            FLAG=0
2375            IF(TMP_FLAG.EQ.0)THEN
2376               CALL SMUMPS_604(A,FACT_AREA_SIZE,
2377     &              NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR)
2378               IF(IERR.LT.0)THEN
2379                  RETURN
2380               ENDIF
2381               FLAG=1
2382            ENDIF
2383         ENDIF
2384         IF(TMP_FLAG.EQ.0)THEN
2385            CALL SMUMPS_608(A,FACT_AREA_SIZE,
2386     &           NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,IERR)
2387            IF(IERR.LT.0)THEN
2388               RETURN
2389            ENDIF
2390            FLAG=1
2391         ENDIF
2392      ENDIF
2393      CALL SMUMPS_602(ZONE,SIZE,DEST,POS_SEQ,
2394     &     NB_NODES,FLAG,PTRFAC,NSTEPS)
2395      IF(SIZE.EQ.0_8)THEN
2396         RETURN
2397      ENDIF
2398      NB_ZONE_REQ=NB_ZONE_REQ+1
2399      SIZE_ZONE_REQ=SIZE_ZONE_REQ+SIZE
2400      REQ_ACT=REQ_ACT+1
2401      CALL SMUMPS_595(A(DEST),DEST,SIZE,ZONE,PTRFAC,NSTEPS,
2402     &     POS_SEQ,NB_NODES,FLAG,IERR)
2403      IF(IERR.LT.0)THEN
2404         RETURN
2405      ENDIF
2406      END SUBROUTINE SMUMPS_611
2407      SUBROUTINE SMUMPS_602(ZONE,SIZE,DEST,POS_SEQ,
2408     &     NB_NODES,FLAG,PTRFAC,NSTEPS)
2409      IMPLICIT NONE
2410      INTEGER(8) :: SIZE, DEST
2411      INTEGER ZONE,FLAG,POS_SEQ,NSTEPS
2412      INTEGER(8) :: PTRFAC(NSTEPS), MAX_SIZE, LAST, J8
2413      INTEGER I,START_NODE,K,MAX_NB,
2414     &     NB_NODES
2415      INTEGER NB_NODES_LOC
2416      LOGICAL ALREADY
2417      IF(SMUMPS_727())THEN
2418         SIZE=0_8
2419         RETURN
2420      ENDIF
2421      IF(FLAG.EQ.0)THEN
2422         MAX_SIZE=LRLU_SOLVE_B(ZONE)
2423         MAX_NB=max(0,CURRENT_POS_B(ZONE)-PDEB_SOLVE_Z(ZONE)+1)
2424      ELSEIF(FLAG.EQ.1)THEN
2425         MAX_SIZE=LRLU_SOLVE_T(ZONE)
2426         MAX_NB=MAX_NB_NODES_FOR_ZONE
2427      ELSE
2428         WRITE(*,*)MYID_OOC,': Internal error (35) in OOC ',
2429     &                      ' Unknown Flag value in ',
2430     &         ' SMUMPS_602',FLAG
2431         CALL MUMPS_ABORT()
2432      ENDIF
2433      CALL SMUMPS_728()
2434      I=CUR_POS_SEQUENCE
2435      START_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
2436      ALREADY=.FALSE.
2437      NB_NODES=0
2438      NB_NODES_LOC=0
2439#if defined (NEW_PREF_SCHEME)
2440      IF(MAX_SIZE.GT.MAX_PREF_SIZE)THEN
2441         MAX_SIZE=MIN(MAX(MAX_PREF_SIZE,
2442     &        SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE)),
2443     &        MAX_SIZE)
2444      ENDIF
2445#endif
2446      IF(ZONE.EQ.NB_Z)THEN
2447         SIZE=SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE)
2448      ELSE
2449         J8=0_8
2450         IF(FLAG.EQ.0)THEN
2451            K=0
2452         ELSEIF(FLAG.EQ.1)THEN
2453            K=CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1
2454         ENDIF
2455         IF(SOLVE_STEP.EQ.0)THEN
2456            I=CUR_POS_SEQUENCE
2457            DO WHILE(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))
2458               IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I,
2459     &              OOC_FCT_TYPE)),
2460     &              OOC_FCT_TYPE)
2461     &              .NE.0_8)THEN
2462                  EXIT
2463               ENDIF
2464               I=I+1
2465            ENDDO
2466            CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))
2467            I=CUR_POS_SEQUENCE
2468            DO WHILE((J8.LE.MAX_SIZE).AND.
2469     &           (I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND.
2470     &           (K.LT.MAX_NB) )
2471               LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I,
2472     &              OOC_FCT_TYPE)),
2473     &              OOC_FCT_TYPE)
2474               IF(LAST.EQ.0_8)THEN
2475                  IF(.NOT.ALREADY)THEN
2476                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
2477                  ENDIF
2478                  I=I+1
2479                  NB_NODES_LOC=NB_NODES_LOC+1
2480                  CYCLE
2481               ENDIF
2482               IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I,
2483     &              OOC_FCT_TYPE)))
2484     &              .NE.0).OR.
2485     &              (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I,
2486     &              OOC_FCT_TYPE))).GE.
2487     &              0))THEN
2488                  IF(.NOT.ALREADY)THEN
2489                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1
2490                     I=I+1
2491                     CYCLE
2492                  ELSE
2493                     EXIT
2494                  ENDIF
2495               ENDIF
2496               ALREADY=.TRUE.
2497               J8=J8+LAST
2498               I=I+1
2499               K=K+1
2500               NB_NODES_LOC=NB_NODES_LOC+1
2501               NB_NODES=NB_NODES+1
2502            ENDDO
2503            IF(J8.GT.MAX_SIZE)THEN
2504               SIZE=J8-LAST
2505               NB_NODES=NB_NODES-1
2506               NB_NODES_LOC=NB_NODES_LOC-1
2507            ELSE
2508               SIZE=J8
2509            ENDIF
2510            DO WHILE (CUR_POS_SEQUENCE+NB_NODES_LOC-1.GE.
2511     &                             CUR_POS_SEQUENCE)
2512               IF(SIZE_OF_BLOCK(STEP_OOC(
2513     &              OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE+NB_NODES-1,
2514     &              OOC_FCT_TYPE)),
2515     &              OOC_FCT_TYPE)
2516     &              .NE.0_8)THEN
2517                  EXIT
2518               ENDIF
2519               NB_NODES_LOC=NB_NODES_LOC-1
2520            ENDDO
2521            POS_SEQ=CUR_POS_SEQUENCE
2522         ELSEIF(SOLVE_STEP.EQ.1)THEN
2523            DO WHILE(I.GE.1)
2524               IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I,
2525     &              OOC_FCT_TYPE)),
2526     &              OOC_FCT_TYPE)
2527     &              .NE.0_8)THEN
2528                  EXIT
2529               ENDIF
2530               I=I-1
2531            ENDDO
2532            CUR_POS_SEQUENCE=max(I,1)
2533            I=CUR_POS_SEQUENCE
2534            DO WHILE((J8.LE.MAX_SIZE).AND.(I.GE.1).AND.
2535     &           (K.LT.MAX_NB))
2536               LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I,
2537     &              OOC_FCT_TYPE)),
2538     &              OOC_FCT_TYPE)
2539               IF(LAST.EQ.0_8)THEN
2540                  IF(.NOT.ALREADY)THEN
2541                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
2542                  ENDIF
2543                  NB_NODES_LOC=NB_NODES_LOC+1
2544                  I=I-1
2545                  CYCLE
2546               ENDIF
2547               IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I,
2548     &              OOC_FCT_TYPE)))
2549     &              .NE.0).OR.
2550     &              (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I,
2551     &              OOC_FCT_TYPE))).GE.
2552     &              0))THEN
2553                  IF(.NOT.ALREADY)THEN
2554                     I=I-1
2555                     CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1
2556                     CYCLE
2557                  ELSE
2558                     EXIT
2559                  ENDIF
2560               ENDIF
2561               ALREADY=.TRUE.
2562               J8=J8+LAST
2563               I=I-1
2564               K=K+1
2565               NB_NODES=NB_NODES+1
2566               NB_NODES_LOC=NB_NODES_LOC+1
2567            ENDDO
2568            IF(J8.GT.MAX_SIZE)THEN
2569               SIZE=J8-LAST
2570               NB_NODES=NB_NODES-1
2571               NB_NODES_LOC=NB_NODES_LOC-1
2572            ELSE
2573               SIZE=J8
2574            ENDIF
2575            I=CUR_POS_SEQUENCE-NB_NODES_LOC+1
2576            DO WHILE (I.LE.CUR_POS_SEQUENCE)
2577               IF(SIZE_OF_BLOCK(STEP_OOC(
2578     &              OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)),
2579     &              OOC_FCT_TYPE).NE.0_8)THEN
2580                  EXIT
2581               ENDIF
2582               I=I+1
2583               NB_NODES_LOC=NB_NODES_LOC-1
2584            ENDDO
2585            POS_SEQ=CUR_POS_SEQUENCE-NB_NODES_LOC+1
2586         ENDIF
2587      ENDIF
2588      IF(FLAG.EQ.0)THEN
2589         DEST=IDEB_SOLVE_Z(ZONE)+LRLU_SOLVE_B(ZONE)-SIZE
2590      ELSE
2591         DEST=POSFAC_SOLVE(ZONE)
2592      ENDIF
2593      END SUBROUTINE SMUMPS_602
2594      SUBROUTINE SMUMPS_582(IERR)
2595      IMPLICIT NONE
2596      INTEGER SOLVE_OR_FACTO
2597      INTEGER, intent(out) :: IERR
2598      IERR=0
2599      IF(allocated(LRLUS_SOLVE))THEN
2600         DEALLOCATE(LRLUS_SOLVE)
2601      ENDIF
2602      IF(allocated(LRLU_SOLVE_T))THEN
2603         DEALLOCATE(LRLU_SOLVE_T)
2604      ENDIF
2605      IF(allocated(LRLU_SOLVE_B))THEN
2606         DEALLOCATE(LRLU_SOLVE_B)
2607      ENDIF
2608      IF(allocated(POSFAC_SOLVE))THEN
2609         DEALLOCATE(POSFAC_SOLVE)
2610      ENDIF
2611      IF(allocated(IDEB_SOLVE_Z))THEN
2612         DEALLOCATE(IDEB_SOLVE_Z)
2613      ENDIF
2614      IF(allocated(PDEB_SOLVE_Z))THEN
2615         DEALLOCATE(PDEB_SOLVE_Z)
2616      ENDIF
2617      IF(allocated(SIZE_SOLVE_Z))THEN
2618         DEALLOCATE(SIZE_SOLVE_Z)
2619      ENDIF
2620      IF(allocated(CURRENT_POS_T))THEN
2621         DEALLOCATE(CURRENT_POS_T)
2622      ENDIF
2623      IF(allocated(CURRENT_POS_B))THEN
2624         DEALLOCATE(CURRENT_POS_B)
2625      ENDIF
2626      IF(allocated(POS_HOLE_T))THEN
2627         DEALLOCATE(POS_HOLE_T)
2628      ENDIF
2629      IF(allocated(POS_HOLE_B))THEN
2630         DEALLOCATE(POS_HOLE_B)
2631      ENDIF
2632      IF(allocated(OOC_STATE_NODE))THEN
2633         DEALLOCATE(OOC_STATE_NODE)
2634      ENDIF
2635      IF(allocated(POS_IN_MEM))THEN
2636         DEALLOCATE(POS_IN_MEM)
2637      ENDIF
2638      IF(allocated(INODE_TO_POS))THEN
2639         DEALLOCATE(INODE_TO_POS)
2640      ENDIF
2641      IF(allocated(IO_REQ))THEN
2642         DEALLOCATE(IO_REQ)
2643      ENDIF
2644      IF(allocated(SIZE_OF_READ))THEN
2645         DEALLOCATE(SIZE_OF_READ)
2646      ENDIF
2647      IF(allocated(FIRST_POS_IN_READ))THEN
2648         DEALLOCATE(FIRST_POS_IN_READ)
2649      ENDIF
2650      IF(allocated(READ_DEST))THEN
2651         DEALLOCATE(READ_DEST)
2652      ENDIF
2653      IF(allocated(READ_MNG))THEN
2654         DEALLOCATE(READ_MNG)
2655      ENDIF
2656      IF(allocated(REQ_TO_ZONE))THEN
2657         DEALLOCATE(REQ_TO_ZONE)
2658      ENDIF
2659      IF(allocated(REQ_ID))THEN
2660         DEALLOCATE(REQ_ID)
2661      ENDIF
2662      SOLVE_OR_FACTO=1
2663      CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR)
2664      IF(IERR.LT.0)THEN
2665         IF (ICNTL1.GT.0)
2666     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
2667         RETURN
2668      ENDIF
2669      END SUBROUTINE SMUMPS_582
2670      SUBROUTINE SMUMPS_612(PTRFAC,NSTEPS,
2671     &            A,LA)
2672      IMPLICIT NONE
2673      INTEGER, INTENT(in)       :: NSTEPS
2674      INTEGER(8), INTENT(INOUT) :: PTRFAC(NSTEPS)
2675      INTEGER(8), INTENT(IN)    :: LA
2676      REAL                   :: A(LA)
2677      INTEGER    :: I, TMP, ZONE, IPAS, IBEG, IEND
2678      INTEGER(8) :: SAVE_PTR
2679      LOGICAL    :: COMPRESS_TO_BE_DONE, SET_POS_SEQUENCE
2680      INTEGER    :: J, IERR
2681      INTEGER(8) :: DUMMY_SIZE
2682      COMPRESS_TO_BE_DONE         = .FALSE.
2683      DUMMY_SIZE                  = 1_8
2684      IERR                        = 0
2685      SET_POS_SEQUENCE            = .TRUE.
2686      IF(SOLVE_STEP.EQ.0)THEN
2687        IBEG = 1
2688        IEND = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)
2689        IPAS = 1
2690      ELSE
2691        IBEG = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)
2692        IEND = 1
2693        IPAS = -1
2694      ENDIF
2695      DO I=IBEG,IEND,IPAS
2696            J = OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
2697            TMP=INODE_TO_POS(STEP_OOC(J))
2698            IF(TMP.EQ.0)THEN
2699               IF (SET_POS_SEQUENCE) THEN
2700                 SET_POS_SEQUENCE = .FALSE.
2701                 CUR_POS_SEQUENCE = I
2702               ENDIF
2703               IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN
2704                 OOC_STATE_NODE(STEP_OOC(J)) = NOT_IN_MEM
2705               ENDIF
2706               CYCLE
2707            ELSE IF(TMP.LT.0)THEN
2708               IF(TMP.GT.-(N_OOC+1)*NB_Z)THEN
2709                  SAVE_PTR=PTRFAC(STEP_OOC(J))
2710                  PTRFAC(STEP_OOC(J)) = abs(SAVE_PTR)
2711                  CALL SMUMPS_600(J,
2712     &                 ZONE,PTRFAC,NSTEPS)
2713                  PTRFAC(STEP_OOC(J)) = SAVE_PTR
2714                  IF(ZONE.EQ.NB_Z)THEN
2715                     IF(J.NE.SPECIAL_ROOT_NODE)THEN
2716                        WRITE(*,*)MYID_OOC,': Internal error 6 ',
2717     &                       ' Node ', J,
2718     &                       ' is in status USED in the
2719     &                        emmergency buffer '
2720                        CALL MUMPS_ABORT()
2721                     ENDIF
2722                  ENDIF
2723                 IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0)
2724     &              THEN
2725                  IF (OOC_STATE_NODE(STEP_OOC(J)).EQ.NOT_IN_MEM) THEN
2726                     OOC_STATE_NODE(STEP_OOC(J)) = USED
2727                     IF((SOLVE_STEP.NE.0).OR.(J.NE.SPECIAL_ROOT_NODE)
2728     &                    .OR.(ZONE.NE.NB_Z))THEN
2729                        CALL SMUMPS_599(J,PTRFAC,NSTEPS)
2730                     ENDIF
2731                     CYCLE
2732                  ELSEIF(OOC_STATE_NODE(STEP_OOC(J)).EQ.ALREADY_USED)
2733     &                    THEN
2734                    COMPRESS_TO_BE_DONE         = .TRUE.
2735                  ELSE
2736                    WRITE(*,*)MYID_OOC,': Internal error Mila 4 ',
2737     &              ' wrong node status :', OOC_STATE_NODE(STEP_OOC(J)),
2738     &              ' on node ', J
2739                    CALL MUMPS_ABORT()
2740                  ENDIF
2741                 ENDIF
2742                 IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN
2743                    CALL SMUMPS_599(J,PTRFAC,NSTEPS)
2744                 ENDIF
2745               ENDIF
2746            ENDIF
2747      ENDDO
2748         IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0)
2749     &      THEN
2750           IF (COMPRESS_TO_BE_DONE) THEN
2751             DO ZONE=1,NB_Z-1
2752               CALL SMUMPS_608(A,LA,
2753     &         DUMMY_SIZE,PTRFAC,
2754     &         NSTEPS,ZONE,IERR)
2755               IF (IERR .LT. 0) THEN
2756                    WRITE(*,*)MYID_OOC,': Internal error Mila 5 ',
2757     &              ' IERR on return to SMUMPS_608 =',
2758     &              IERR
2759                    CALL MUMPS_ABORT()
2760               ENDIF
2761             ENDDO
2762           ENDIF
2763         ENDIF
2764      RETURN
2765      END SUBROUTINE SMUMPS_612
2766      SUBROUTINE SMUMPS_583(PTRFAC,NSTEPS,MTYPE,
2767     &                                    A,LA,DOPREFETCH,IERR)
2768      IMPLICIT NONE
2769      INTEGER NSTEPS,MTYPE
2770      INTEGER, intent(out)::IERR
2771      INTEGER(8) :: LA
2772      REAL A(LA)
2773      INTEGER(8) :: PTRFAC(NSTEPS)
2774      LOGICAL DOPREFETCH
2775      INTEGER MUMPS_808
2776      EXTERNAL MUMPS_808
2777      IERR = 0
2778      OOC_FCT_TYPE=MUMPS_808("F",MTYPE,KEEP_OOC(201),
2779     &                                    KEEP_OOC(50))
2780      OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1
2781      IF (KEEP_OOC(201).NE.1) THEN
2782        OOC_SOLVE_TYPE_FCT = FCT
2783      ENDIF
2784      SOLVE_STEP=0
2785      CUR_POS_SEQUENCE=1
2786      MTYPE_OOC=MTYPE
2787      IF ( KEEP_OOC(201).NE.1
2788#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT)
2789     &  .OR. KEEP_OOC(50).NE.0
2790#endif
2791     &  ) THEN
2792        CALL SMUMPS_612(PTRFAC,NSTEPS,A,LA)
2793      ELSE
2794        CALL SMUMPS_683(KEEP_OOC(28),
2795     &              KEEP_OOC(38), KEEP_OOC(20) )
2796      ENDIF
2797      IF (DOPREFETCH) THEN
2798          CALL SMUMPS_585(A,LA,PTRFAC,
2799     &                                 KEEP_OOC(28),IERR)
2800      ELSE
2801          CUR_POS_SEQUENCE = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)
2802      ENDIF
2803      RETURN
2804      END SUBROUTINE SMUMPS_583
2805      SUBROUTINE SMUMPS_584(PTRFAC,NSTEPS,MTYPE,
2806     &           I_WORKED_ON_ROOT,IROOT,A,LA,IERR)
2807      IMPLICIT NONE
2808      INTEGER NSTEPS
2809      INTEGER(8) :: LA
2810      INTEGER(8) :: PTRFAC(NSTEPS)
2811      INTEGER MTYPE
2812      INTEGER IROOT
2813      LOGICAL I_WORKED_ON_ROOT
2814      INTEGER, intent(out):: IERR
2815      REAL A(LA)
2816      INTEGER(8) :: DUMMY_SIZE
2817      INTEGER ZONE
2818      INTEGER MUMPS_808
2819      EXTERNAL MUMPS_808
2820      IERR=0
2821      OOC_FCT_TYPE=MUMPS_808("B",MTYPE,KEEP_OOC(201),
2822     &                                    KEEP_OOC(50))
2823      OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1
2824      IF (KEEP_OOC(201).NE.1) OOC_SOLVE_TYPE_FCT=FCT
2825      SOLVE_STEP=1
2826      CUR_POS_SEQUENCE=TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)
2827      MTYPE_OOC=MTYPE
2828      IF ( KEEP_OOC(201).NE.1
2829#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT)
2830     &  .OR. KEEP_OOC(50).NE.0
2831#endif
2832     &  ) THEN
2833        CALL SMUMPS_612(PTRFAC,NSTEPS,A,LA)
2834        IF (I_WORKED_ON_ROOT) THEN
2835          CALL SMUMPS_598 ( IROOT,
2836     &         PTRFAC, KEEP_OOC(28), A, LA,.FALSE.,IERR)
2837          IF (IERR .LT. 0) RETURN
2838          CALL SMUMPS_600(IROOT,
2839     &         ZONE,PTRFAC,NSTEPS)
2840          IF(IROOT.EQ.NB_Z)THEN
2841             DUMMY_SIZE=1_8
2842             CALL SMUMPS_608(A,LA,
2843     &            DUMMY_SIZE,PTRFAC,
2844     &            NSTEPS,NB_Z,IERR)
2845             IF (IERR .LT. 0) THEN
2846                WRITE(*,*)MYID_OOC,': Internal error in
2847     &               SMUMPS_608',
2848     &               IERR
2849                CALL MUMPS_ABORT()
2850             ENDIF
2851          ENDIF
2852        ENDIF
2853        IF (NB_Z.GT.1) THEN
2854          CALL SMUMPS_594(A,LA,PTRFAC,
2855     &                                  KEEP_OOC(28),IERR)
2856          IF (IERR .LT. 0) RETURN
2857        ENDIF
2858      ELSE
2859        CALL SMUMPS_683(KEEP_OOC(28),
2860     &              KEEP_OOC(38), KEEP_OOC(20) )
2861        CALL SMUMPS_585(A,LA,PTRFAC,KEEP_OOC(28),IERR)
2862        IF (IERR .LT. 0 ) RETURN
2863      ENDIF
2864      RETURN
2865      END SUBROUTINE SMUMPS_584
2866      SUBROUTINE SMUMPS_613(id,IERR)
2867      USE SMUMPS_STRUC_DEF
2868      IMPLICIT NONE
2869      TYPE(SMUMPS_STRUC), TARGET :: id
2870      INTEGER, intent(out) :: IERR
2871      INTEGER I,DIM,J,TMP,SIZE,K,I1
2872      CHARACTER*1 TMP_NAME(350)
2873      EXTERNAL MUMPS_OOC_GET_NB_FILES_C, MUMPS_OOC_GET_FILE_NAME_C
2874      IERR=0
2875      SIZE=0
2876      DO J=1,OOC_NB_FILE_TYPE
2877         TMP=J-1
2878         CALL MUMPS_OOC_GET_NB_FILES_C(TMP,I)
2879         id%OOC_NB_FILES(J)=I
2880         SIZE=SIZE+I
2881      ENDDO
2882      IF(associated(id%OOC_FILE_NAMES))THEN
2883         DEALLOCATE(id%OOC_FILE_NAMES)
2884         NULLIFY(id%OOC_FILE_NAMES)
2885      ENDIF
2886      ALLOCATE(id%OOC_FILE_NAMES(SIZE,350),stat=IERR)
2887      IF (IERR .GT. 0) THEN
2888         IF (ICNTL1.GT.0)
2889     &   WRITE(ICNTL1,*) 'PB allocation in SMUMPS_613'
2890         IERR=-1
2891         IF(id%INFO(1).GE.0)THEN
2892            id%INFO(1) = -13
2893            id%INFO(2) = SIZE*350
2894            RETURN
2895         ENDIF
2896      ENDIF
2897      IF(associated(id%OOC_FILE_NAME_LENGTH))THEN
2898         DEALLOCATE(id%OOC_FILE_NAME_LENGTH)
2899         NULLIFY(id%OOC_FILE_NAME_LENGTH)
2900      ENDIF
2901      ALLOCATE(id%OOC_FILE_NAME_LENGTH(SIZE),stat=IERR)
2902      IF (IERR .GT. 0) THEN
2903         IERR=-1
2904         IF(id%INFO(1).GE.0)THEN
2905            IF (ICNTL1.GT.0)
2906     &      WRITE(ICNTL1,*)
2907     &      'PB allocation in SMUMPS_613'
2908            id%INFO(1) = -13
2909            id%INFO(2) = SIZE
2910            RETURN
2911         ENDIF
2912      ENDIF
2913      K=1
2914      DO I1=1,OOC_NB_FILE_TYPE
2915         TMP=I1-1
2916         DO I=1,id%OOC_NB_FILES(I1)
2917            CALL MUMPS_OOC_GET_FILE_NAME_C(TMP,I,DIM,TMP_NAME(1))
2918            DO J=1,DIM+1
2919               id%OOC_FILE_NAMES(K,J)=TMP_NAME(J)
2920            ENDDO
2921            id%OOC_FILE_NAME_LENGTH(K)=DIM+1
2922            K=K+1
2923         ENDDO
2924      ENDDO
2925      END SUBROUTINE SMUMPS_613
2926      SUBROUTINE SMUMPS_614(id)
2927      USE SMUMPS_STRUC_DEF
2928      IMPLICIT NONE
2929      TYPE(SMUMPS_STRUC), TARGET :: id
2930      CHARACTER*1 TMP_NAME(350)
2931      INTEGER I,I1,TMP,J,K,L,DIM,IERR
2932      INTEGER, DIMENSION(:),ALLOCATABLE :: NB_FILES
2933      INTEGER K211
2934      ALLOCATE(NB_FILES(OOC_NB_FILE_TYPE),stat=IERR)
2935      IF (IERR .GT. 0) THEN
2936         IERR=-1
2937         IF(id%INFO(1).GE.0)THEN
2938            IF (ICNTL1.GT.0)
2939     &      WRITE(ICNTL1,*)
2940     &      'PB allocation in SMUMPS_614'
2941            id%INFO(1) = -13
2942            id%INFO(2) = OOC_NB_FILE_TYPE
2943            RETURN
2944         ENDIF
2945      ENDIF
2946      IERR=0
2947      NB_FILES=id%OOC_NB_FILES
2948      I=id%MYID
2949      K=id%KEEP(35)
2950      L=mod(id%KEEP(204),3)
2951      K211=id%KEEP(211)
2952      CALL MUMPS_OOC_ALLOC_POINTERS_C(OOC_NB_FILE_TYPE,NB_FILES,IERR)
2953      IF(IERR.LT.0)THEN
2954         IF (ICNTL1.GT.0)
2955     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
2956         id%INFO(1)=IERR
2957         RETURN
2958      ENDIF
2959      CALL MUMPS_OOC_INIT_VARS_C(I,K,L,K211,IERR)
2960      IF(IERR.LT.0)THEN
2961         IF (ICNTL1.GT.0)
2962     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
2963         id%INFO(1)=IERR
2964         RETURN
2965      ENDIF
2966      K=1
2967      DO I1=1,OOC_NB_FILE_TYPE
2968         DO I=1,NB_FILES(I1)
2969            DIM=id%OOC_FILE_NAME_LENGTH(K)
2970            DO J=1,DIM
2971               TMP_NAME(J)=id%OOC_FILE_NAMES(K,J)
2972            ENDDO
2973            TMP=I1-1
2974            CALL MUMPS_OOC_SET_FILE_NAME_C(TMP,I,DIM,IERR,TMP_NAME(1))
2975            IF(IERR.LT.0)THEN
2976               IF (ICNTL1.GT.0)
2977     &         WRITE(ICNTL1,*)MYID_OOC,': ',
2978     &         ERR_STR_OOC(1:DIM_ERR_STR_OOC)
2979               id%INFO(1)=IERR
2980               RETURN
2981            ENDIF
2982            K=K+1
2983         ENDDO
2984      ENDDO
2985      CALL MUMPS_OOC_START_LOW_LEVEL(IERR)
2986      IF(IERR.LT.0)THEN
2987         IF (ICNTL1.GT.0)
2988     &   WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC)
2989         id%INFO(1)=IERR
2990         RETURN
2991      ENDIF
2992      DEALLOCATE(NB_FILES)
2993      RETURN
2994      END SUBROUTINE SMUMPS_614
2995      SUBROUTINE SMUMPS_589(DEST,SRC,NB,NB_EFF)
2996      IMPLICIT NONE
2997      INTEGER NB, NB_EFF
2998      CHARACTER(LEN=NB) SRC
2999      CHARACTER*1 DEST(NB)
3000      INTEGER I
3001      DO I=1,NB_EFF
3002         DEST(I)=SRC(I:I)
3003      ENDDO
3004      END SUBROUTINE SMUMPS_589
3005      SUBROUTINE SMUMPS_580(IERR)
3006      USE SMUMPS_OOC_BUFFER
3007      IMPLICIT NONE
3008      INTEGER, intent(out) :: IERR
3009      IERR=0
3010      IF(.NOT.WITH_BUF)THEN
3011         RETURN
3012      ENDIF
3013      CALL SMUMPS_707(OOC_FCT_TYPE,IERR)
3014      IF (IERR < 0) THEN
3015        RETURN
3016      ENDIF
3017      RETURN
3018      END SUBROUTINE SMUMPS_580
3019      SUBROUTINE SMUMPS_681(IERR)
3020      USE SMUMPS_OOC_BUFFER
3021      IMPLICIT NONE
3022      INTEGER, intent(out) :: IERR
3023      INTEGER I
3024      IERR=0
3025      IF(.NOT.WITH_BUF)THEN
3026         RETURN
3027      ENDIF
3028      DO I=1,OOC_NB_FILE_TYPE
3029         CALL SMUMPS_707(I,IERR)
3030         IF (IERR < 0) RETURN
3031      ENDDO
3032      RETURN
3033      END SUBROUTINE SMUMPS_681
3034       SUBROUTINE SMUMPS_683(NSTEPS,
3035     &     KEEP38, KEEP20)
3036      IMPLICIT NONE
3037      INTEGER NSTEPS
3038      INTEGER I, J
3039      INTEGER(8) :: TMP_SIZE8
3040      INTEGER KEEP38, KEEP20
3041      INODE_TO_POS = 0
3042      POS_IN_MEM   = 0
3043      OOC_STATE_NODE(1:NSTEPS)=0
3044      TMP_SIZE8=1_8
3045      J=1
3046      DO I=1,NB_Z-1
3047         IDEB_SOLVE_Z(I)=TMP_SIZE8
3048         PDEB_SOLVE_Z(I)=J
3049         POSFAC_SOLVE(I)=TMP_SIZE8
3050         LRLUS_SOLVE(I) =SIZE_ZONE_SOLVE
3051         LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE
3052         LRLU_SOLVE_B(I)=0_8
3053         SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE
3054         CURRENT_POS_T(I)=J
3055         CURRENT_POS_B(I)=J
3056         POS_HOLE_T(I)   =J
3057         POS_HOLE_B(I)   =J
3058         J = J + MAX_NB_NODES_FOR_ZONE
3059         TMP_SIZE8 = TMP_SIZE8 + SIZE_ZONE_SOLVE
3060      ENDDO
3061      IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8
3062      PDEB_SOLVE_Z(NB_Z)=J
3063      POSFAC_SOLVE(NB_Z)=TMP_SIZE8
3064      LRLUS_SOLVE(NB_Z) =SIZE_SOLVE_EMM
3065      LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM
3066      LRLU_SOLVE_B(NB_Z)=0_8
3067      SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM
3068      CURRENT_POS_T(NB_Z)=J
3069      CURRENT_POS_B(NB_Z)=J
3070      POS_HOLE_T(NB_Z)   =J
3071      POS_HOLE_B(NB_Z)   =J
3072      IO_REQ=-77777
3073      SIZE_OF_READ=-9999_8
3074      FIRST_POS_IN_READ=-9999
3075      READ_DEST=-9999_8
3076      READ_MNG=-9999
3077      REQ_TO_ZONE=-9999
3078      REQ_ID=-9999
3079      RETURN
3080      END SUBROUTINE SMUMPS_683
3081      SUBROUTINE SMUMPS_688
3082     &     ( STRAT, TYPEFile,
3083     &     AFAC, LAFAC, MonBloc,
3084     &     LNextPiv2beWritten, UNextPiv2beWritten,
3085     &     IW, LIWFAC,
3086     &     MYID, FILESIZE, IERR , LAST_CALL)
3087      IMPLICIT NONE
3088      TYPE(IO_BLOCK), INTENT(INOUT):: MonBloc
3089      INTEGER(8) :: LAFAC
3090      INTEGER,        INTENT(IN)   :: STRAT, LIWFAC,
3091     &     MYID, TYPEFile
3092      INTEGER,   INTENT(INOUT)        :: IW(0:LIWFAC-1)
3093      REAL, INTENT(IN) :: AFAC(LAFAC)
3094      INTEGER,   INTENT(INOUT) :: LNextPiv2beWritten,
3095     &     UNextPiv2beWritten
3096      INTEGER(8), INTENT(INOUT) :: FILESIZE
3097      INTEGER,   INTENT(OUT) :: IERR
3098      LOGICAL,   INTENT(IN)  :: LAST_CALL
3099      INTEGER(8) :: TMPSIZE_OF_BLOCK
3100      INTEGER :: TempFTYPE
3101      LOGICAL WRITE_L, WRITE_U
3102      LOGICAL DO_U_FIRST
3103      INCLUDE 'mumps_headers.h'
3104      IERR = 0
3105      IF (KEEP_OOC(50).EQ.0
3106     &         .AND.KEEP_OOC(251).EQ.2) THEN
3107        WRITE_L = .FALSE.
3108      ELSE
3109        WRITE_L =  (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_L)
3110      ENDIF
3111      WRITE_U =  (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_U)
3112      DO_U_FIRST = .FALSE.
3113      IF ( TYPEFile.EQ.TYPEF_BOTH_LU ) THEN
3114         IF ( LNextPiv2beWritten .GT. UNextPiv2beWritten ) THEN
3115            DO_U_FIRST = .TRUE.
3116         END IF
3117      END IF
3118      IF (DO_U_FIRST) GOTO 200
3119 100  IF (WRITE_L .AND. TYPEF_L > 0 ) THEN
3120         TempFTYPE  = TYPEF_L
3121         IF ((MonBloc%Typenode.EQ.2).AND.(.NOT.MonBloc%MASTER))
3122     &        THEN
3123           TMPSIZE_OF_BLOCK = SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),
3124     &                                      TempFTYPE)
3125           IF (TMPSIZE_OF_BLOCK .LT. 0_8) THEN
3126               TMPSIZE_OF_BLOCK = -TMPSIZE_OF_BLOCK - 1_8
3127           ENDIF
3128           LNextPiv2beWritten =
3129     &     int(
3130     &          TMPSIZE_OF_BLOCK
3131     &          / int(MonBloc%NROW,8)
3132     &        )
3133     &     + 1
3134         ENDIF
3135         CALL SMUMPS_695( STRAT,
3136     &        TempFTYPE, AFAC, LAFAC, MonBloc,
3137     &        IERR,
3138     &        LNextPiv2beWritten,
3139     &        OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE),
3140     &        SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE),
3141     &        FILESIZE, LAST_CALL )
3142         IF (IERR .LT. 0) RETURN
3143         IF (DO_U_FIRST) GOTO 300
3144      ENDIF
3145 200  IF (WRITE_U) THEN
3146         TempFTYPE  = TYPEF_U
3147         CALL SMUMPS_695( STRAT,
3148     &        TempFTYPE, AFAC, LAFAC, MonBloc,
3149     &        IERR,
3150     &        UNextPiv2beWritten,
3151     &        OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE),
3152     &        SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE),
3153     &        FILESIZE, LAST_CALL)
3154         IF (IERR .LT. 0) RETURN
3155         IF (DO_U_FIRST) GOTO 100
3156      ENDIF
3157 300  CONTINUE
3158      RETURN
3159      END SUBROUTINE SMUMPS_688
3160      SUBROUTINE SMUMPS_695( STRAT, TYPEF,
3161     &     AFAC, LAFAC, MonBloc,
3162     &     IERR,
3163     &     LorU_NextPiv2beWritten,
3164     &     LorU_AddVirtNodeI8, LorUSIZE_OF_BLOCK,
3165     &     FILESIZE, LAST_CALL
3166     &     )
3167      USE SMUMPS_OOC_BUFFER
3168      IMPLICIT NONE
3169      INTEGER, INTENT(IN) :: STRAT
3170      INTEGER, INTENT(IN) :: TYPEF
3171      INTEGER(8), INTENT(INOUT) :: FILESIZE
3172      INTEGER(8), INTENT(IN) :: LAFAC
3173      REAL, INTENT(IN) :: AFAC(LAFAC)
3174      INTEGER, INTENT(INOUT) :: LorU_NextPiv2beWritten
3175      INTEGER(8), INTENT(INOUT) :: LorU_AddVirtNodeI8
3176      INTEGER(8), INTENT(INOUT) :: LorUSIZE_OF_BLOCK
3177      TYPE(IO_BLOCK), INTENT(INOUT) :: MonBloc
3178      INTEGER, INTENT(OUT)  :: IERR
3179      LOGICAL, INTENT(IN)   :: LAST_CALL
3180      INTEGER NNMAX
3181      INTEGER(8) :: TOTSIZE, EFFSIZE
3182      INTEGER(8) :: TailleEcrite
3183      INTEGER SIZE_PANEL
3184      INTEGER(8) :: AddVirtCour
3185      LOGICAL VIRT_ADD_RESERVED_BEF_CALL
3186      LOGICAL VIRTUAL_ADDRESS_JUST_RESERVED
3187      LOGICAL HOLE_PROCESSED_BEFORE_CALL
3188      LOGICAL TMP_ESTIM
3189      INTEGER ICUR, INODE_CUR, ILAST
3190      INTEGER(8) :: ADDR_LAST
3191      IERR = 0
3192      IF (TYPEF == TYPEF_L ) THEN
3193         NNMAX = MonBloc%NROW
3194      ELSE
3195         NNMAX = MonBloc%NCOL
3196      ENDIF
3197      SIZE_PANEL = SMUMPS_690(NNMAX)
3198      IF ( (.NOT.MonBloc%Last) .AND.
3199     &     (MonBloc%LastPiv-LorU_NextPiv2beWritten+1.LT.SIZE_PANEL))
3200     &     THEN
3201        RETURN
3202      ENDIF
3203      TMP_ESTIM = .TRUE.
3204      TOTSIZE = SMUMPS_725
3205     &          (MonBloc%NFS, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM)
3206      IF (MonBloc%Last) THEN
3207           TMP_ESTIM=.FALSE.
3208           EFFSIZE = SMUMPS_725
3209     &     (MonBloc%LastPiv, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM)
3210      ELSE
3211            EFFSIZE = -1034039740327_8
3212      ENDIF
3213      IF (MonBloc%Typenode.EQ.3.AND. MonBloc%NFS.NE.MonBloc%NCOL) THEN
3214         WRITE(*,*) 'Internal error in SMUMPS_695 for type3',
3215     &   MonBloc%NFS,MonBloc%NCOL
3216         CALL MUMPS_ABORT()
3217      ENDIF
3218      IF (MonBloc%Typenode.EQ.3.AND. TYPEF.NE.TYPEF_L) THEN
3219         WRITE(*,*) 'Internal error in SMUMPS_695,TYPEF=',
3220     &   TYPEF, 'for typenode=3'
3221         CALL MUMPS_ABORT()
3222      ENDIF
3223      IF (MonBloc%Typenode.EQ.2.AND.
3224     &     TYPEF.EQ.TYPEF_U.AND.
3225     &     .NOT. MonBloc%MASTER ) THEN
3226         WRITE(*,*) 'Internal error in SMUMPS_695',
3227     &   MonBloc%MASTER,MonBloc%Typenode, TYPEF
3228         CALL MUMPS_ABORT()
3229      ENDIF
3230      HOLE_PROCESSED_BEFORE_CALL  = (LorUSIZE_OF_BLOCK .LT. 0_8)
3231      IF (HOLE_PROCESSED_BEFORE_CALL.AND.(.NOT.MonBloc%Last)) THEN
3232          WRITE(6,*) ' Internal error  in SMUMPS_695 ',
3233     &    ' last is false after earlier calls with last=true'
3234          CALL MUMPS_ABORT()
3235      ENDIF
3236      IF (HOLE_PROCESSED_BEFORE_CALL) THEN
3237        LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8
3238        TOTSIZE = -99999999_8
3239      ENDIF
3240      VIRTUAL_ADDRESS_JUST_RESERVED = .FALSE.
3241      VIRT_ADD_RESERVED_BEF_CALL =
3242     &                    ( LorUSIZE_OF_BLOCK .NE. 0_8 .OR.
3243     &                      HOLE_PROCESSED_BEFORE_CALL )
3244      IF (MonBloc%Last .AND. .NOT. HOLE_PROCESSED_BEFORE_CALL) THEN
3245        KEEP_OOC(228) = max(KEEP_OOC(228),
3246     &        (MonBloc%LastPiv+SIZE_PANEL-1) / SIZE_PANEL)
3247        IF (VIRT_ADD_RESERVED_BEF_CALL) THEN
3248            IF (AddVirtLibre(TYPEF).EQ.
3249     &           (LorU_AddVirtNodeI8+TOTSIZE) ) THEN
3250              AddVirtLibre(TYPEF) = LorU_AddVirtNodeI8 + EFFSIZE
3251            ENDIF
3252        ELSE
3253            VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE.
3254            IF (EFFSIZE .EQ. 0_8) THEN
3255              LorU_AddVirtNodeI8 = -9999_8
3256            ELSE
3257              LorU_AddVirtNodeI8  = AddVirtLibre(TYPEF)
3258            ENDIF
3259            AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + EFFSIZE
3260        ENDIF
3261      ELSE
3262        IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL
3263     &    ) THEN
3264          LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF)
3265          AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + TOTSIZE
3266        ENDIF
3267      ENDIF
3268      AddVirtCour = LorU_AddVirtNodeI8 + LorUSIZE_OF_BLOCK
3269      CALL SMUMPS_697( STRAT, TYPEF, MonBloc,
3270     &     SIZE_PANEL,
3271     &     AFAC, LAFAC,
3272     &     LorU_NextPiv2beWritten, AddVirtCour,
3273     &     TailleEcrite,
3274     &     IERR )
3275      IF ( IERR .LT. 0 ) RETURN
3276      LorUSIZE_OF_BLOCK = LorUSIZE_OF_BLOCK + TailleEcrite
3277      IF (LorUSIZE_OF_BLOCK.EQ.0_8 ) THEN
3278        IF ( .NOT. VIRT_ADD_RESERVED_BEF_CALL
3279     &    .AND. .NOT. VIRTUAL_ADDRESS_JUST_RESERVED )
3280     &    THEN
3281          AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) - TOTSIZE
3282          LorU_AddVirtNodeI8 = 0_8
3283        ENDIF
3284      ELSE IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL ) THEN
3285          VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE.
3286      ENDIF
3287      IF ( VIRTUAL_ADDRESS_JUST_RESERVED) THEN
3288         OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(TYPEF),
3289     &        TYPEF) = MonBloc%INODE
3290         I_CUR_HBUF_NEXTPOS(TYPEF) = I_CUR_HBUF_NEXTPOS(TYPEF) + 1
3291         IF (MonBloc%Last) THEN
3292           MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,EFFSIZE)
3293           TMP_SIZE_FACT=TMP_SIZE_FACT+EFFSIZE
3294         ELSE
3295           MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,TOTSIZE)
3296           TMP_SIZE_FACT=TMP_SIZE_FACT+TOTSIZE
3297         ENDIF
3298         TMP_NB_NODES=TMP_NB_NODES+1
3299         IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN
3300            MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,
3301     &           TMP_NB_NODES)
3302            TMP_SIZE_FACT=0_8
3303            TMP_NB_NODES=0
3304         ENDIF
3305      ENDIF
3306      IF (MonBloc%Last) THEN
3307        LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8
3308      ENDIF
3309      IF (LAST_CALL) THEN
3310        IF (.NOT.MonBloc%Last) THEN
3311          WRITE(6,*) ' Internal error in SMUMPS_695 ',
3312     &               ' LAST and LAST_CALL are incompatible '
3313         CALL MUMPS_ABORT()
3314        ENDIF
3315        LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8
3316        ICUR      = I_CUR_HBUF_NEXTPOS(TYPEF) - 1
3317        INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF)
3318        ADDR_LAST = AddVirtLibre(TYPEF)
3319        IF (INODE_CUR .NE. MonBloc%INODE) THEN
3320 10       CONTINUE
3321          ILAST = ICUR
3322          IF ( OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) .NE. -9999_8) THEN
3323            ADDR_LAST = OOC_VADDR(STEP_OOC(INODE_CUR), TYPEF)
3324          ENDIF
3325          ICUR = ICUR - 1
3326          INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF)
3327          IF (INODE_CUR .EQ. MonBloc%INODE) THEN
3328            LorUSIZE_OF_BLOCK = ADDR_LAST -
3329     &                          OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF)
3330          ELSE
3331            IF (ICUR .LE. 1) THEN
3332              WRITE(*,*) "Internal error in SMUMPS_695"
3333              WRITE(*,*) "Did not find current node in sequence"
3334              CALL MUMPS_ABORT()
3335            ENDIF
3336            GOTO 10
3337          ENDIF
3338        ENDIF
3339        FILESIZE  = FILESIZE + LorUSIZE_OF_BLOCK
3340      ENDIF
3341      RETURN
3342      END SUBROUTINE SMUMPS_695
3343      SUBROUTINE SMUMPS_697(
3344     &     STRAT, TYPEF, MonBloc,
3345     &     SIZE_PANEL,
3346     &     AFAC, LAFAC,
3347     &     NextPiv2beWritten, AddVirtCour,
3348     &     TailleEcrite, IERR )
3349      USE SMUMPS_OOC_BUFFER
3350      IMPLICIT NONE
3351      INTEGER,       INTENT(IN) :: STRAT, TYPEF, SIZE_PANEL
3352      INTEGER(8)                :: LAFAC
3353      INTEGER(8),     INTENT(IN) ::  AddVirtCour
3354      REAL, INTENT(IN) :: AFAC(LAFAC)
3355      INTEGER,       INTENT(INOUT) :: NextPiv2beWritten
3356      TYPE(IO_BLOCK),INTENT(INOUT) :: MonBloc
3357      INTEGER(8),      INTENT(OUT) :: TailleEcrite
3358      INTEGER, INTENT(OUT)  :: IERR
3359      INTEGER   :: I, NBeff, LPANELeff, IEND
3360      INTEGER(8) :: AddVirtDeb
3361      IERR = 0
3362      TailleEcrite = 0_8
3363      AddVirtDeb   = AddVirtCour
3364      I = NextPiv2beWritten
3365      IF ( NextPiv2beWritten .GT. MonBloc%LastPiv ) THEN
3366        RETURN
3367      ENDIF
3368 10   CONTINUE
3369      NBeff  = min(SIZE_PANEL,MonBloc%LastPiv-I+1 )
3370      IF ((NBeff.NE.SIZE_PANEL) .AND. (.NOT.MonBloc%Last)) THEN
3371         GOTO 20
3372      ENDIF
3373      IF (TYPEF.EQ.TYPEF_L.AND.MonBloc%MASTER.AND.
3374     &     KEEP_OOC(50).EQ.2 .AND. MonBloc%Typenode.NE.3) THEN
3375         IF (MonBloc%INDICES(NBeff+I-1) < 0)
3376     &        THEN
3377            NBeff=NBeff+1
3378         ENDIF
3379      ENDIF
3380      IEND   = I + NBeff -1
3381      CALL SMUMPS_653( STRAT, TYPEF, MonBloc,
3382     &     AFAC, LAFAC,
3383     &     AddVirtDeb, I, IEND, LPANELeff,
3384     &     IERR)
3385      IF ( IERR .LT. 0 ) THEN
3386        RETURN
3387      ENDIF
3388      IF ( IERR .EQ. 1 ) THEN
3389         IERR=0
3390         GOTO 20
3391      ENDIF
3392      IF (TYPEF .EQ. TYPEF_L) THEN
3393         MonBloc%LastPanelWritten_L = MonBloc%LastPanelWritten_L+1
3394      ELSE
3395         MonBloc%LastPanelWritten_U = MonBloc%LastPanelWritten_U+1
3396      ENDIF
3397      AddVirtDeb   = AddVirtDeb + int(LPANELeff,8)
3398      TailleEcrite = TailleEcrite + int(LPANELeff,8)
3399      I=I+NBeff
3400      IF ( I .LE. MonBloc%LastPiv ) GOTO 10
3401 20   CONTINUE
3402      NextPiv2beWritten = I
3403      RETURN
3404      END SUBROUTINE SMUMPS_697
3405      INTEGER(8) FUNCTION SMUMPS_725
3406     &      (NFSorNPIV, NNMAX, SIZE_PANEL, MonBloc, ESTIM)
3407      IMPLICIT NONE
3408      TYPE(IO_BLOCK), INTENT(IN):: MonBloc
3409      INTEGER, INTENT(IN) :: NFSorNPIV, NNMAX, SIZE_PANEL
3410      LOGICAL, INTENT(IN) :: ESTIM
3411      INTEGER :: I, NBeff
3412      INTEGER(8) :: TOTSIZE
3413      TOTSIZE = 0_8
3414      IF (NFSorNPIV.EQ.0) GOTO 100
3415      IF (.NOT. MonBloc%MASTER .OR. MonBloc%Typenode.EQ.3) THEN
3416        TOTSIZE = int(NFSorNPIV,8) * int(NNMAX,8)
3417      ELSE
3418        I = 1
3419 10     CONTINUE
3420        NBeff = min(SIZE_PANEL, NFSorNPIV-I+1)
3421        IF (KEEP_OOC(50).EQ.2) THEN
3422          IF (ESTIM) THEN
3423            NBeff = NBeff + 1
3424          ELSE
3425             IF (MonBloc%INDICES(I+NBeff-1) < 0) THEN
3426            NBeff = NBeff + 1
3427            ENDIF
3428          ENDIF
3429        ENDIF
3430        TOTSIZE = TOTSIZE +
3431     &           int(NNMAX-I+1,8) * int(NBeff,8)
3432        I = I + NBeff
3433        IF ( I .LE. NFSorNPIV ) GOTO 10
3434      ENDIF
3435 100  CONTINUE
3436      SMUMPS_725 = TOTSIZE
3437      RETURN
3438      END FUNCTION SMUMPS_725
3439      INTEGER FUNCTION SMUMPS_690( NNMAX )
3440      IMPLICIT NONE
3441      INTEGER, INTENT(IN) :: NNMAX
3442      INTEGER SMUMPS_748
3443      SMUMPS_690=SMUMPS_748(
3444     &     HBUF_SIZE, NNMAX, KEEP_OOC(227),KEEP_OOC(50))
3445      RETURN
3446      END FUNCTION SMUMPS_690
3447      SUBROUTINE SMUMPS_728()
3448      IMPLICIT NONE
3449      INTEGER I,TMP_NODE
3450      IF(.NOT.SMUMPS_727())THEN
3451         IF(SOLVE_STEP.EQ.0)THEN
3452            I=CUR_POS_SEQUENCE
3453            TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
3454     &           OOC_FCT_TYPE)
3455            DO WHILE ((I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND.
3456     &           (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
3457     &           .EQ.0_8))
3458               INODE_TO_POS(STEP_OOC(TMP_NODE))=1
3459               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED
3460               I=I+1
3461               IF(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN
3462                  TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
3463               ENDIF
3464            ENDDO
3465            CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))
3466         ELSE
3467            I=CUR_POS_SEQUENCE
3468            TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,
3469     &           OOC_FCT_TYPE)
3470            DO WHILE ((I.GE.1).AND.
3471     &           (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)
3472     &           .EQ.0_8))
3473               INODE_TO_POS(STEP_OOC(TMP_NODE))=1
3474               OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED
3475               I=I-1
3476               IF(I.GE.1)THEN
3477                  TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)
3478               ENDIF
3479            ENDDO
3480            CUR_POS_SEQUENCE=max(I,1)
3481         ENDIF
3482      ENDIF
3483      RETURN
3484      END SUBROUTINE SMUMPS_728
3485      SUBROUTINE SMUMPS_809(N,KEEP201,
3486     &           Pruned_List,nb_prun_nodes,STEP)
3487      IMPLICIT NONE
3488      INTEGER, INTENT(IN) :: N, KEEP201, nb_prun_nodes
3489      INTEGER, INTENT(IN) :: STEP(N),
3490     &                       Pruned_List(nb_prun_nodes)
3491      INTEGER I, ISTEP
3492      IF (KEEP201 .GT. 0) THEN
3493        OOC_STATE_NODE(:) = ALREADY_USED
3494        DO I = 1, nb_prun_nodes
3495          ISTEP = STEP(Pruned_List(I))
3496          OOC_STATE_NODE(ISTEP) = NOT_IN_MEM
3497        ENDDO
3498      ENDIF
3499      RETURN
3500      END SUBROUTINE SMUMPS_809
3501      END MODULE SMUMPS_OOC
3502