43
46 IMPLICIT NONE
47 INTEGER COMM_LOAD, ASS_IRECV
48 INTEGER N, INODE, FPERE, LIW
49 INTEGER, intent(inout) :: NNEGW, NPVW, NB22T2W, NBTINYW
50 INTEGER, intent(inout) :: DET_EXPW, DET_SIGNW
51 COMPLEX, intent(inout) :: DET_MANTW
52 INTEGER(8) :: LA
53 INTEGER, TARGET :: IW( LIW )
54 COMPLEX A( LA )
55 REAL UU, SEUIL
56 TYPE (CMUMPS_ROOT_STRUC) :: root
57 INTEGER COMM, MYID, LBUFR, LBUFR_BYTES
58 INTEGER LPTRAR, NELT
59 INTEGER ICNTL(60), KEEP(500)
60 INTEGER(8) KEEP8(150)
61 INTEGER NBFIN, SLAVEF,
62 & IFLAG, IERROR, LEAF, LPOOL
63 INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS
64 INTEGER IWPOS, IWPOSCB, COMP
65 INTEGER NB_BLOC_FAC
66 INTEGER FRTPTR( N + 1 ), FRTELT( NELT )
67 INTEGER BUFR( LBUFR ), IPOOL(LPOOL),
68 & ITLOC(N+KEEP(253)), FILS(N), DAD( KEEP(28) ),
69 & ND( KEEP(28) ), FRERE( KEEP(28) )
70 INTEGER(8), INTENT(IN) :: PTRARW(LPTRAR), PTRAIW(LPTRAR)
71 COMPLEX :: RHS_MUMPS(KEEP(255))
72 INTEGER(8) :: PTRAST(KEEP(28))
73 INTEGER(8) :: PTRFAC(KEEP(28))
74 INTEGER(8) :: PAMASTER(KEEP(28))
75 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)),
76 & STEP(N), PIMASTER(KEEP(28)),
77 & NSTK_S(KEEP(28)), PERM(N),
78 & PROCNODE_STEPS(KEEP(28))
79 INTEGER ISTEP_TO_INIV2(KEEP(71)),
80 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
81 DOUBLE PRECISION OPASSW, OPELIW
82 COMPLEX DBLARR(KEEP8(26))
83 INTEGER INTARR(KEEP8(27))
84 LOGICAL AVOID_DELAYED
85 INTEGER LPN_LIST
86 INTEGER PIVNUL_LIST(LPN_LIST)
87 REAL DKEEP(230)
88 INTEGER :: LRGROUPS(N)
89 INTEGER(8) :: POSELT
90 INTEGER IOLDPS, allocok, K263,J
91 INTEGER INOPV, IFINB, NFRONT, NPIV, IEND_BLOCK
92 INTEGER NASS, LDAFS, IBEG_BLOCK
93 INTEGER :: NB_POSTPONED
94 INTEGER :: IBEG_BLOCK_FOR_IPIV
95 LOGICAL LASTBL, LR_ACTIVATED, COMPRESS_PANEL
96 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR,
97 & OOC_EFFECTIVE_ON_FRONT,
98 & OOC_EFF_AND_WRITE_BYPANEL
99 INTEGER NBLR_ORIG, IBEG_BLR, IEND_BLR, CURRENT_BLR
100 INTEGER Inextpiv
101 LOGICAL RESET_TO_ONE
102 INTEGER K109_SAVE
103 INTEGER XSIZE, NBKJIB_ORIG
104 REAL UUTEMP
105 include 'mumps_headers.h'
106 INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV
107 REAL , ALLOCATABLE, DIMENSION ( : ) :: DIAG_ORIG
108 INTEGER :: SIZEDIAG_ORIG
109 INTEGER(8) :: LAFAC
110 INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten,
111 & IDUMMY, NELIM
112 TYPE(IO_BLOCK) :: MonBloc
113 LOGICAL LAST_CALL
114 INTEGER PP_FIRST2SWAP_L, IFLAG_OOC
115 INTEGER PP_LastPIVRPTRFilled
116 INTEGER INFO_TMP(2)
117 INTEGER :: MAXI_RANK
118 INTEGER HF, NPARTSASS, NPARTSCB, NB_BLR
119 INTEGER MAXI_CLUSTER, LWORK
120 TYPE(LRB_TYPE), DIMENSION(1), TARGET :: BLR_DUMMY
121 INTEGER, POINTER, DIMENSION(:) :: PTDummy
122 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: ACC_LUA
123 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR
124 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: BLR_L, BLR_SEND
125 COMPLEX, POINTER, DIMENSION(:) :: DIAG
126 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: BLR_PANEL
127 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_TMP, BEGS_BLR_STATIC
128 INTEGER :: DIAGSIZ_STA, DIAGSIZ_DYN, DPOS, I, IP, MEM, MEM_TOT
129 INTEGER(8) :: POSELT_DIAG, APOSMAX
130 COMPLEX, ALLOCATABLE :: WORK(:), TAU(:)
131 INTEGER, ALLOCATABLE :: JPVT(:)
132 REAL, ALLOCATABLE :: RWORK(:)
133 COMPLEX, ALLOCATABLE :: BLOCK(:,:)
134 INTEGER :: OMP_NUM
135 INTEGER :: MY_NUM
136 INTEGER PIVOT_OPTION
137 INTEGER LAST_ROW
139 LOGICAL STATICMODE
140 REAL SEUIL_LOC
141 REAL GW_FACTCUMUL
142 INTEGER PIVSIZ,IWPOSPIV
143 COMPLEX ONE
144 parameter(one=(1.0e0,0.0e0))
145 NULLIFY(ptdummy)
146 NULLIFY(acc_lua)
147 NULLIFY(begs_blr)
148 NULLIFY(blr_l)
149 NULLIFY(blr_send)
150 NULLIFY(diag)
151 NULLIFY(blr_panel)
152 NULLIFY(begs_blr_tmp)
153 NULLIFY(begs_blr_static)
154 IF (keep(206).GE.1) THEN
155 inextpiv = 1
156 ELSE
157 inextpiv = 0
158 ENDIF
159 inopv = 0
160 IF(keep(97) .EQ. 0) THEN
161 staticmode = .false.
162 ELSE
163 staticmode = .true.
164 ENDIF
165 IF (avoid_delayed) THEN
166 staticmode = .true.
167 uutemp=uu
168 seuil_loc =
max(seuil,epsilon(seuil))
169 ELSE
170 seuil_loc=seuil
171 uutemp=uu
172 ENDIF
173 reset_to_one = ((keep(110).GT.0).AND.(dkeep(2).LE.0.0e0))
174 IF (reset_to_one) THEN
175 k109_save = keep(109)
176 ENDIF
177 ibeg_block = 1
178 nb_bloc_fac = 0
179 xsize = keep(ixsz)
180 ioldps = ptlust_s(step( inode ))
181 poselt = ptrast(step( inode ))
182 nfront = iw(ioldps+xsize)
183 nass = iabs(iw(ioldps+2+xsize))
184 ldafs = nass
185 IF ((keep(219).EQ.1).AND.(keep(207).EQ.1).AND.(keep(50).EQ.2)
186 & ) THEN
187 aposmax = poselt + int(ldafs,8)*int(ldafs,8)
188 nb_postponed =
max(nfront - nd(step(inode)),0)
190 & keep, a(aposmax), nass, nb_postponed)
191 ENDIF
192 iw(ioldps+3+xsize) = -99999
193 lr_activated= .false.
194 lr_activated = (iw(ioldps+xxlr).GT.0)
195 compress_panel = (iw(ioldps+xxlr).GE.2)
196 oocwrite_compatible_with_blr =
197 & ( .NOT.lr_activated.OR. (.NOT.compress_panel).OR.
198 & (keep(486).NE.2)
199 & )
200 ooc_effective_on_front= ((keep(201).EQ.1).AND.
201 & oocwrite_compatible_with_blr)
202 IF (nass.LT.keep(4)) THEN
203 nbkjib_orig = nass
204 ELSE IF (nass .GT. keep(3)) THEN
205 nbkjib_orig =
min( keep(6), nass )
206 ELSE
207 nbkjib_orig =
min( keep(5), nass )
208 ENDIF
209 IF (.not.lr_activated) THEN
210 nblr_orig = keep(420)
211 ELSE
212 nblr_orig = -9999
213 ENDIF
214 IF (lr_activated) THEN
215 k263 = 1
216 ELSE
217 k263 = keep(263)
218 IF (k263 .NE. 0 .AND. nass/nblr_orig < 4) THEN
219 IF ( nblr_orig .GT. nbkjib_orig * 4 ) THEN
220 nblr_orig =
max(nbkjib_orig, (nass+3)/4)
221 ELSE
222 k263 = 0
223 ENDIF
224 ENDIF
225 ENDIF
226 pivot_option =
min(2,keep(468))
227 IF ((uutemp == 0.0e0) .AND. ooc_effective_on_front) THEN
228 IF (k263.EQ.1.AND.(.NOT.lr_activated)) THEN
229 pivot_option = 0
230 ENDIF
231 ENDIF
232 iend_block = 0
233 iend_blr = 0
234 current_blr = 0
235 ALLOCATE( ipiv( nass ), stat = allocok )
236 IF ( allocok .GT. 0 ) THEN
237 WRITE(*,*) myid, ' : CMUMPS_FAC2_LDLT failed to allocate ',
238 & nass, ' integers'
239 iflag = -13
240 ierror=nass
241 GO TO 500
242 END IF
243 IF (keep(219).GE.3) THEN
244 sizediag_orig = nass
245 ELSE
246 sizediag_orig = 1
247 ENDIF
248 ALLOCATE ( diag_orig(sizediag_orig), stat = allocok )
249 IF ( allocok .GT. 0 ) THEN
250 WRITE(*,*) myid,
251 & ' : FAC_NIV2 failed to allocate ',
252 & nass, ' REAL/COMPLEX entries'
253 iflag=-13
254 ierror=nass
255 GO TO 500
256 END IF
258 liwfac = iw(ioldps+xxi)
259 IF (ooc_effective_on_front) THEN
260 idummy = -9876
261 typefile = typef_l
262 nextpiv2bewritten = 1
263 pp_first2swap_l = nextpiv2bewritten
264 monbloc%LastPanelWritten_L = 0
265 monbloc%INODE = inode
266 monbloc%MASTER = .true.
267 monbloc%Typenode = 2
268 monbloc%NROW = nass
269 monbloc%NCOL = nass
270 monbloc%NFS = nass
271 monbloc%Last = .false.
272 monbloc%LastPiv = -66666
273 monbloc%INDICES =>
274 & iw(ioldps+6+nfront+xsize+iw(ioldps+5+xsize)
275 & :ioldps+5+2*nfront+xsize+iw(ioldps+5+xsize))
276 ENDIF
277 IF (lr_activated) THEN
278 IF (keep(475).EQ.3) THEN
279 IF (uutemp == 0.0e0) THEN
280 pivot_option = 0
281 ELSE
282 pivot_option = 1
283 ENDIF
284 ENDIF
286 ENDIF
287 hf = 6 + iw(ioldps+5+xsize)+xsize
288 ooc_eff_and_write_bypanel = ( (pivot_option.GE.2) .AND.
289 & ooc_effective_on_front )
290 IF (lr_activated) THEN
291 CALL get_cut(iw(ioldps+hf:ioldps+hf+nfront-1), nass,
292 & 0, lrgroups, npartscb,
293 & npartsass, begs_blr)
294 CALL regrouping2(begs_blr, npartsass, nass, npartscb,
295 & 0, keep(488), .false., keep(472))
296 nb_blr = npartsass + npartscb
297 call max_cluster(begs_blr,nb_blr,maxi_cluster)
298 maxi_rank = keep(479)*maxi_cluster
299 lwork = maxi_cluster*maxi_cluster
300 omp_num = 1
301#if defined(BLR_MT)
302
303#endif
304 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
305 & rwork(2*maxi_cluster*omp_num),
306 & tau(maxi_cluster*omp_num),
307 & jpvt(maxi_cluster*omp_num),
308 & work(lwork*omp_num),stat=allocok)
309 IF (allocok > 0) THEN
310 iflag = -13
311 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
312 GOTO 480
313 ENDIF
314 ALLOCATE(acc_lua(omp_num),stat=allocok)
315 IF (allocok > 0) THEN
316 iflag = -13
317 ierror = omp_num
318 GOTO 480
319 ENDIF
320 IF (keep(480).GE.3) THEN
321 DO my_num=1,omp_num
322 CALL alloc_lrb(acc_lua(my_num), maxi_rank,
323 & maxi_cluster, maxi_cluster, .true.,
324 & iflag, ierror, keep8)
325 IF (iflag.LT.0) GOTO 480
326 acc_lua(my_num)%K = 0
327 ENDDO
328 ENDIF
329 ENDIF
330 IF (lr_activated.AND.(keep(480).NE.0
331 & .OR.
332 & (
333 & (keep(486).EQ.2)
334 & )
335 & )) THEN
336 info_tmp(1) = iflag
337 info_tmp(2) = ierror
339 iflag = info_tmp(1)
340 ierror = info_tmp(2)
341 IF (iflag.LT.0) GOTO 500
343 & .true.,
344 & .true.,
345 & .false.,
346 & npartsass,
347 & begs_blr, ptdummy,
348 & huge(npartsass),
349 & info_tmp)
350 iflag = info_tmp(1)
351 ierror = info_tmp(2)
352 IF (iflag.LT.0) GOTO 500
353 ENDIF
354 lastbl = .false.
355 DO WHILE (iend_blr < nass )
356 current_blr = current_blr + 1
357 ibeg_blr = iw(ioldps+1+keep(ixsz)) + 1
358 IF (.NOT. lr_activated)THEN
359 iend_blr =
min(iend_blr + nblr_orig, nass)
360 ELSE
361 iend_blr = begs_blr(current_blr+1)-1
362 begs_blr( current_blr ) = ibeg_blr
363 IF ( iend_blr - ibeg_blr + 1 .GT. maxi_cluster ) THEN
364 maxi_cluster = iend_blr - ibeg_blr + 1
365 lwork = maxi_cluster*maxi_cluster
366 DEALLOCATE(block, work, rwork, tau, jpvt)
367 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
368 & rwork(2*maxi_cluster*omp_num),
369 & tau(maxi_cluster*omp_num),
370 & jpvt(maxi_cluster*omp_num),
371 & work(lwork*omp_num),stat=allocok)
372 IF (allocok > 0) THEN
373 iflag = -13
374 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
375 GOTO 480
376 ENDIF
377 IF (keep(480).GE.3) THEN
378 DO my_num=1,omp_num
380 CALL alloc_lrb(acc_lua(my_num), maxi_rank,
381 & maxi_cluster, maxi_cluster, .true.,
382 & iflag, ierror, keep8)
383 IF (iflag.LT.0) GOTO 480
384 acc_lua(my_num)%K = 0
385 ENDDO
386 ENDIF
387 ENDIF
388 ENDIF
389 DO WHILE (iend_block < iend_blr )
390 ibeg_block = iw(ioldps+1+keep(ixsz)) + 1
391 IF (keep(405).EQ.0) THEN
392 keep(425)=
max(keep(425),iend_block-ibeg_block)
393 ELSE
394
395 keep(425)=
max(keep(425),iend_block-ibeg_block)
396
397 ENDIF
398 iend_block =
min(iend_block + nbkjib_orig, iend_blr)
399 50 CONTINUE
400 IF (k263.EQ.0) THEN
401 ibeg_block_for_ipiv = ibeg_block
402 ELSE
403 ibeg_block_for_ipiv = ibeg_blr
404 ENDIF
406 & diag_orig, sizediag_orig, gw_factcumul,
407 & nfront,nass,ibeg_block_for_ipiv,
408 & ibeg_block, iend_block,
409 & nass, ipiv,
410 & n,inode,iw,liw,a,la,
411 & nnegw,nb22t2w,nbtinyw,
412 & det_expw, det_mantw, det_signw,
413 & inopv,
414 & iflag,ioldps,poselt,uu, seuil_loc,
415 & keep,keep8,pivsiz,
416 & dkeep(1),pivnul_list(1),lpn_list,
417 & pp_first2swap_l, monbloc%LastPanelWritten_L,
418 & pp_lastpivrptrfilled,
419 & pivot_option,
420 & inextpiv, iend_blr, lr_activated,
421 & ooc_effective_on_front)
422 IF (iflag.LT.0) GOTO 500
423 IF (inopv.EQ. 1) THEN
424 IF (staticmode) THEN
425 inopv = -1
426 GOTO 50
427 ENDIF
428 lastbl = .true.
429 ELSE IF (inopv .LE. 0) THEN
430 inopv = 0
431 npvw = npvw + pivsiz
433 & nass, iw(ioldps+1+xsize), inode,a,la,
434 & ldafs, poselt,ifinb,
435 & pivsiz,
436 & keep(219),
437 & pivot_option, iend_blr, lr_activated)
438 IF(pivsiz .EQ. 2) THEN
439 iwpospiv = ioldps+xsize+iw(ioldps+1+xsize)+6+
440 & iw(ioldps+5+xsize)
441 iw(iwpospiv+nfront) = -iw(iwpospiv+nfront)
442 ENDIF
443 iw(ioldps+1+xsize) = iw(ioldps+1+xsize) + pivsiz
444 IF (ifinb.EQ.0) THEN
445 GOTO 50
446 ELSE IF (ifinb .EQ. -1) THEN
447 lastbl = .true.
448 ENDIF
449 ENDIF
450 npiv = iw(ioldps+1+xsize)
451 IF ( ooc_eff_and_write_bypanel ) THEN
452 IF (.NOT.reset_to_one.OR.k109_save.EQ.keep(109)) THEN
453 monbloc%Last = .false.
454 monbloc%LastPiv= npiv
455 last_call=.false.
457 & strat_try_write,
458 & typefile, a(poselt),
459 & lafac, monbloc, nextpiv2bewritten, idummy, iw(ioldps),
460 & liwfac, myid, keep8(31), iflag_ooc,last_call )
461 IF (iflag_ooc .LT. 0 ) iflag = iflag_ooc
462 IF (iflag .LT. 0) GOTO 500
463 ENDIF
464 ENDIF
465 IF (k263.eq.0) THEN
466 nelim = iend_blr - npiv
468 & n, inode, fpere, iw, liw,
469 & ioldps, poselt, a, la, ldafs,
470 & ibeg_block, npiv, ipiv, nass,lastbl, nb_bloc_fac,
471 & comm, myid, bufr, lbufr, lbufr_bytes,nbfin,leaf,
472 & iflag, ierror, ipool,lpool,
473 & slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
474 & lrlus,
comp, ptrist, ptrast, ptlust_s, ptrfac, step,
475 & pimaster, pamaster,
476 & nstk_s,perm,procnode_steps, root,
477 & opassw, opeliw, itloc, rhs_mumps,
478 & fils, dad, ptrarw, ptraiw,
479 & intarr,dblarr,icntl,keep,keep8,dkeep,nd,frere,
480 & lptrar, nelt, frtptr, frtelt,
481 & istep_to_iniv2, tab_pos_in_pere
482 & , nelim, .false.
483 & , npartsass, current_blr, blr_dummy, lrgroups
484 & )
485 IF ( iflag .LT. 0 ) GOTO 500
486 IF (reset_to_one.AND.k109_save.LT.keep(109)) THEN
487 CALL cmumps_reset_to_one(
488 & iw(ioldps+keep(ixsz)+iw(ioldps+5+keep(ixsz))+6),
489 & npiv, ibeg_block,
490 & k109_save, keep(109), pivnul_list, lpn_list,
491 & a, poselt, la, ldafs)
492 ENDIF
493 IF ( ooc_eff_and_write_bypanel) THEN
494 monbloc%Last = .false.
495 monbloc%LastPiv= npiv
496 last_call=.false.
498 & strat_try_write,
499 & typefile, a(poselt),
500 & lafac, monbloc, nextpiv2bewritten, idummy, iw(ioldps),
501 & liwfac, myid, keep8(31), iflag_ooc,last_call )
502 IF (iflag_ooc .LT. 0 ) THEN
503 iflag = iflag_ooc
504 IF (iflag .LT. 0) GOTO 500
505 ENDIF
506 ENDIF
507 ENDIF
508 IF ( iend_blr .GT. iend_block ) THEN
509 IF (pivot_option.EQ.2) THEN
510 last_row = nass
511 ELSE
512 last_row = iend_blr
513 ENDIF
515 & nass,nass,inode,a,la,
516 & ldafs, poselt,
517 & keep,keep8,
518 & -6666, -6666,
519 & iend_blr, last_row,
520 & .false., .true., lr_activated,
521 & iw, liw, -6666
522 & )
523 ENDIF
525 END DO
526 npiv = iw(ioldps+1+xsize)
527 IF (lr_activated) THEN
528 ALLOCATE(blr_l(nb_blr-current_blr),stat=allocok)
529 IF (allocok > 0) THEN
530 iflag = -13
531 ierror = nb_blr-current_blr
532 GOTO 500
533 ENDIF
534 nelim = iend_block - npiv
535 IF (iend_blr.NE.iend_block) THEN
536 WRITE(*,*) "Internal error 1 in CMUMPS_FAC2_LDLT",
537 & iend_blr, iend_block
539 ENDIF
540 IF (nelim .EQ. iend_blr - ibeg_blr + 1) THEN
541 IF (keep(480).GE.2
542 & .OR.
543 & (
544 & (keep(486).EQ.2)
545 & )
546 & ) THEN
547 DO j=1,nb_blr-current_blr
548 blr_l(j)%M=0
549 blr_l(j)%N=0
550 blr_l(j)%K=0
551 blr_l(j)%ISLR=.false.
552 NULLIFY(blr_l(j)%Q)
553 NULLIFY(blr_l(j)%R)
554 ENDDO
556 & iw(ioldps+xxf),
557 & 0,
558 & current_blr, blr_l)
559 NULLIFY(blr_l)
560 ENDIF
561 GOTO 101
562 ENDIF
563#if defined(BLR_MT)
564
565#endif
567 & begs_blr, nb_blr, dkeep(8), keep(466), keep(473),
568 & blr_l,
569 & current_blr, 'V', work, tau, jpvt, lwork, rwork,
570 & block, maxi_cluster, nelim,
571 & .false., 0, 0,
572 & 2, keep(483), keep8
573 & )
574#if defined(BLR_MT)
575
576#endif
577 IF (iflag.LT.0) GOTO 400
578 IF (pivot_option.LT.2) THEN
580 & ibeg_blr,
581 & nb_blr, blr_l, current_blr, current_blr+1,
582 & nb_blr, 2, 1, 0, .false.,
583 & iw, offset_iw=ioldps+6+xsize+nfront+ibeg_blr-1,
584 & nass=nass)
585#if defined(BLR_MT)
586
587#endif
588 ENDIF
589 400 CONTINUE
590#if defined(BLR_MT)
591
592#endif
593 IF (iflag.LT.0) GOTO 480
594 IF (keep(480).NE.0
595 & .OR.
596 & (
597 & (keep(486).EQ.2)
598 & )
599 & ) THEN
600 IF (keep(480).LT.5) THEN
602 & iw(ioldps+xxf),
603 & 0,
604 & current_blr, blr_l)
605 ENDIF
606 ENDIF
607 ENDIF
608 101 CONTINUE
609 IF (.NOT. lr_activated) THEN
611 & nass, nass, inode, a, la,
612 & ldafs, poselt,
613 & keep, keep8,
614 & iend_blr, nass,
615 & -6666, -6666,
616 & (pivot_option.LE.1), .false., lr_activated,
617 & iw, liw, ioldps+6+xsize+nfront+ibeg_blr-1)
618 ENDIF
619 IF (k263.NE.0) THEN
620 nelim = iend_blr-npiv
621 blr_send=>blr_dummy
622 IF (associated(blr_l)) THEN
623 blr_send=>blr_l
624 ENDIF
626 & n, inode, fpere, iw, liw,
627 & ioldps, poselt, a, la, ldafs,
628 & ibeg_blr, npiv, ipiv, nass,lastbl, nb_bloc_fac,
629 &
630 & comm, myid, bufr, lbufr, lbufr_bytes,nbfin,leaf,
631 & iflag, ierror, ipool,lpool,
632 & slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
633 & lrlus,
comp, ptrist, ptrast, ptlust_s, ptrfac, step,
634 & pimaster, pamaster,
635 & nstk_s,perm,procnode_steps, root,
636 & opassw, opeliw, itloc, rhs_mumps,
637 & fils, dad, ptrarw, ptraiw,
638 & intarr,dblarr,icntl,keep,keep8,dkeep,nd,frere,
639 & lptrar, nelt, frtptr, frtelt,
640 & istep_to_iniv2, tab_pos_in_pere
641 & , nelim, lr_activated
642 & , npartsass, current_blr , blr_send , lrgroups
643 & )
644 IF ( iflag .LT. 0 ) GOTO 500
645 IF (reset_to_one.AND.k109_save.LT.keep(109)) THEN
646 CALL cmumps_reset_to_one(
647 & iw(ioldps+keep(ixsz)+iw(ioldps+5+keep(ixsz))+6),
648 & npiv, ibeg_blr,
649 & k109_save, keep(109), pivnul_list, lpn_list,
650 & a, poselt, la, ldafs)
651 ENDIF
652 IF ( ooc_eff_and_write_bypanel ) THEN
653 monbloc%Last = .false.
654 monbloc%LastPiv= npiv
655 last_call=.false.
657 & strat_try_write,
658 & typefile, a(poselt),
659 & lafac, monbloc, nextpiv2bewritten, idummy, iw(ioldps),
660 & liwfac, myid, keep8(31), iflag_ooc,last_call )
661 IF (iflag_ooc .LT. 0 ) THEN
662 iflag = iflag_ooc
663 IF (iflag .LT. 0) GOTO 500
664 ENDIF
665 ENDIF
666 ENDIF
667 IF (.NOT. lr_activated) THEN
668 IF (pivot_option.EQ.2) THEN
669 last_row = nass
670 ELSE
671 last_row = iend_blr
672 ENDIF
674 & nass,nass,inode,a,la,
675 & ldafs, poselt,
676 & keep,keep8,
677 & -6666, -6666,
678 & nass, last_row,
679 & .false., .true., lr_activated,
680 & iw, liw, -6666
681 & )
682 ELSE
683 nelim = iend_block - npiv
684 IF (iend_blr.NE.iend_block) THEN
686 ENDIF
687#if defined(BLR_MT)
688
689#endif
690 IF (keep(480).GE.2) THEN
691 IF (iend_blr.LT.nass) THEN
693 & nass, iw(ioldps+xxf),
694 & begs_blr, current_blr, nb_blr, npartsass,
695 & nelim,
696 & iw(hf+ioldps+nfront), block,
697 & acc_lua, maxi_cluster, maxi_rank,
698 & 2, iflag, ierror,
699 & keep(481), dkeep(11), keep(466), keep(477),
700 & keep(480), keep(479), keep(478), keep(476),
701 & keep(483), keep8)
702 ENDIF
703 ENDIF
704 IF (nelim .EQ. iend_blr - ibeg_blr + 1) GOTO 450
705 IF (keep(480).LT.2) THEN
707 & iflag, ierror, nass,
708 & begs_blr, nb_blr, current_blr, blr_l, nelim,
709 & iw(hf+ioldps+nfront+ibeg_blr-1), block,
710 & maxi_cluster, npiv,
711 & 2,
712 & keep(481), dkeep(11), keep(466), keep(477)
713 & )
714 ENDIF
715#if defined(BLR_MT)
716
717#endif
718 IF (iflag.LT.0) GOTO 450
719 IF (pivot_option.LT.2) THEN
720 IF ((uu.GT.0).OR.(keep(486).NE.2)) THEN
722 & .true.,
723 & begs_blr(current_blr),
724 & begs_blr(current_blr+1), nb_blr, blr_l, current_blr,
725 & 'V', 1)
726 ENDIF
727 ENDIF
728 450 CONTINUE
729#if defined(BLR_MT)
730
731#endif
732 IF (iflag.LT.0) GOTO 480
733 IF (nelim .EQ. iend_blr - ibeg_blr + 1) THEN
734 IF (keep(486).EQ.3) THEN
735 IF (keep(480).EQ.0) THEN
736 DEALLOCATE(blr_l)
737 NULLIFY(blr_l)
738 ENDIF
739 ENDIF
740 GOTO 100
741 ENDIF
742 IF (keep(486).EQ.3) THEN
743 IF (keep(480).EQ.0) THEN
745 & keep(34))
746 DEALLOCATE(blr_l)
747 ENDIF
748 NULLIFY(blr_l)
749 ENDIF
750 ENDIF
751 IF ( ooc_eff_and_write_bypanel ) THEN
752 monbloc%Last = .false.
753 monbloc%LastPiv= npiv
754 last_call=.false.
756 & strat_try_write,
757 & typefile, a(poselt),
758 & lafac, monbloc, nextpiv2bewritten, idummy, iw(ioldps),
759 & liwfac, myid, keep8(31), iflag_ooc,last_call )
760 IF (iflag_ooc < 0 ) THEN
761 iflag = iflag_ooc
762 GOTO 500
763 ENDIF
764 ENDIF
765 100 CONTINUE
766 END DO
767 IF (lr_activated) THEN
768 ibeg_blr = iw(ioldps+1+keep(ixsz)) + 1
769 begs_blr( current_blr + 1 ) = ibeg_blr
770 IF
771 & (
772 & (keep(486).EQ.2)
773 & )
774 & THEN
776 & begs_blr_static)
777 IF (uu.GT.0) THEN
778 allocate(begs_blr_tmp(nb_blr+1),stat=allocok)
779 IF (allocok > 0) THEN
780 iflag = -13
781 ierror = nb_blr+1
782 GOTO 500
783 ENDIF
784 DO j=1,nb_blr+1
785 begs_blr_tmp(j) = begs_blr_static(j)
786 ENDDO
787 ENDIF
788 ENDIF
789 IF (
790 & (keep(486).EQ.2)
791 &
792 & ) THEN
793 mem_tot = 0
794#if defined(BLR_MT)
795
796
797#endif
798#if defined(BLR_MT)
799
800
801
802#endif
803 DO ip=1,npartsass
804 IF (iflag.LT.0) cycle
805 diagsiz_dyn = begs_blr(ip+1)-begs_blr(ip)
806 diagsiz_sta = begs_blr_static(ip+1)-begs_blr(ip)
807 mem = diagsiz_dyn*diagsiz_sta
808 mem_tot = mem_tot + mem
809 ALLOCATE(diag(mem),stat=allocok)
810 IF (allocok > 0) THEN
811 iflag = -13
812 ierror = mem
813 cycle
814 ENDIF
815 dpos = 1
816 poselt_diag = poselt + int(begs_blr(ip)-1,8)*int(ldafs,8)
817 & + int(begs_blr(ip)-1,8)
818 DO i=1,diagsiz_sta
819 diag(dpos:dpos+diagsiz_dyn-1) =
820 & a(poselt_diag:poselt_diag+int(diagsiz_dyn-1,8))
821 dpos = dpos + diagsiz_dyn
822 poselt_diag = poselt_diag + int(ldafs,8)
823 ENDDO
825 & iw(ioldps+xxf),
826 & ip, diag)
827 ENDDO
828#if defined(BLR_MT)
829
830
831#endif
833 & .false., keep8, iflag, ierror, .true., .true.)
834#if defined(BLR_MT)
835
836#endif
837 IF (iflag.LT.0) GOTO 460
838 IF (uu.GT.0) THEN
839 DO ip=1,npartsass
840 nelim = begs_blr_tmp(ip+1)-begs_blr(ip+1)
841#if defined(BLR_MT)
842
843#endif
845 & iw(ioldps+xxf), 0, ip, blr_panel)
847 & keep(34))
848#if defined(BLR_MT)
849
850#endif
852 & ierror, ldafs, begs_blr_tmp,
853 & nb_blr, dkeep(8), keep(466), keep(473),
854 & blr_panel, ip,
855 & 'V', work, tau, jpvt, lwork, rwork,
856 & block, maxi_cluster, nelim,
857 & .false., 0, 0,
858 & 2, keep(483), keep8,
859 & end_i_in=npartsass, frswap=.true.
860 & )
861#if defined(BLR_MT)
862
863#endif
864 IF (iflag.LT.0) GOTO 440
865#if defined(BLR_MT)
866
867#endif
868 begs_blr_tmp(ip+1) = begs_blr(ip+1)
869#if defined(BLR_MT)
870
871#endif
872 ENDDO
873#if defined(BLR_MT)
874
875#endif
876 440 CONTINUE
877 ENDIF
878 460 CONTINUE
879#if defined(BLR_MT)
880
881#endif
882 IF (uu.GT.0) THEN
883 deallocate(begs_blr_tmp)
884 ENDIF
885 IF (iflag.LT.0) GOTO 500
886 ENDIF
887 IF (
888 & (keep(486).EQ.2)
889 &
890 & ) THEN
892 & begs_blr)
893 ENDIF
894 ENDIF
895 IF (ooc_effective_on_front) THEN
896 strat = strat_write_max
897 monbloc%Last = .true.
898 monbloc%LastPiv = iw(ioldps+1+xsize)
899 last_call = .true.
901 & ( strat, typefile,
902 & a(poselt), lafac, monbloc,
903 & nextpiv2bewritten, idummy,
904 & iw(ioldps), liwfac,
905 & myid, keep8(31), iflag_ooc, last_call )
906 IF (iflag_ooc .LT. 0 ) THEN
907 iflag = iflag_ooc
908 IF (iflag .LT. 0) GOTO 500
909 ENDIF
911 & ioldps, iw, liw, monbloc , nfront, keep)
912 ENDIF
913 GOTO 600
914 480 CONTINUE
915 500 CONTINUE
917 600 CONTINUE
918 IF(allocated(ipiv)) DEALLOCATE( ipiv )
919 IF (allocated(diag_orig)) DEALLOCATE(diag_orig)
920 IF (lr_activated) THEN
921 IF (iflag.GE.0) THEN
923 DO ip=1,npartsass
925 & iw(ioldps+xxf), 0, ip, blr_panel)
927 & )
928 ENDDO
930 ENDIF
931 IF (allocated(rwork)) DEALLOCATE(rwork)
932 IF (allocated(work)) DEALLOCATE(work)
933 IF (allocated(tau)) DEALLOCATE(tau)
934 IF (allocated(jpvt)) DEALLOCATE(jpvt)
935 IF (allocated(block)) DEALLOCATE(block)
936 IF (associated(acc_lua)) THEN
937 IF (keep(480).GE.3) THEN
938 DO my_num=1,omp_num
940 ENDDO
941 ENDIF
942 DEALLOCATE(acc_lua)
943 ENDIF
944 IF (associated(begs_blr)) THEN
945 DEALLOCATE(begs_blr)
946 NULLIFY(begs_blr)
947 ENDIF
948 ENDIF
949 IF (keep(486).NE.0) THEN
950 IF (.NOT.lr_activated) THEN
952 ENDIF
953 ENDIF
954 IF (lr_activated.AND.keep(480).NE.0) THEN
955 IF (.NOT.
956 & (
957 & (keep(486).EQ.2)
958 & )
959 & ) THEN
961 & keep8, keep(34))
962 ENDIF
963 ENDIF
964 IF (lr_activated) THEN
965 IF (.NOT.
966 & (
967 & (keep(486).EQ.2)
968 & )
969 & ) THEN
971 & keep(34))
972 ENDIF
973 ENDIF
974 RETURN
subroutine cmumps_bdc_error(myid, slavef, comm, keep)
subroutine cmumps_update_parpiv_entries(inode, keep, parpiv, lparpiv, nb_postponed)
subroutine cmumps_ooc_pp_tryrelease_space(iwpos, ioldps, iw, liw, monbloc, nfront, keep)
subroutine get_cut(iwr, nass, ncb, lrgroups, npartscb, npartsass, cut)
subroutine, public cmumps_buf_test()
subroutine cmumps_fac_sq_ldlt(ibeg_block, iend_block, npiv, nfront, nass, inode, a, la, lda, poselt, keep, keep8, first_row_trsm, last_row_trsm, last_col_gemm, last_row_gemm, call_trsm, call_gemm, lr_activated, iw, liw, offset_iw)
subroutine cmumps_send_factored_blk(comm_load, ass_irecv, n, inode, fpere, iw, liw, ioldps, poselt, a, la, lda_fs, ibeg_block, iend, tipiv, lpiv, lastbl, nb_bloc_fac, comm, myid, bufr, lbufr, lbufr_bytes, nbfin, leaf, iflag, ierror, ipool, lpool, slavef, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, comp, ptrist, ptrast, ptlust_s, ptrfac, step, pimaster, pamaster, nstk_s, perm, procnode_steps, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, nelim, lr_activated, npartsass, current_blr_panel, blr_loru, lrgroups)
subroutine cmumps_fac_i_ldlt_niv2(diag_orig, sizediag_orig, gw_factcumul, nfront, nass, ibeg_block_to_send, ibeg_block, iend_block, nass2, tipiv, n, inode, iw, liw, a, la, nnegw, nb22t2w, nbtinyw, det_expw, det_mantw, det_signw, inopv, iflag, ioldps, poselt, uu, seuil, keep, keep8, pivsiz, dkeep, pivnul_list, lpn_list, pp_first2swap_l, pp_lastpanelondisk, pp_lastpivrptrindexfilled, pivot_option, inextpiv, iend_blr, lr_activated, ooc_effective_on_front)
subroutine cmumps_fac_mq_ldlt_niv2(iend_block, nass, npiv, inode, a, la, ldafs, poselt, ifinb, pivsiz, k219, pivot_option, iend_blr, lr_activated)
subroutine cmumps_blr_panel_lrtrsm(a, la, poselt, nfront, ibeg_block, nb_blr, blr_loru, current_blr, first_block, last_block, niv, sym, loru, lbandslave, iw, offset_iw, nass)
subroutine cmumps_blr_update_trailing_ldlt(a, la, poselt, iflag, ierror, nfront, begs_blr, nb_blr, current_blr, blr_l, nelim, iw2, block, maxi_cluster, npiv, niv, midblk_compress, toleps, tol_opt, kpercent)
subroutine cmumps_blr_upd_panel_left_ldlt(a, la, poselt, nfront, iwhandler, begs_blr, current_blr, nb_blr, npartsass, nelim, iw2, block, acc_lua, maxi_cluster, maxi_rank, niv, iflag, ierror, midblk_compress, toleps, tol_opt, kpercent_rmb, k480, k479, k478, kpercent_lua, kpercent, keep8, first_block)
subroutine cmumps_compress_panel(a, la, poselt, iflag, ierror, nfront, begs_blr, nb_blr, toleps, tol_opt, k473, blr_panel, current_blr, dir, work, tau, jpvt, lwork, rwork, block, maxi_cluster, nelim, lbandslave, npiv, ishift, niv, kpercent, keep8, k480, beg_i_in, end_i_in, frswap)
subroutine cmumps_decompress_panel(a, la, poselt, lda11, lda21, copy_dense_blocks, begs_blr_diag, begs_blr_first_offdiag, nb_blr, blr_panel, current_blr, dir, decomp_timer, beg_i_in, end_i_in, only_nelim_in, cbasm_tofix_in)
subroutine, public cmumps_blr_save_init(iwhandler, issym, ist2, isslave, nb_panels, begs_blr_l, begs_blr_col, nb_accesses_init, info)
subroutine, public cmumps_blr_save_begs_blr_dyn(iwhandler, begs_blr_dynamic)
subroutine, public cmumps_blr_init_front(iwhandler, info, mtk405)
subroutine, public cmumps_blr_save_diag_block(iwhandler, ipanel, d)
subroutine, public cmumps_blr_save_panel_loru(iwhandler, loru, ipanel, lrb_panel)
subroutine, public cmumps_blr_retrieve_panel_loru(iwhandler, loru, ipanel, thelrbpanel)
subroutine, public cmumps_blr_retrieve_begsblr_sta(iwhandler, begs_blr_static)
subroutine, public cmumps_blr_end_front(iwhandler, info1, keep8, k34, lrsolve_act_opt, mtk405)
subroutine, public cmumps_blr_free_all_panels(iwhandler, loru, keep8, k34)
subroutine upd_flop_facto_fr(nfront, nass, npiv, sym, niv)
subroutine upd_mry_lu_fr(nass, ncb, sym, nelim)
subroutine upd_mry_lu_lrgain(blr_panel, nbblocks)
subroutine upd_flop_frfronts(nfront, npiv, nass, sym, niv)
subroutine dealloc_blr_panel(blr_panel, iend, keep8, k34, ibeg_in)
subroutine dealloc_lrb(lrb_out, keep8, k34)
subroutine, public cmumps_ooc_io_lu_panel(strat, typefile, afac, lafac, monbloc, lnextpiv2bewritten, unextpiv2bewritten, iw, liwfac, myid, filesize, ierr, last_call)