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