37#if defined(BLR_MT)
38#endif
39
40 IMPLICIT NONE
41 INTEGER(8) :: LA, POSELT
42 INTEGER N, INODE, LIW, IFLAG, IERROR
43 INTEGER, INTENT(INOUT) :: NOFFW, NPVW, NBTINYW
44 INTEGER, INTENT(INOUT) :: DET_EXPW, DET_SIGNW
45 DOUBLE PRECISION, INTENT(INOUT) :: DET_MANTW
46 INTEGER IW( LIW )
47 DOUBLE PRECISION A( LA )
48 INTEGER MYID, SLAVEF, IOLDPS
49 INTEGER KEEP( 500 )
50 INTEGER(8) KEEP8(150)
51 INTEGER PROCNODE_STEPS( KEEP(28) ), STEP(N)
52 DOUBLE PRECISION UU, SEUIL
53 LOGICAL AVOID_DELAYED
54 INTEGER ETATASS, IWPOS
55 INTEGER LPN_LIST
56 INTEGER PIVNUL_LIST(LPN_LIST)
57 DOUBLE PRECISION DKEEP(230)
58 INTEGER :: LRGROUPS(N), PERM(N)
59 INTEGER INOPV, IFINB, NFRONT, NPIV, IBEG_BLOCK, IEND_BLOCK
60 INTEGER NASS, NBKJIB_ORIG, XSIZE
61 INTEGER NBLR_ORIG, IBEG_BLR, IEND_BLR
62 INTEGER Inextpiv
63 INTEGER LAST_ROW, LAST_COL, FIRST_COL
64 LOGICAL CALL_LTRSM, CALL_UTRSM
65 DOUBLE PRECISION UUTEMP
66 LOGICAL STATICMODE
67 DOUBLE PRECISION SEUIL_LOC
68 INTEGER PIVOT_OPTION
69 INTEGER LRTRSM_OPTION
70 INTEGER(8) :: LAFAC
71 INTEGER LIWFAC, STRAT, LNextPiv2beWritten,
72 & UNextPiv2beWritten, IFLAG_OOC,
73 & PP_FIRST2SWAP_L, PP_FIRST2SWAP_U,
74 & PP_LastPIVRPTRFilled_L,
75 & PP_LastPIVRPTRFilled_U
76 INTEGER TYPEF_LOC
77 TYPE(IO_BLOCK) :: MonBloc
78 LOGICAL LAST_CALL
79 INTEGER PARPIV_T1
80 INTEGER CURRENT_BLR
81 LOGICAL LR_ACTIVATED
82 LOGICAL COMPRESS_CB, COMPRESS_PANEL
83 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR,
84 & OOC_EFFECTIVE_ON_FRONT,
85 & OOC_EFF_AND_WRITE_BYPANEL
86 INTEGER :: K473_LOC
87 INTEGER FIRST_BLOCK, LAST_BLOCK
88 INTEGER INFO_TMP(2), MAXI_RANK
89 INTEGER HF, NPARTSASS, NPARTSCB, NB_BLR
90 INTEGER MAXI_CLUSTER, LWORK, NELIM, NELIM_LOC
91 INTEGER :: IROW_L, NVSCHUR
92 INTEGER, POINTER, DIMENSION(:) :: PTDummy
93 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR
94 TYPE(LRB_TYPE), POINTER, DIMENSION(:,:) :: CB_LRB
95 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: ACC_LUA
96 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: BLR_U, BLR_L
97 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_TMP
98 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: BLR_PANEL
99 DOUBLE PRECISION, POINTER, DIMENSION(:) :: DIAG
100 INTEGER :: DIAGSIZ_STA, DIAGSIZ_DYN, DPOS, LorU, I, MEM, MEM_TOT
101 INTEGER(8) :: POSELT_DIAG
102 CHARACTER(len=1) :: DIR
103 DOUBLE PRECISION, ALLOCATABLE :: WORK(:), TAU(:)
104 INTEGER, ALLOCATABLE :: JPVT(:)
105 DOUBLE PRECISION, ALLOCATABLE :: RWORK(:)
106 DOUBLE PRECISION, ALLOCATABLE :: BLOCK(:,:)
107 INTEGER :: allocok,J
108 INTEGER :: OMP_NUM
109 INTEGER :: IP
110 INTEGER(8) :: UPOS, LPOS
111 INTEGER :: MY_NUM
112 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: NEXT_BLR_U, NEXT_BLR_L
113 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_STATIC
114 DOUBLE PRECISION :: ZERO
115 parameter(zero=0.0d0)
116 include 'mumps_headers.h'
117 first_block = -99999
118 last_block = -99999
119 ip=0
120 IF (keep(206).GE.1) THEN
121 inextpiv = 1
122 ELSE
123 inextpiv = 0
124 ENDIF
125 inopv = 0
126 seuil_loc = seuil
127 IF(keep(97) .EQ. 0) THEN
128 staticmode = .false.
129 ELSE
130 staticmode = .true.
131 ENDIF
132 IF (avoid_delayed) THEN
133 staticmode = .true.
134 uutemp=uu
135 seuil_loc =
max(seuil,epsilon(seuil))
136 ELSE
137 uutemp=uu
138 ENDIF
139 pivot_option = keep(468)
140 lrtrsm_option = keep(475)
141 lafac = -9999_8
142 xsize = keep(ixsz)
143 nfront = iw(ioldps+xsize)
144 nass = iabs(iw(ioldps+2+xsize))
145 iw(ioldps+3+xsize) = -99999
146 lr_activated = .false.
147 compress_panel = .false.
148 compress_cb = .false.
149 NULLIFY(ptdummy)
150 NULLIFY(begs_blr)
151 NULLIFY(cb_lrb)
152 NULLIFY(acc_lua)
153 NULLIFY(blr_u)
154 NULLIFY(blr_l)
155 NULLIFY(begs_blr_tmp)
156 NULLIFY(blr_panel)
157 NULLIFY(diag)
158 compress_panel = (iw(ioldps+xxlr).GE.2)
159 compress_cb = ((iw(ioldps+xxlr).EQ.1).OR.
160 & (iw(ioldps+xxlr).EQ.3))
161 lr_activated = (iw(ioldps+xxlr).GT.0)
162 IF (compress_cb.AND.(.NOT.compress_panel)) THEN
163 k473_loc = 1
164 ELSE
165 k473_loc = keep(473)
166 ENDIF
167 k473_loc = keep(473)
168 oocwrite_compatible_with_blr =
169 & ( .NOT.lr_activated.OR.(.NOT.compress_panel).OR.
170 & (keep(486).NE.2)
171 & )
172 ooc_effective_on_front= ((keep(201).EQ.1).AND.
173 & oocwrite_compatible_with_blr)
175 & lr_activated, parpiv_t1)
176 IF (uutemp.EQ.zero) THEN
177 pivot_option=0
178 ELSE IF (parpiv_t1.NE.0) THEN
179 pivot_option =
min(pivot_option,2)
180 ENDIF
181 IF (lr_activated) THEN
182 IF (lrtrsm_option.EQ.3) THEN
183 pivot_option =
min(pivot_option,1)
184 ELSEIF (lrtrsm_option.EQ.2) THEN
185 pivot_option =
min(pivot_option, 2)
186 ENDIF
187 ENDIF
188 IF (pivot_option.LE.1) THEN
189 parpiv_t1 = 0
190 ENDIF
191 IF (nass.LT.keep(4)) THEN
192 nbkjib_orig = nass
193 ELSE IF (nass .GT. keep(3)) THEN
194 nbkjib_orig =
min( keep(6), nass )
195 ELSE
196 nbkjib_orig =
min( keep(5), nass )
197 ENDIF
198 IF (.not.lr_activated) THEN
199 nblr_orig = keep(420)
200 ELSE
201 nblr_orig = -9999
202 ENDIF
203 IF ((keep(114).EQ.1) .AND.
204 & (keep(116).GT.0) .AND. ((nfront-nass-keep(253)).GT.0)
205 & ) THEN
206 irow_l = ioldps+6+xsize+nass
208 & n,
209 & nfront-nass-keep(253),
210 & keep(116),
211 & iw(irow_l), perm,
212 & nvschur )
213 ELSE
214 nvschur = 0
215 ENDIF
216 iend_block = 0
217 iend_blr = 0
218 current_blr = 0
220 liwfac = iw(ioldps+xxi)
221 IF ( ooc_effective_on_front ) THEN
222 lnextpiv2bewritten = 1
223 unextpiv2bewritten = 1
224 pp_first2swap_l = lnextpiv2bewritten
225 pp_first2swap_u = unextpiv2bewritten
226 monbloc%LastPanelWritten_L = 0
227 monbloc%LastPanelWritten_U = 0
228 pp_lastpivrptrfilled_l = 0
229 pp_lastpivrptrfilled_u = 0
230 monbloc%INODE = inode
231 monbloc%MASTER = .true.
232 monbloc%Typenode = 1
233 monbloc%NROW = nfront
234 monbloc%NCOL = nfront
235 monbloc%NFS = nass
236 monbloc%Last = .false.
237 monbloc%LastPiv = -88877
238 NULLIFY(monbloc%INDICES)
239 ENDIF
240 IF (lr_activated) THEN
241 IF (keep(405) .EQ. 1) THEN
242
244
245 ELSE
247 ENDIF
248 ELSE IF (keep(486).NE.0) THEN
249 ENDIF
250 ooc_eff_and_write_bypanel = ( (pivot_option.GE.3) .AND.
251 & ooc_effective_on_front )
252 hf = 6 + iw(ioldps+5+xsize)+xsize
253 IF (lr_activated) THEN
254 CALL get_cut(iw(ioldps+hf:ioldps+hf+nfront-1), nass,
255 & nfront-nass, lrgroups, npartscb,
256 & npartsass, begs_blr)
257 CALL regrouping2(begs_blr, npartsass, nass, npartscb,
258 & nfront-nass, keep(488), .false., keep(472))
259 nb_blr = npartsass + npartscb
260 call max_cluster(begs_blr,nb_blr,maxi_cluster)
261 maxi_rank = keep(479)*maxi_cluster
262 lwork = maxi_cluster*maxi_cluster
263 omp_num = 1
264#if defined(BLR_MT)
265
266#endif
267 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
268 & rwork(2*maxi_cluster*omp_num),
269 & tau(maxi_cluster*omp_num),
270 & jpvt(maxi_cluster*omp_num),
271 & work(lwork*omp_num),
272 & stat=allocok)
273 IF (allocok > 0) THEN
274 iflag = -13
275 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
276 GOTO 490
277 ENDIF
278 ALLOCATE(acc_lua(omp_num),stat=allocok)
279 IF (allocok > 0) THEN
280 iflag = -13
281 ierror = omp_num
282 GOTO 490
283 ENDIF
284 IF (keep(480).GE.3) THEN
285 DO my_num=1,omp_num
286 CALL alloc_lrb(acc_lua(my_num), maxi_rank,
287 & maxi_cluster, maxi_cluster, .true.,
288 & iflag, ierror, keep8)
289 IF (iflag.LT.0) GOTO 490
290 acc_lua(my_num)%K = 0
291 ENDDO
292 ENDIF
293 ENDIF
294 IF (lr_activated.AND.
295 & (keep(480).NE.0
296 & .OR.
297 & (
298 & (keep(486).EQ.2)
299 & )
300 & .OR.compress_cb
301 & )) THEN
302 info_tmp(1) = iflag
303 info_tmp(2) = ierror
305 & .false.,
306 & .false.,
307 & .false.,
308 & npartsass,
309 & begs_blr, ptdummy,
310 & huge(npartsass),
311 & info_tmp)
312 iflag = info_tmp(1)
313 ierror = info_tmp(2)
314 IF (iflag.LT.0) GOTO 500
315 ENDIF
316 IF (compress_cb.AND.npartscb.GT.0) THEN
317 allocate(cb_lrb(npartscb,npartscb),stat=allocok)
318 IF (allocok > 0) THEN
319 iflag = -13
320 ierror = npartscb*npartscb
321 GOTO 490
322 ENDIF
324 ENDIF
325 DO WHILE (iend_blr < nass )
326 current_blr = current_blr + 1
327 ibeg_blr = iw(ioldps+1+keep(ixsz)) + 1
328 IF (.NOT. lr_activated) THEN
329 iend_blr =
min(iend_blr + nblr_orig, nass)
330 ELSE
331 iend_blr = begs_blr(current_blr+1)-1
332 begs_blr( current_blr ) = ibeg_blr
333 IF ( iend_blr - ibeg_blr + 1 .GT. maxi_cluster ) THEN
334 maxi_cluster = iend_blr - ibeg_blr + 1
335 lwork = maxi_cluster*maxi_cluster
336 DEALLOCATE(block, work, rwork, tau, jpvt)
337 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
338 & rwork(2*maxi_cluster*omp_num),
339 & tau(maxi_cluster*omp_num),
340 & jpvt(maxi_cluster*omp_num),
341 & work(lwork*omp_num),stat=allocok)
342 IF (allocok > 0) THEN
343 iflag = -13
344 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
345 GOTO 490
346 ENDIF
347 IF (keep(480).GE.3) THEN
348 DO my_num=1,omp_num
350 CALL alloc_lrb(acc_lua(my_num), maxi_rank,
351 & maxi_cluster, maxi_cluster, .true.,
352 & iflag, ierror, keep8)
353 IF (iflag.LT.0) GOTO 500
354 acc_lua(my_num)%K = 0
355 ENDDO
356 ENDIF
357 ENDIF
358 ENDIF
359 IF (lr_activated) THEN
360 IF (keep(480).GE.5) THEN
361 IF (current_blr.EQ.1) THEN
362 ALLOCATE(blr_u(nb_blr-current_blr),stat=allocok)
363 IF (allocok > 0) THEN
364 iflag = -13
365 ierror = nb_blr-current_blr
366 GOTO 490
367 ENDIF
368 ALLOCATE(blr_l(nb_blr-current_blr),stat=allocok)
369 IF (allocok > 0) THEN
370 iflag = -13
371 ierror = nb_blr-current_blr
372 GOTO 490
373 ENDIF
374 IF (nb_blr.GT.current_blr) THEN
375 blr_u(1:nb_blr-current_blr)%ISLR=.false.
377 & iw(ioldps+xxf),
378 & 1,
379 & current_blr, blr_u)
380 blr_l(1:nb_blr-current_blr)%ISLR=.false.
382 & iw(ioldps+xxf),
383 & 0,
384 & current_blr, blr_l)
385 ENDIF
386 ELSE
387 IF (nb_blr.GT.current_blr) THEN
389 & iw(ioldps+xxf),
390 & 1,
391 & current_blr, blr_u)
393 & iw(ioldps+xxf),
394 & 0,
395 & current_blr, blr_l)
396 ENDIF
397 ENDIF
398 IF (current_blr.LT.npartsass) THEN
399 ALLOCATE(next_blr_u(nb_blr-current_blr-1),stat=allocok)
400 IF (allocok > 0) THEN
401 iflag = -13
402 ierror = nb_blr-current_blr-1
403 GOTO 490
404 ENDIF
405 ALLOCATE(next_blr_l(nb_blr-current_blr-1),stat=allocok)
406 IF (allocok > 0) THEN
407 iflag = -13
408 ierror = nb_blr-current_blr-1
409 GOTO 490
410 ENDIF
411 IF (nb_blr.GT.current_blr+1) THEN
413 & iw(ioldps+xxf),
414 & 1,
415 & current_blr+1, next_blr_u)
417 & iw(ioldps+xxf),
418 & 0,
419 & current_blr+1, next_blr_l)
420 ENDIF
421 ENDIF
422 ELSE
423 ALLOCATE(blr_u(nb_blr-current_blr),stat=allocok)
424 IF (allocok > 0) THEN
425 iflag = -13
426 ierror = nb_blr-current_blr
427 GOTO 490
428 ENDIF
429 ALLOCATE(blr_l(nb_blr-current_blr),stat=allocok)
430 IF (allocok > 0) THEN
431 iflag = -13
432 ierror = nb_blr-current_blr
433 GOTO 490
434 ENDIF
435 ENDIF
436 ENDIF
437 DO WHILE (iend_block < iend_blr )
438 ibeg_block = iw(ioldps+1+keep(ixsz)) + 1
439 IF (keep(405).EQ.0) THEN
440 keep(425)=
max(keep(425),iend_block-ibeg_block)
441 ELSE
442
443 keep(425)=
max(keep(425),iend_block-ibeg_block)
444
445 ENDIF
446 iend_block =
min(iend_block + nbkjib_orig, iend_blr)
447 50 CONTINUE
449 & ibeg_block,iend_block,n,inode,
450 & iw,liw,a,la,inopv,noffw,nbtinyw,
451 & det_expw, det_mantw, det_signw,
452 & iflag,ioldps,poselt,uu,seuil_loc,keep,keep8,
453 & dkeep(1),pivnul_list(1),lpn_list,
454 & pp_first2swap_l, monbloc%LastPanelWritten_L,
455 & pp_lastpivrptrfilled_l,
456 & pp_first2swap_u, monbloc%LastPanelWritten_U,
457 & pp_lastpivrptrfilled_u,
458 & pivot_option, lr_activated, iend_blr,
459 & inextpiv, ooc_effective_on_front,
460 & nvschur, parpiv_t1
461 & )
462 IF (iflag.LT.0) GOTO 500
463 IF (inopv.EQ.1) THEN
464 IF(staticmode) THEN
465 inopv = -1
466 GOTO 50
467 ENDIF
468 ELSE IF ( inopv.LE.0 ) THEN
469 inopv = 0
470 IF (pivot_option.GE.3) THEN
471 last_col = nfront
472 ELSEIF (pivot_option.EQ.2) THEN
473 last_col = nass
474 ELSE
475 last_col = iend_blr
476 ENDIF
478 & nfront, nass, iw(ioldps+1+xsize),
479 & last_col, a, la, poselt, ifinb,
480 & lr_activated
481 & )
482 iw(ioldps+1+xsize) = iw(ioldps+1+xsize) + 1
483 IF (ifinb.EQ.0) THEN
484 GOTO 50
485 ENDIF
486 ENDIF
487 IF ( ooc_eff_and_write_bypanel ) THEN
488 monbloc%LastPiv= iw(ioldps+1+xsize)
489 strat = strat_try_write
490 last_call = .false.
492 & ( strat, typef_u,
493 & a(poselt), lafac, monbloc,
494 & lnextpiv2bewritten, unextpiv2bewritten,
495 & iw(ioldps), liwfac,
496 & myid, keep8(31), iflag_ooc,last_call )
497 IF (iflag_ooc < 0 ) THEN
498 iflag=iflag_ooc
499 GOTO 500
500 ENDIF
501 ENDIF
502 npiv = iw(ioldps+1+xsize)
503 IF ( iend_blr .GT. iend_block ) THEN
504 IF (pivot_option.GE.3) THEN
505 last_col = nfront
506 ELSEIF (pivot_option.EQ.2) THEN
507 last_col = nass
508 ELSE
509 last_col = iend_blr
510 ENDIF
512 & npiv, nfront, iend_blr, last_col,
513 & a, la, poselt,
514 & -66666,
515 & .true., .false., .true.,
516 & .false.,
517 & lr_activated
518 & )
519 ENDIF
520 END DO
521 npiv = iw(ioldps+1+xsize)
522 IF (.NOT. lr_activated
523 & .OR. (.NOT. compress_panel)
524 & ) THEN
525 IF (pivot_option.EQ.4) THEN
526 last_row = nfront
527 ELSE
528 last_row = nass
529 ENDIF
530 IF (pivot_option.GE.3) THEN
531 last_col = nfront
532 ELSE
533 last_col = nass
534 ENDIF
535 IF (iend_blr.LT.last_row) THEN
537 & npiv, nfront, last_row, last_col,
538 & a, la, poselt, iend_blr, .true., (pivot_option.LT.2),
539 & .true., .false.,
540 & lr_activated)
541 ENDIF
542 ELSE
543 nelim = iend_blr - npiv
544 IF (nelim .EQ. iend_blr - ibeg_blr + 1) THEN
545 IF (keep(480).GE.2
546 & .OR.
547 & (
548 & (keep(486).EQ.2)
549 & )
550 & ) THEN
551 DO j=1,nb_blr-current_blr
552 blr_u(j)%M=0
553 blr_u(j)%N=0
554 blr_u(j)%K=0
555 blr_u(j)%ISLR=.false.
556 NULLIFY(blr_u(j)%Q)
557 NULLIFY(blr_u(j)%R)
558 ENDDO
560 & iw(ioldps+xxf),
561 & 1,
562 & current_blr, blr_u)
563 DO j=1,nb_blr-current_blr
564 blr_l(j)%M=0
565 blr_l(j)%N=0
566 blr_l(j)%K=0
567 blr_l(j)%ISLR=.false.
568 NULLIFY(blr_l(j)%Q)
569 NULLIFY(blr_l(j)%R)
570 ENDDO
572 & iw(ioldps+xxf),
573 & 0,
574 & current_blr, blr_l)
575 NULLIFY(blr_l)
576 NULLIFY(blr_u)
577 IF (keep(480).GE.2 .AND. iend_blr.LT.nass) THEN
578 IF (lrtrsm_option.EQ.3) THEN
579 first_block = 1
580 ELSE
581 first_block = npartsass-current_blr
582 ENDIF
583#if defined(BLR_MT)
584
585#endif
587 & nfront, iw(ioldps+xxf), 0,
588 & begs_blr, begs_blr, current_blr, acc_lua,
589 & nb_blr, npartsass, nelim,
590 & 1, 0,
591 & .false., iflag, ierror, 0,
592 & keep(481), dkeep(11), keep(466), keep(477),
593 & keep(480), keep(479), keep(478), keep(476),
594 & keep(483), maxi_cluster, maxi_rank,
595 & keep(474), 0, blr_u,
596 & keep8,
597 & first_block=first_block)
598 IF (iflag.LT.0) GOTO 900
600 & nfront, iw(ioldps+xxf), 1,
601 & begs_blr, begs_blr, current_blr, acc_lua,
602 & nb_blr, npartsass, nelim,
603 & 1, 0,
604 & .false., iflag, ierror, 0,
605 & keep(481), dkeep(11), keep(466), keep(477),
606 & keep(480), keep(479), keep(478), keep(476),
607 & keep(483), maxi_cluster, maxi_rank,
608 & keep(474), 0, blr_u,
609 & keep8,
610 & first_block=first_block)
611 900 CONTINUE
612#if defined(BLR_MT)
613
614#endif
615 IF (iflag.LT.0) GOTO 500
616 ENDIF
617 ENDIF
618 IF (keep(486).EQ.3) THEN
619 IF (keep(480).EQ.0) THEN
620 DEALLOCATE(blr_u,blr_l)
621 NULLIFY(blr_l)
622 NULLIFY(blr_u)
623 ENDIF
624 ENDIF
625 GOTO 100
626 ENDIF
627 IF (pivot_option.GE.3) THEN
628 first_col = nfront
629 ELSEIF (pivot_option.EQ.2) THEN
630 first_col = nass
631 ELSE
632 first_col = iend_blr
633 ENDIF
634 IF (lrtrsm_option.EQ.3) THEN
635 last_col = iend_blr
636 ELSEIF (lrtrsm_option.EQ.2) THEN
637 last_col = nass
638 ELSE
639 last_col = nfront
640 ENDIF
641 call_ltrsm = (lrtrsm_option.EQ.0)
642 call_utrsm = (last_col-first_col.GT.0)
643 IF ((iend_blr.LT.nfront) .AND.
644 & (call_ltrsm.OR.call_utrsm)) THEN
646 & npiv, nfront, nfront,
647 & last_col,
648 & a, la, poselt,
649 & first_col, call_ltrsm,
650 & call_utrsm, .false.,
651 & .false.,
652 & lr_activated)
653 ENDIF
654#if defined(BLR_MT)
655#endif
656#if defined(BLR_MT)
657
658#endif
660 & ierror,
661 & nfront,
662 & begs_blr, nb_blr, dkeep(8), keep(466), k473_loc,
663 & blr_u, current_blr,
664 & 'H', work, tau, jpvt, lwork, rwork,
665 & block, maxi_cluster, nelim,
666 & .false., 0, 0,
667 & 1, keep(483), keep8,
668 & k480=keep(480)
669 & )
670#if defined(BLR_MT)
671
672#endif
673 IF (iflag.LT.0) GOTO 400
675 & nfront,
676 & begs_blr, nb_blr, dkeep(8), keep(466), k473_loc, blr_l,
677 & current_blr,
678 & 'V', work, tau, jpvt, lwork, rwork,
679 & block, maxi_cluster, nelim,
680 & .false., 0, 0,
681 & 1, keep(483), keep8,
682 & k480=keep(480)
683 & )
684#if defined(BLR_MT)
685
686
687#endif
688 IF (keep(480).NE.0
689 & .OR.
690 & (
691 & (keep(486).EQ.2)
692 & )
693 & ) THEN
694 IF (keep(480).LT.5) THEN
696 & iw(ioldps+xxf),
697 & 1,
698 & current_blr, blr_u)
700 & iw(ioldps+xxf),
701 & 0,
702 & current_blr, blr_l)
703 ENDIF
704 ENDIF
705#if defined(BLR_MT)
706
707
708#endif
709 IF (iflag.LT.0) GOTO 400
710 IF (lrtrsm_option.GT.0) THEN
712 & ibeg_blr,
713 & nb_blr, blr_l, current_blr, current_blr+1,
714 & nb_blr, 1, 0, 0, .false.)
715 IF (pivot_option.LT.3.AND.lrtrsm_option.GE.2) THEN
716 IF (pivot_option.LE.1.AND.lrtrsm_option.EQ.3) THEN
717 first_block = current_blr+1
718 ELSE
719 first_block = npartsass+1
720 ENDIF
722 & ibeg_blr, nb_blr, blr_u,
723 & current_blr, first_block, nb_blr,
724 & 1, 0, 1, .false.)
725#if defined(BLR_MT)
726
727#endif
729 & a, la, poselt, iflag, ierror, nfront,
730 & begs_blr, current_blr, blr_u, nb_blr,
731 & first_block, ibeg_blr, npiv, nelim)
732 ENDIF
733 ENDIF
734#if defined(BLR_MT)
735
736#endif
737 IF (iflag.LT.0) GOTO 400
738 IF (keep(480).GE.2) THEN
739 upos = poselt+int(begs_blr(current_blr)-1,8)*int(nfront,8)
740 & +int(begs_blr(current_blr+1)-nelim-1,8)
741 lpos = poselt+int(begs_blr(current_blr+1)-1,8)*int(nfront,8)
742 & +int(begs_blr(current_blr+1)-nelim-1,8)
744 & lpos, iflag, ierror, nfront, nfront,
745 & begs_blr, current_blr, blr_l, nb_blr,
746 & current_blr+1, nelim, 'N')
747 IF (iflag.LT.0) GOTO 444
748 IF (iend_blr.LT.nass) THEN
749 IF (lrtrsm_option.EQ.3) THEN
750 first_block = 1
751 ELSE
752 first_block = npartsass-current_blr
753 ENDIF
755 & nfront, iw(ioldps+xxf), 0,
756 & begs_blr, begs_blr, current_blr, acc_lua,
757 & nb_blr, npartsass, nelim,
758 & 1, 0,
759 & .false., iflag, ierror, 0,
760 & keep(481), dkeep(11), keep(466), keep(477),
761 & keep(480), keep(479), keep(478), keep(476),
762 & keep(483), maxi_cluster, maxi_rank,
763 & keep(474), 0, blr_u,
764 & keep8,
765 & first_block=first_block)
766 IF (iflag.LT.0) GOTO 442
768 & nfront, iw(ioldps+xxf), 1,
769 & begs_blr, begs_blr, current_blr, acc_lua,
770 & nb_blr, npartsass, nelim,
771 & 1, 0,
772 & .false., iflag, ierror, 0,
773 & keep(481), dkeep(11), keep(466), keep(477),
774 & keep(480), keep(479), keep(478), keep(476),
775 & keep(483), maxi_cluster, maxi_rank,
776 & keep(474), 0, blr_u,
777 & keep8,
778 & first_block=first_block)
779 442 CONTINUE
780 ENDIF
781 444 CONTINUE
782 ELSE
784 & iflag, ierror, nfront,
785 & begs_blr, begs_blr, current_blr, blr_l, nb_blr,
786 & blr_u, nb_blr,
787 & nelim,.false., 0,
788 & 1, 0,
789 & keep(481), dkeep(11), keep(466), keep(477)
790 & )
791 ENDIF
792#if defined(BLR_MT)
793
794#endif
795 IF (iflag.LT.0) GOTO 400
796 IF (keep(486).NE.2) THEN
797 last_block = nb_blr
798 ELSEIF(uu.GT.0) THEN
799 last_block = npartsass
800 ELSE
801 last_block = current_blr
802 ENDIF
803 IF (lrtrsm_option.GT.0) THEN
804 first_block = current_blr+1
806 & nfront, .true.,
807 & begs_blr(current_blr),
808 & begs_blr(current_blr+1),
809 & nb_blr, blr_l, current_blr, 'V', 1,
810 & beg_i_in=first_block, end_i_in=last_block)
811#if defined(BLR_MT)
812#endif
813 ENDIF
814 IF (lrtrsm_option.GE.2) THEN
815 IF (lrtrsm_option.EQ.2) THEN
816 first_block = npartsass+1
817 ELSE
818 first_block = current_blr+1
819 ENDIF
821 & nfront, .true.,
822 & begs_blr(current_blr),
823 & begs_blr(current_blr+1),
824 & nb_blr, blr_u, current_blr, 'H', 1,
825 & beg_i_in=first_block, end_i_in=last_block)
826 ENDIF
827 400 CONTINUE
828#if defined(BLR_MT)
829
830#endif
831 IF (iflag.LT.0) GOTO 500
832 IF (keep(486).EQ.3) THEN
833 IF (keep(480).EQ.0) THEN
835 & keep(34))
837 & keep(34))
838 DEALLOCATE(blr_u,blr_l)
839 ENDIF
840 ENDIF
841 NULLIFY(blr_l)
842 NULLIFY(blr_u)
843 ENDIF
844 IF ( ooc_eff_and_write_bypanel ) THEN
845 IF (pivot_option.LT.4) THEN
846 typef_loc = typef_u
847 ELSE
849 ENDIF
850 monbloc%LastPiv= iw(ioldps+1+xsize)
851 strat = strat_try_write
852 last_call = .false.
854 & ( strat, typef_loc,
855 & a(poselt), lafac, monbloc,
856 & lnextpiv2bewritten, unextpiv2bewritten,
857 & iw(ioldps), liwfac,
858 & myid, keep8(31), iflag_ooc,last_call )
859 IF (iflag_ooc < 0 ) THEN
860 iflag=iflag_ooc
861 GOTO 500
862 ENDIF
863 ENDIF
864 100 CONTINUE
865 END DO
866 IF (lr_activated) THEN
867 ibeg_blr = iw(ioldps+1+keep(ixsz)) + 1
868 begs_blr( current_blr + 1 ) = ibeg_blr
869 IF (
870 & (keep(486).EQ.2)
871 & ) THEN
873 & begs_blr_static)
874 IF (uu.GT.0) THEN
875 allocate(begs_blr_tmp(nb_blr+1),stat=allocok)
876 IF (allocok > 0) THEN
877 iflag = -13
878 ierror = nb_blr+1
879 GOTO 500
880 ENDIF
881 DO ip=1,nb_blr+1
882 begs_blr_tmp(ip) = begs_blr_static(ip)
883 ENDDO
884 ENDIF
885 ENDIF
886 mem_tot = 0
887#if defined(BLR_MT)
888
889
890#endif
891 IF (
892 & (keep(486).EQ.2)
893 & ) THEN
894#if defined(BLR_MT)
895
896
897
898#endif
899 DO ip=1,npartsass
900 IF (iflag.LT.0) cycle
901 diagsiz_dyn = begs_blr(ip+1)-begs_blr(ip)
902 diagsiz_sta = begs_blr_static(ip+1)-begs_blr(ip)
903 mem = diagsiz_dyn*(2*diagsiz_sta-diagsiz_dyn)
904 mem_tot = mem_tot + mem
905 ALLOCATE(diag(mem), stat=allocok)
906 IF (allocok > 0) THEN
907 iflag = -13
908 ierror = mem
909 cycle
910 ENDIF
911 dpos = 1
912 poselt_diag = poselt + int(begs_blr(ip)-1,8)*int(nfront,8)
913 & + int(begs_blr(ip)-1,8)
914 DO i=1,diagsiz_sta
915 IF (i.LE.diagsiz_dyn) THEN
916 diag(dpos:dpos+diagsiz_sta-1) =
917 & a(poselt_diag:poselt_diag+int(diagsiz_sta-1,8))
918 dpos = dpos + diagsiz_sta
919 ELSE
920 diag(dpos:dpos+diagsiz_dyn-1) =
921 & a(poselt_diag:poselt_diag+int(diagsiz_dyn-1,8))
922 dpos = dpos + diagsiz_dyn
923 ENDIF
924 poselt_diag = poselt_diag + int(nfront,8)
925 ENDDO
927 & iw(ioldps+xxf),
928 & ip, diag)
929 ENDDO
930#if defined(BLR_MT)
931
932
933#endif
935 & (keep(405).NE.0), keep8, iflag, ierror, .true., .true.)
936#if defined(BLR_MT)
937
938#endif
939 IF (iflag.LT.0) GOTO 447
940 IF (uu.GT.0) THEN
941 DO ip=1,npartsass
942 nelim_loc = begs_blr_tmp(ip+1)-begs_blr(ip+1)
943 DO loru=0,1
945 & iw(ioldps+xxf), loru, ip, blr_panel)
946#if defined(BLR_MT)
947
948#endif
950 & keep(34))
951#if defined(BLR_MT)
952
953#endif
954 IF (loru.EQ.0) THEN
955 dir = 'V'
956 ELSE
957 dir = 'H'
958 ENDIF
960 & ierror, nfront, begs_blr_tmp,
961 & nb_blr, dkeep(8), keep(466), k473_loc,
962 & blr_panel, ip,
963 & dir, work, tau, jpvt, lwork, rwork,
964 & block, maxi_cluster, nelim_loc,
965 & .false., 0, 0,
966 & 1, keep(483), keep8,
967 & end_i_in=npartsass, frswap=.true.
968 & )
969#if defined(BLR_MT)
970
971#endif
972 IF (iflag.LT.0) GOTO 445
973 ENDDO
974#if defined(BLR_MT)
975
976
977#endif
978 begs_blr_tmp(ip+1) = begs_blr(ip+1)
979#if defined(BLR_MT)
980
981#endif
982 ENDDO
983#if defined(BLR_MT)
984
985#endif
986 445 CONTINUE
987 ENDIF
988 447 CONTINUE
989 ENDIF
990 IF (iflag .LT. 0) GOTO 450
991 IF (keep(480) .GE. 2) THEN
992#if defined(BLR_MT)
993
994#endif
996 & begs_blr_static)
997#if defined(BLR_MT)
998
999#endif
1001 & begs_blr_static, begs_blr_static,
1002 & npartscb, npartscb, npartsass, nass,
1003 & iw(ioldps+xxf),
1004 & 1, .false., iflag, ierror,
1005 & keep(481), dkeep(11), keep(466), keep(477),
1006 & acc_lua, keep(480),keep(479),keep(478),keep(476),
1007 & keep(484), maxi_cluster, maxi_rank,
1008 & keep(474), 0, blr_u,
1009 & .false.,
1010 & cb_lrb, keep8)
1011#if defined(BLR_MT)
1012
1013#endif
1014 ENDIF
1015 IF (iflag.LT.0) GOTO 450
1016#if defined(BLR_MT)
1017
1018#endif
1019 IF (compress_cb
1020 & .OR.
1021 & (
1022 & (keep(486).EQ.2)
1023 & )
1024 & ) THEN
1026 & begs_blr)
1027 ENDIF
1028 IF (compress_cb) THEN
1029 iend_blr = begs_blr(current_blr+2)
1030 IF ( iend_blr - ibeg_blr + 1 .GT. maxi_cluster ) THEN
1031 maxi_cluster = iend_blr - ibeg_blr + 1
1032 lwork = maxi_cluster*maxi_cluster
1033 DEALLOCATE(block, work, rwork, tau, jpvt)
1034 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
1035 & rwork(2*maxi_cluster*omp_num),
1036 & tau(maxi_cluster*omp_num),
1037 & jpvt(maxi_cluster*omp_num),
1038 & work(lwork*omp_num),stat=allocok)
1039 IF (allocok > 0) THEN
1040 iflag = -13
1041 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
1042 ENDIF
1043 ENDIF
1044 ENDIF
1045#if defined(BLR_MT)
1046
1047
1048#endif
1049 IF (iflag.LT.0) GOTO 450
1050 IF (compress_cb) THEN
1052 & begs_blr, begs_blr, npartscb, npartscb, npartsass,
1053 & nfront-nass, nfront-nass, inode,
1054 & iw(ioldps+xxf), 0, 1, iflag, ierror,
1055 & dkeep(12), keep(466), keep(484), keep(489), cb_lrb,
1056 & work, tau, jpvt, lwork, rwork, block,
1057 & maxi_cluster, keep8,
1058 & -9999, -9999, -9999, keep(1),
1059 & nelim=nelim)
1060#if defined(BLR_MT)
1061
1062#endif
1063 ENDIF
1064 450 CONTINUE
1065#if defined(BLR_MT)
1066
1067#endif
1068 IF (
1069 & (
1070 & (keep(486).EQ.2)
1071 & )
1072 & .AND.uu.GT.0
1073 & ) THEN
1074 deallocate(begs_blr_tmp)
1075 ENDIF
1076 IF (iflag.LT.0) GOTO 500
1078 DO ip=1,npartsass
1079 DO loru=0,1
1081 & iw(ioldps+xxf), loru, ip, blr_panel)
1083 & )
1084 ENDDO
1085 ENDDO
1087 ENDIF
1088 IF ( (pivot_option.LT.4) .AND. (.NOT.lr_activated) ) THEN
1090 & nfront, nass, (pivot_option.LT.3), a, la, lafac, poselt,
1091 & iw, liw, ioldps, monbloc, myid, noffw,
1092 & det_expw, det_mantw, det_signw,
1093 & liwfac,
1094 & pp_first2swap_l, pp_first2swap_u,
1095 & lnextpiv2bewritten, unextpiv2bewritten,
1096 & pp_lastpivrptrfilled_l, pp_lastpivrptrfilled_u,
1097 &
1098 & xsize, seuil, uu, dkeep, keep8, keep, iflag,
1099 & ooc_effective_on_front, nvschur )
1100 ENDIF
1101 IF (keep(486).NE.0) THEN
1102 IF (.NOT.lr_activated) THEN
1104 ENDIF
1105 ENDIF
1106 IF ( ooc_effective_on_front ) THEN
1107 strat = strat_write_max
1108 monbloc%Last = .true.
1109 monbloc%LastPiv = iw(ioldps+1+xsize)
1110 last_call = .true.
1113 & a(poselt), lafac, monbloc,
1114 & lnextpiv2bewritten, unextpiv2bewritten,
1115 & iw(ioldps), liwfac,
1116 & myid, keep8(31), iflag_ooc, last_call )
1117 IF (iflag_ooc < 0 ) THEN
1118 iflag=iflag_ooc
1119 GOTO 500
1120 ENDIF
1122 & ioldps, iw, liw, monbloc , nfront, keep)
1123 ENDIF
1124 GOTO 600
1125 490 CONTINUE
1126 500 CONTINUE
1127 600 CONTINUE
1128 IF (lr_activated) THEN
1129 IF (allocated(work)) deallocate(work)
1130 IF (allocated(rwork)) DEALLOCATE(rwork)
1131 IF (allocated(tau)) deallocate(tau)
1132 IF (allocated(jpvt)) deallocate(jpvt)
1133 IF (allocated(block)) deallocate(block)
1134 IF (associated(acc_lua)) THEN
1135 IF (keep(480).GE.3) THEN
1136 DO my_num=1,omp_num
1137 CALL dealloc_lrb(acc_lua(my_num), keep8, keep(34))
1138 ENDDO
1139 ENDIF
1140 DEALLOCATE(acc_lua)
1141 NULLIFY(acc_lua)
1142 ENDIF
1143 IF (associated(begs_blr)) THEN
1144 DEALLOCATE(begs_blr)
1145 NULLIFY(begs_blr)
1146 ENDIF
1147 ENDIF
1148 IF (lr_activated.AND.(keep(480).NE.0)) THEN
1149 IF (.NOT.
1150 & (
1151 & (keep(486).EQ.2)
1152 & )
1153 & ) THEN
1155 & keep8, keep(34))
1156 ENDIF
1157 ENDIF
1158 IF (lr_activated) THEN
1159 IF (.NOT.
1160 & (
1161 & (keep(486).EQ.2)
1162 & )
1163 & .AND..NOT.compress_cb) THEN
1165 & keep(34), mtk405=keep(405))
1166 ENDIF
1167 ENDIF
1168 npvw = npvw + iw(ioldps+1+xsize)
subroutine dmumps_set_parpivt1(inode, nfront, nass1, keep, lr_activated, parpiv_t1)
subroutine dmumps_ooc_pp_tryrelease_space(iwpos, ioldps, iw, liw, monbloc, nfront, keep)
subroutine get_cut(iwr, nass, ncb, lrgroups, npartscb, npartsass, cut)
subroutine dmumps_fac_mq(ibeg_block, iend_block, nfront, nass, npiv, last_col, a, la, poselt, ifinb, lr_activated)
subroutine dmumps_fac_i(nfront, nass, last_row, ibeg_block, iend_block, n, inode, iw, liw, a, la, inopv, noffw, nbtinyw, det_expw, det_mantw, det_signw, iflag, ioldps, poselt, uu, seuil, keep, keep8, dkeep, pivnul_list, lpn_list pp_first2swap_l, pp_lastpanelondisk_l, pp_lastpivrptrfilled_l, pp_first2swap_u, pp_lastpanelondisk_u, pp_lastpivrptrfilled_u, pivot_option, lr_activated, iend_blr, inextpiv, ooc_effective_on_front, nvschur, parpiv_t1, tipiv)
subroutine dmumps_get_size_schur_in_front(n, ncb, size_schur, row_indices, perm, nvschur)
subroutine dmumps_fac_sq(ibeg_block, iend_block, npiv, nfront, last_row, last_col, a, la, poselt, first_col, call_ltrsm, call_utrsm, call_gemm, with_comm_thread, lr_activated)
subroutine dmumps_fac_fr_update_cbrows(inode, nfront, nass, call_utrsm, a, la, lafac, poselt, iw, liw, ioldps, monbloc, myid, noffw, det_expw, det_mantw, det_signw, liwfac, pp_first2swap_l, pp_first2swap_u, lnextpiv2bewritten, unextpiv2bewritten, pp_lastpivrptrfilled_l, pp_lastpivrptrfilled_u xsize, seuil, uu, dkeep, keep8, keep, iflag, ooc_effective_on_front, nvschur)
subroutine dmumps_blr_upd_nelim_var_u(a, la, poselt, iflag, ierror, nfront, begs_blr, current_blr, blr_u, nb_blr, first_block, ibeg_blr, npiv, nelim)
subroutine dmumps_blr_update_trailing(a, la, poselt, iflag, ierror, nfront, begs_blr_l, begs_blr_u, current_blr, blr_l, nb_blr_l, blr_u, nb_blr_u, nelim, lbandslave, ishift, niv, sym, midblk_compress, toleps, tol_opt, kpercent)
subroutine dmumps_blr_upd_panel_left(a, la, poselt, nfront, iwhandler, loru, begs_blr, begs_blr_u, current_blr, acc_lua, nb_blr, npartsass, nelim, niv, sym, lbandslave, iflag, ierror, ishift, midblk_compress, toleps, tol_opt, kpercent_rmb, k480, k479, k478, kpercent_lua, kpercent, maxi_cluster, maxi_rank, k474, fsorcb, blr_u_col, keep8, first_block, beg_i_in, end_i_in)
subroutine dmumps_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 dmumps_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 dmumps_blr_upd_cb_left(a, la, poselt, nfront, begs_blr, begs_blr_u, nb_rows, nb_incb, nb_inasm, nass, iwhandler, niv, lbandslave, iflag, ierror, midblk_compress, toleps, tol_opt, kpercent_rmb, acc_lua, k480, k479, k478, kpercent_lua, kpercent, maxi_cluster, maxi_rank, k474, fsorcb, blr_u_col, compress_cb, cb_lrb, keep8)
subroutine dmumps_compress_cb(a, la, poselt, lda, begs_blr, begs_blr_u, nb_rows, nb_cols, nb_inasm, nrows, ncols, inode, iwhandler, sym, niv, iflag, ierror, toleps, tol_opt, kpercent, k489, cb_lrb, work, tau, jpvt, lwork, rwork, block, maxi_cluster, keep8, nfs4father, npiv, nvschur_k253, keep, m_array, nelim, nbrowsinf)
subroutine dmumps_blr_upd_nelim_var_l(a_u, la_u, upos, a_l, la_l, lpos, iflag, ierror, ldu, ldl, begs_blr_l, current_blr, blr_l, nb_blr_l, first_block, nelim, utrans)
subroutine dmumps_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, public dmumps_blr_save_diag_block(iwhandler, ipanel, d)
subroutine, public dmumps_blr_save_init(iwhandler, issym, ist2, isslave, nb_panels, begs_blr_l, begs_blr_col, nb_accesses_init, info)
subroutine, public dmumps_blr_save_cb_lrb(iwhandler, cb_lrb)
subroutine, public dmumps_blr_free_all_panels(iwhandler, loru, keep8, k34)
subroutine, public dmumps_blr_retrieve_panel_loru(iwhandler, loru, ipanel, thelrbpanel)
subroutine, public dmumps_blr_end_front(iwhandler, info1, keep8, k34, lrsolve_act_opt, mtk405)
subroutine, public dmumps_blr_retrieve_begsblr_sta(iwhandler, begs_blr_static)
subroutine, public dmumps_blr_save_begs_blr_dyn(iwhandler, begs_blr_dynamic)
subroutine, public dmumps_blr_save_panel_loru(iwhandler, loru, ipanel, lrb_panel)
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 upd_flop_facto_fr(nfront, nass, npiv, sym, niv)
subroutine dealloc_lrb(lrb_out, keep8, k34)
subroutine dealloc_blr_panel(blr_panel, iend, keep8, k34, ibeg_in)
subroutine, public dmumps_ooc_io_lu_panel(strat, typefile, afac, lafac, monbloc, lnextpiv2bewritten, unextpiv2bewritten, iw, liwfac, myid, filesize, ierr, last_call)
integer, parameter, public typef_both_lu
1.15.0