33#if defined(BLR_MT)
34#endif
35
36 IMPLICIT NONE
37 INTEGER(8) :: LA, POSELT
38 INTEGER N, INODE, LIW, IFLAG, IERROR
39 INTEGER, intent(inout) :: NNEGW, NPVW, NB22T1W, NBTINYW
40 INTEGER, intent(inout) :: DET_EXPW, DET_SIGNW
41 DOUBLE PRECISION, intent(inout) :: DET_MANTW
42 INTEGER MYID, IOLDPS
43 INTEGER KEEP( 500 )
44 INTEGER(8) KEEP8(150)
45 DOUBLE PRECISION UU, SEUIL
46 DOUBLE PRECISION A( LA )
47 INTEGER, TARGET :: IW( LIW )
48 INTEGER, intent(in) :: PERM(N)
49 LOGICAL AVOID_DELAYED
50 INTEGER ETATASS, IWPOS
51 INTEGER LPN_LIST
52 INTEGER PIVNUL_LIST(LPN_LIST)
53 DOUBLE PRECISION DKEEP(230)
54 INTEGER :: LRGROUPS(N)
55 INTEGER INOPV, IFINB, NFRONT, NPIV, IBEG_BLOCK, IEND_BLOCK
56 INTEGER NASS, NBKJIB_ORIG, XSIZE
57 INTEGER :: LDA
58 DOUBLE PRECISION UUTEMP
59 LOGICAL STATICMODE
60 DOUBLE PRECISION SEUIL_LOC
61 LOGICAL IS_MAXFROMM_AVAIL
62 INTEGER PIVOT_OPTION
63 INTEGER LRTRSM_OPTION
64 INTEGER LAST_ROW, FIRST_ROW
65 DOUBLE PRECISION MAXFROMM
66 INTEGER(8) :: LAFAC
67 INTEGER LIWFAC, STRAT, NextPiv2beWritten, IFLAG_OOC,
68 & IDUMMY, PP_FIRST2SWAP_L, PP_LastPIVRPTRFilled
69 TYPE(IO_BLOCK) :: MonBloc
70 LOGICAL LAST_CALL
71 INTEGER PARPIV_T1, OFFSET
72 INTEGER NFS4FATHER
73 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: M_ARRAY
74 LOGICAL LASTBL
75 INTEGER CURRENT_BLR
76 LOGICAL LR_ACTIVATED
77 LOGICAL COMPRESS_CB, COMPRESS_PANEL
78 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR, OOC_EFFECTIVE_ON_FRONT,
79 & OOC_EFF_AND_WRITE_BYPANEL
80 INTEGER K473_LOC
81 INTEGER INFO_TMP(2), MAXI_RANK
82 INTEGER FIRST_BLOCK, LAST_BLOCK
83 INTEGER HF, NPARTSASS, NPARTSCB, NB_BLR
84 INTEGER MAXI_CLUSTER, LWORK, NELIM, NELIM_LOC
85 TYPE(LRB_TYPE), POINTER, DIMENSION(:,:) :: CB_LRB
86 INTEGER, POINTER, DIMENSION(:) :: PTDummy
87 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: ACC_LUA
88 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR
89 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: BLR_L
90 DOUBLE PRECISION, POINTER, DIMENSION(:) :: DIAG
91 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_TMP
92 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: BLR_PANEL
93 INTEGER :: DIAGSIZ_STA, DIAGSIZ_DYN, DIAGPOS, I, IP, MEM, MEM_TOT
94 INTEGER(8) :: POSELT_DIAG
95 DOUBLE PRECISION, ALLOCATABLE :: WORK(:), TAU(:)
96 INTEGER, ALLOCATABLE :: JPVT(:)
97 DOUBLE PRECISION,ALLOCATABLE :: RWORK(:)
98 DOUBLE PRECISION, ALLOCATABLE :: BLOCK(:,:)
99 INTEGER :: allocok,J
100 INTEGER :: OMP_NUM
101 INTEGER :: II,JJ
102 INTEGER(8) :: UPOS, LPOS, DPOS
103 DOUBLE PRECISION :: ONE, MONE, ZERO
104 parameter(one = 1.0d0, mone=-1.0d0)
105 parameter(zero=0.0d0)
106 INTEGER :: MY_NUM
107 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: NEXT_BLR_L
108 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_STATIC
109 INTEGER :: NVSCHUR, NVSCHUR_K253, IROW_L
110 include 'mumps_headers.h'
111 INTEGER NBLR_ORIG, IBEG_BLR, IEND_BLR
112 INTEGER Inextpiv
113 INTEGER PIVSIZ,IWPOSP2
114 is_maxfromm_avail = .false.
115 IF (keep(206).GE.1) THEN
116 inextpiv = 1
117 ELSE
118 inextpiv = 0
119 ENDIF
120 inopv = 0
121 IF(keep(97) .EQ. 0) THEN
122 staticmode = .false.
123 ELSE
124 staticmode = .true.
125 ENDIF
126 uutemp=uu
127 IF (avoid_delayed) THEN
128 staticmode = .true.
129 seuil_loc =
max(seuil,epsilon(seuil))
130 ELSE
131 seuil_loc = seuil
132 ENDIF
133 lafac = -9999_8
134 xsize = keep(ixsz)
135 nfront = iw(ioldps+xsize)
136 lda = nfront
137 nass = iabs(iw(ioldps+2+xsize))
138 iw(ioldps+3+xsize) = -99999
139 lr_activated= .false.
140 compress_panel = .false.
141 compress_cb = .false.
142 NULLIFY(ptdummy)
143 NULLIFY(begs_blr)
144 NULLIFY(cb_lrb)
145 NULLIFY(acc_lua)
146 NULLIFY(blr_l)
147 NULLIFY(begs_blr_tmp)
148 NULLIFY(blr_panel)
149 NULLIFY(diag)
150 compress_panel = (iw(ioldps+xxlr).GE.2)
151 compress_cb = ((iw(ioldps+xxlr).EQ.1).OR.
152 & (iw(ioldps+xxlr).EQ.3))
153 lr_activated = (iw(ioldps+xxlr).GT.0)
154 IF (compress_cb.AND.(.NOT.compress_panel)) THEN
155 compress_panel = .true.
156 k473_loc = 1
157 ELSE
158 k473_loc = keep(473)
159 ENDIF
160 oocwrite_compatible_with_blr =
161 & ( .NOT.lr_activated.OR.(.NOT.compress_panel).OR.
162 & (keep(486).NE.2)
163 & )
164 ooc_effective_on_front= ((keep(201).EQ.1).AND.
165 & oocwrite_compatible_with_blr)
167 & lr_activated, parpiv_t1)
168 lrtrsm_option = keep(475)
169 pivot_option = keep(468)
170 IF (uutemp.EQ.zero) THEN
171 pivot_option = 0
172 ELSE IF (parpiv_t1.NE.0) THEN
173 pivot_option =
min(pivot_option,2)
174 ENDIF
175 IF (lr_activated) THEN
176 IF (lrtrsm_option.EQ.3) THEN
177 pivot_option =
min(pivot_option,1)
178 ELSEIF (lrtrsm_option.EQ.2) THEN
179 pivot_option =
min(pivot_option, 2)
180 ENDIF
181 ENDIF
182 IF (pivot_option.LE.1) THEN
183 parpiv_t1 = 0
184 ENDIF
185 IF (nass.LT.keep(4)) THEN
186 nbkjib_orig = nass
187 ELSE IF (nass .GT. keep(3)) THEN
188 nbkjib_orig =
min( keep(6), nass )
189 ELSE
190 nbkjib_orig =
min( keep(5), nass )
191 ENDIF
192 IF (.not.lr_activated) THEN
193 nblr_orig = keep(420)
194 ELSE
195 nblr_orig = -9999
196 ENDIF
197 IF ((keep(114).EQ.1) .AND.
198 & (keep(116).GT.0) .AND. ((nfront-nass-keep(253)).GT.0)
199 & ) THEN
200 irow_l = ioldps+6+xsize+nass
202 & n,
203 & nfront-nass-keep(253),
204 & keep(116),
205 & iw(irow_l), perm,
206 & nvschur )
207 ELSE
208 nvschur = 0
209 ENDIF
210 iend_block = 0
211 iend_blr = 0
212 current_blr = 0
213 lastbl = .false.
215 liwfac = iw(ioldps+xxi)
216 IF (ooc_effective_on_front) THEN
217 idummy = -8765
218 nextpiv2bewritten = 1
219 pp_first2swap_l = nextpiv2bewritten
220 monbloc%LastPanelWritten_L = 0
221 pp_lastpivrptrfilled = 0
222 monbloc%INODE = inode
223 monbloc%MASTER = .true.
224 monbloc%Typenode = 1
225 monbloc%NROW = nfront
226 monbloc%NCOL = nfront
227 monbloc%NFS = nass
228 monbloc%Last = .false.
229 monbloc%LastPiv = -77777
230 monbloc%INDICES =>
231 & iw(ioldps+6+nfront+xsize:
232 & ioldps+5+nfront+xsize+nfront)
233 ENDIF
234 IF (lr_activated) THEN
235 IF (keep(405) .EQ. 1) THEN
236
238
239 ELSE
241 ENDIF
242 ELSE IF (keep(486).NE.0) THEN
243 ENDIF
244 ooc_eff_and_write_bypanel = ( (pivot_option.GE.3) .AND.
245 & ooc_effective_on_front )
246 hf = 6 + iw(ioldps+5+xsize)+xsize
247 IF (lr_activated) THEN
248 CALL get_cut(iw(ioldps+hf:ioldps+hf+nfront-1), nass,
249 & nfront-nass, lrgroups, npartscb,
250 & npartsass, begs_blr)
251 CALL regrouping2(begs_blr, npartsass, nass, npartscb,
252 & nfront-nass, keep(488), .false., keep(472))
253 nb_blr = npartsass + npartscb
254 call max_cluster(begs_blr,nb_blr,maxi_cluster)
255 maxi_rank = keep(479)*maxi_cluster
256 lwork = maxi_cluster*maxi_cluster
257 omp_num = 1
258#if defined(BLR_MT)
259
260#endif
261 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
262 & rwork(2*maxi_cluster*omp_num),
263 & tau(maxi_cluster*omp_num),
264 & jpvt(maxi_cluster*omp_num),
265 & work(lwork*omp_num),stat=allocok)
266 IF (allocok > 0) THEN
267 iflag = -13
268 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
269 GOTO 490
270 ENDIF
271 ALLOCATE(acc_lua(omp_num),stat=allocok)
272 IF (allocok > 0) THEN
273 iflag = -13
274 ierror = omp_num
275 GOTO 490
276 ENDIF
277 IF (keep(480).GE.3) THEN
278 DO my_num=1,omp_num
279 CALL alloc_lrb(acc_lua(my_num), maxi_rank,
280 & maxi_cluster, maxi_cluster, .true.,
281 & iflag, ierror, keep8)
282 IF (iflag.LT.0) GOTO 500
283 acc_lua(my_num)%K = 0
284 ENDDO
285 ENDIF
286 ENDIF
287 IF (lr_activated.AND.(keep(480).NE.0
288 & .OR.
289 & (
290 & (keep(486).EQ.2)
291 & )
292 & .OR.compress_cb
293 & )) THEN
294 info_tmp(1) = iflag
295 info_tmp(2) = ierror
296 IF (iflag.LT.0) GOTO 500
298 & .true.,
299 & .false.,
300 & .false.,
301 & npartsass,
302 & begs_blr, ptdummy,
303 & huge(npartsass),
304 & info_tmp)
305 iflag = info_tmp(1)
306 ierror = info_tmp(2)
307 IF (iflag.LT.0) GOTO 500
308 ENDIF
309 IF (compress_cb.AND.npartscb.GT.0) THEN
310 allocate(cb_lrb(npartscb,npartscb),stat=allocok)
311 IF (allocok > 0) THEN
312 iflag = -13
313 ierror = npartscb*npartscb
314 GOTO 490
315 ENDIF
316 DO ii=1,npartscb
317 DO jj=1,npartscb
318 cb_lrb(ii,jj)%M=0
319 cb_lrb(ii,jj)%N=0
320 NULLIFY(cb_lrb(ii,jj)%Q)
321 NULLIFY(cb_lrb(ii,jj)%R)
322 cb_lrb(ii,jj)%ISLR = .false.
323 ENDDO
324 ENDDO
326 ENDIF
327 DO WHILE (iend_blr < nass )
328 current_blr = current_blr + 1
329 ibeg_blr = iw(ioldps+1+keep(ixsz)) + 1
330 IF (.NOT. lr_activated) THEN
331 iend_blr =
min(iend_blr + nblr_orig, nass)
332 ELSE
333 iend_blr = begs_blr(current_blr+1)-1
334 begs_blr( current_blr ) = ibeg_blr
335 IF ( iend_blr - ibeg_blr + 1 .GT. maxi_cluster ) THEN
336 maxi_cluster = iend_blr - ibeg_blr + 1
337 lwork = maxi_cluster*maxi_cluster
338 DEALLOCATE(block, work, rwork, tau, jpvt)
339 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
340 & rwork(2*maxi_cluster*omp_num),
341 & tau(maxi_cluster*omp_num),
342 & jpvt(maxi_cluster*omp_num),
343 & work(lwork*omp_num),stat=allocok)
344 IF (allocok > 0) THEN
345 iflag = -13
346 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
347 GOTO 490
348 ENDIF
349 IF (keep(480).GE.3) THEN
350 DO my_num=1,omp_num
352 CALL alloc_lrb(acc_lua(my_num), maxi_rank,
353 & maxi_cluster, maxi_cluster, .true.,
354 & iflag, ierror, keep8)
355 IF (iflag.LT.0) GOTO 500
356 acc_lua(my_num)%K = 0
357 ENDDO
358 ENDIF
359 ENDIF
360 IF (keep(480).GE.5) THEN
361 IF (current_blr.EQ.1) THEN
362 ALLOCATE(blr_l(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 IF (nb_blr.GT.current_blr) THEN
369 blr_l(1:nb_blr-current_blr)%ISLR=.false.
371 & iw(ioldps+xxf),
372 & 0,
373 & current_blr, blr_l)
374 ENDIF
375 ELSE
376 IF (nb_blr.GT.current_blr) THEN
378 & iw(ioldps+xxf),
379 & 0,
380 & current_blr, blr_l)
381 ENDIF
382 ENDIF
383 IF (current_blr.LT.npartsass) THEN
384 ALLOCATE(next_blr_l(nb_blr-current_blr-1),stat=allocok)
385 IF (allocok > 0) THEN
386 iflag = -13
387 ierror = nb_blr-current_blr-1
388 GOTO 490
389 ENDIF
390 IF (nb_blr.GT.current_blr+1) THEN
392 & iw(ioldps+xxf),
393 & 0,
394 & current_blr+1, next_blr_l)
395 ENDIF
396 ENDIF
397 ELSE
398 ALLOCATE(blr_l(nb_blr-current_blr),stat=allocok)
399 IF (allocok > 0) THEN
400 iflag = -13
401 ierror = nb_blr-current_blr
402 GOTO 490
403 ENDIF
404 ENDIF
405 ENDIF
406 IF (lr_activated) THEN
407 ENDIF
408 DO WHILE (iend_block < iend_blr )
409 ibeg_block = iw(ioldps+1+keep(ixsz)) + 1
410 IF (keep(405).EQ.0) THEN
411 keep(425)=
max(keep(425),iend_block-ibeg_block)
412 ELSE
413
414 keep(425)=
max(keep(425),iend_block-ibeg_block)
415
416 ENDIF
417 iend_block =
min(iend_block + nbkjib_orig, iend_blr)
418 50 CONTINUE
420 & ibeg_block, iend_block,
421 & iw,liw,a,la,
422 & inopv, nnegw, nb22t1w, nbtinyw,
423 & det_expw, det_mantw, det_signw,
424 & iflag,ioldps,poselt,uutemp,
425 & seuil_loc,keep,keep8,pivsiz,
426 & dkeep(1),pivnul_list(1),lpn_list, xsize,
427 & pp_first2swap_l, monbloc%LastPanelWritten_L,
428 & pp_lastpivrptrfilled, maxfromm, is_maxfromm_avail,
429 & pivot_option, iend_blr, inextpiv,
430 & ooc_effective_on_front,
431 & nvschur, parpiv_t1, lr_activated
432 & )
433 IF (iflag.LT.0) GOTO 500
434 IF (inopv.EQ.1) THEN
435 IF(staticmode) THEN
436 inopv = -1
437 GOTO 50
438 ENDIF
439 lastbl = .true.
440 ELSE IF ( inopv.LE.0 ) THEN
441 inopv = 0
442 npvw = npvw + pivsiz
443 nvschur_k253 = 0
444 IF (pivot_option.GE.3) THEN
445 last_row = nfront
446 nvschur_k253 = nvschur + keep(253)
447 ELSEIF (pivot_option.EQ.2) THEN
448 last_row = nass
449 ELSE
450 last_row = iend_blr
451 ENDIF
453 & nfront, nass, iw(ioldps+1+xsize),
454 & inode,a,la,
455 & lda,
456 & poselt,ifinb,
457 & pivsiz, maxfromm,
458 & is_maxfromm_avail, (uutemp.NE.0.0d0),
459 & parpiv_t1,
460 & last_row, iend_blr, nvschur_k253,
461 & lr_activated
462 & )
463 IF(pivsiz .EQ. 2) THEN
464 iwposp2 = ioldps+iw(ioldps+1+xsize)+6
465 iw(iwposp2+nfront+xsize) =
466 & -iw(iwposp2+nfront+xsize)
467 ENDIF
468 iw(ioldps+1+xsize) = iw(ioldps+1+xsize) + pivsiz
469 IF (ifinb.EQ.0) THEN
470 GOTO 50
471 ELSE IF (ifinb.EQ.-1) THEN
472 lastbl = .true.
473 ENDIF
474 ENDIF
475 IF ( ooc_eff_and_write_bypanel ) THEN
476 monbloc%Last = lastbl
477 monbloc%LastPiv= iw(ioldps+1+xsize)
478 last_call=.false.
480 & strat_try_write,
481 & typef_l, a(poselt),
482 & lafac, monbloc, nextpiv2bewritten, idummy,
483 & iw(ioldps), liwfac,
484 & myid, keep8(31), iflag_ooc,last_call )
485 IF (iflag_ooc < 0 ) THEN
486 iflag=iflag_ooc
487 GOTO 500
488 ENDIF
489 ENDIF
490 npiv = iw(ioldps+1+xsize)
491 IF ( iend_blr .GT. iend_block ) THEN
492 IF (pivot_option.GE.3) THEN
493 last_row = nfront
494 ELSEIF (pivot_option.EQ.2) THEN
495 last_row = nass
496 ELSE
497 last_row = iend_blr
498 ENDIF
500 & npiv, nfront,nass,inode,a,la,
501 & lda, poselt,
502 & keep, keep8,
503 & -6666, -6666,
504 & iend_blr, last_row,
505 & .false., .true., lr_activated,
506 & iw, liw, -6666
507 & )
508 ENDIF
509 END DO
510 npiv = iw(ioldps+1+xsize)
511 IF (.NOT. lr_activated
512 & .OR. (.NOT. compress_panel)
513 & ) THEN
514 IF (pivot_option.GE.3) THEN
515 last_row = nfront
516 ELSEIF (pivot_option.EQ.2) THEN
517 last_row = nass
518 ELSE
519 last_row = iend_blr
520 ENDIF
522 & nfront,nass,inode,a,la,
523 & lda, poselt,
524 & keep, keep8,
525 & iend_blr, nass,
526 & nass, last_row,
527 & (pivot_option.LE.1), .true., lr_activated,
528 & iw, liw, ioldps+6+xsize+nfront+ibeg_blr-1)
529 ELSE
530 nelim = iend_block - npiv
531 IF (nelim .EQ. iend_blr - ibeg_blr + 1) THEN
532 IF (keep(480).GE.2
533 & .OR.
534 & (
535 & (keep(486).EQ.2)
536 & )
537 & ) THEN
538 DO j=1,nb_blr-current_blr
539 blr_l(j)%M=0
540 blr_l(j)%N=0
541 blr_l(j)%K=0
542 blr_l(j)%ISLR=.false.
543 NULLIFY(blr_l(j)%Q)
544 NULLIFY(blr_l(j)%R)
545 ENDDO
547 & iw(ioldps+xxf),
548 & 0,
549 & current_blr, blr_l)
550 NULLIFY(blr_l)
551 IF (keep(480).GE.2 .AND. iend_blr.LT.nass) THEN
552 IF (lrtrsm_option.EQ.2) THEN
553 first_block = npartsass-current_blr
554 ELSE
555 first_block = 1
556 ENDIF
557#if defined(BLR_MT)
558
559#endif
561 & nfront, iw(ioldps+xxf),
562 & begs_blr, current_blr, nb_blr, npartsass,
563 & nelim,
564 & iw(hf+ioldps+nfront), block,
565 & acc_lua, maxi_cluster, maxi_rank,
566 & 1, iflag, ierror,
567 & keep(481), dkeep(11), keep(466), keep(477),
568 & keep(480), keep(479), keep(478), keep(476),
569 & keep(483), keep8, first_block=first_block)
570#if defined(BLR_MT)
571
572#endif
573 IF (iflag.LT.0) GOTO 500
574 ENDIF
575 ENDIF
576 IF (keep(486).EQ.3) THEN
577 IF (keep(480).EQ.0) THEN
578 DEALLOCATE(blr_l)
579 NULLIFY(blr_l)
580 ENDIF
581 ENDIF
582 GOTO 100
583 ENDIF
584 IF (pivot_option.GE.3) THEN
585 first_row = nfront
586 ELSEIF (pivot_option.EQ.2) THEN
587 first_row = nass
588 ELSE
589 first_row = iend_blr
590 ENDIF
591 IF (lrtrsm_option.EQ.3) THEN
592 last_row = iend_blr
593 ELSEIF (lrtrsm_option.EQ.2) THEN
594 last_row = nass
595 ELSE
596 last_row = nfront
597 ENDIF
598 IF ((iend_blr.LT.nfront) .AND. (last_row-first_row.GT.0)) THEN
600 & npiv, nfront, nass,
601 & inode, a, la, lda, poselt,
602 & keep, keep8,
603 & first_row, last_row,
604 & -6666, -6666,
605 & .true., .false., lr_activated,
606 & iw, liw, ioldps+6+xsize+nfront+ibeg_blr-1)
607 ENDIF
608#if defined(BLR_MT)
609#endif
610#if defined(BLR_MT)
611
612
613#endif
615 & nfront,
616 & begs_blr, nb_blr, dkeep(8), keep(466), k473_loc, blr_l,
617 & current_blr,
618 & 'V', work, tau, jpvt, lwork, rwork,
619 & block, maxi_cluster, nelim,
620 & .false., 0, 0,
621 & 1, keep(483), keep8,
622 & k480=keep(480)
623 & )
624#if defined(BLR_MT)
625
626#endif
627 IF (iflag.LT.0) GOTO 400
628 IF (pivot_option.LT.3) THEN
629 IF (lrtrsm_option.GE.2) THEN
630 IF (pivot_option.LE.1.AND.lrtrsm_option.EQ.3) THEN
631 first_block = current_blr+1
632 ELSE
633 first_block = npartsass+1
634 ENDIF
636 & ibeg_blr, nb_blr, blr_l,
637 & current_blr, first_block, nb_blr,
638 & 1, 1, 0,
639 & .false.,
640 & iw, offset_iw=ioldps+6+xsize+nfront+ibeg_blr-1)
641#if defined(BLR_MT)
642
643#endif
644 ENDIF
645 IF (nelim.GT.0) THEN
646 IF (pivot_option.LE.1) THEN
647 first_block = current_blr+1
648 ELSE
649 first_block = npartsass+1
650 ENDIF
651 lpos = poselt
652 & +int(begs_blr(current_blr+1)-1-nelim,8)*int(nfront,8)
653 & +int(begs_blr(current_blr)-1,8)
654 dpos = poselt
655 & +int(begs_blr(current_blr)-1,8)*int(nfront,8)
656 & +int(begs_blr(current_blr)-1,8)
657 offset=ioldps+6+xsize+nfront+ibeg_blr-1
658 upos = poselt+int(begs_blr(current_blr)-1,8)*int(nfront,8)
659 & +int(begs_blr(current_blr+1)-1-nelim,8)
660#if defined(BLR_MT)
661
662#endif
664 & keep(424), nfront, npiv-ibeg_blr+1,
665 & liw, iw, offset, la, a, poselt, lpos, upos, dpos)
666#if defined(BLR_MT)
667
668#endif
669 lpos = poselt
670 & +int(begs_blr(current_blr+1)-1,8)*int(nfront,8)
671 & +int(begs_blr(current_blr+1)-1-nelim,8)
673 & a, la, upos, a, la, lpos,
674 & iflag, ierror, nfront, nfront,
675 & begs_blr, current_blr, blr_l, nb_blr,
676 & first_block, nelim, 'N')
677 ENDIF
678 ENDIF
679 IF (iflag.LT.0) GOTO 400
680#if defined(BLR_MT)
681
682#endif
683 IF (keep(480).NE.0
684 & .OR.
685 & (
686 & (keep(486).EQ.2)
687 & )
688 & ) THEN
689 IF (keep(480).LT.5) THEN
691 & iw(ioldps+xxf),
692 & 0,
693 & current_blr, blr_l)
694 ENDIF
695 ENDIF
696#if defined(BLR_MT)
697
698
699#endif
700 IF (keep(480).GE.2) THEN
701 IF (iend_blr.LT.nass) THEN
702 IF (lrtrsm_option.EQ.2) THEN
703 first_block = npartsass-current_blr
704 ELSE
705 first_block = 1
706 ENDIF
708 & nfront, iw(ioldps+xxf),
709 & begs_blr, current_blr, nb_blr, npartsass,
710 & nelim,
711 & iw(hf+ioldps+nfront), block,
712 & acc_lua, maxi_cluster, maxi_rank,
713 & 1, iflag, ierror,
714 & keep(481), dkeep(11), keep(466), keep(477),
715 & keep(480), keep(479), keep(478), keep(476),
716 & keep(483), keep8, first_block=first_block)
717 ENDIF
718 ELSE
720 & iflag, ierror, nfront,
721 & begs_blr, nb_blr, current_blr, blr_l, nelim,
722 & iw(hf+ioldps+nfront+ibeg_blr-1), block,
723 & maxi_cluster, npiv,
724 & 1,
725 & keep(481), dkeep(11), keep(466), keep(477)
726 & )
727 ENDIF
728#if defined(BLR_MT)
729
730#endif
731 IF (iflag.LT.0) GOTO 400
732 IF (lrtrsm_option.GE.2) THEN
733 IF (lrtrsm_option.EQ.2) THEN
734 first_block = npartsass+1
735 ELSE
736 first_block = current_blr+1
737 ENDIF
738 IF (keep(486).NE.2) THEN
739 last_block = nb_blr
740 ELSEIF(uu.GT.0) THEN
741 last_block = npartsass
742 ELSE
743 last_block = current_blr
744 ENDIF
746 & .true.,
747 & begs_blr(current_blr),
748 & begs_blr(current_blr+1), nb_blr, blr_l, current_blr, 'V',
749 & 1,
750 & beg_i_in=first_block, end_i_in=last_block)
751 ENDIF
752 400 CONTINUE
753#if defined(BLR_MT)
754
755#endif
756 IF (iflag.LT.0) GOTO 500
757 IF (keep(486).EQ.3) THEN
758 IF (keep(480).EQ.0) THEN
760 & keep(34))
761 DEALLOCATE(blr_l)
762 ELSE
763 NULLIFY(next_blr_l)
764 ENDIF
765 ENDIF
766 NULLIFY(blr_l)
767 ENDIF
768 IF ( ooc_eff_and_write_bypanel ) THEN
769 monbloc%Last = lastbl
770 monbloc%LastPiv= npiv
771 last_call=.false.
773 & strat_try_write,
774 & typef_l, a(poselt),
775 & lafac, monbloc, nextpiv2bewritten, idummy, iw(ioldps),
776 & liwfac, myid, keep8(31), iflag_ooc,last_call )
777 IF (iflag_ooc < 0 ) THEN
778 iflag=iflag_ooc
779 GOTO 500
780 ENDIF
781 ENDIF
782 100 CONTINUE
783 END DO
784 IF (lr_activated) THEN
785 ibeg_blr = iw(ioldps+1+keep(ixsz)) + 1
786 begs_blr( current_blr + 1 ) = ibeg_blr
787 IF (
788 & (keep(486).EQ.2)
789 & ) THEN
791 & begs_blr_static)
792 IF (uu.GT.0) THEN
793 allocate(begs_blr_tmp(nb_blr+1),stat=allocok)
794 IF (allocok > 0) THEN
795 iflag = -13
796 ierror = nb_blr+1
797 GOTO 500
798 ENDIF
799 DO j=1,nb_blr+1
800 begs_blr_tmp(j) = begs_blr_static(j)
801 ENDDO
802 ENDIF
803 ENDIF
804 mem_tot = 0
805#if defined(BLR_MT)
806
807
808#endif
809 IF ( (keep(486).EQ.2)
810 & ) THEN
811#if defined(BLR_MT)
812
813
814
815#endif
816 DO ip=1,npartsass
817 IF (iflag.LT.0) cycle
818 diagsiz_dyn = begs_blr(ip+1)-begs_blr(ip)
819 diagsiz_sta = begs_blr_static(ip+1)-begs_blr(ip)
820 mem = diagsiz_dyn*diagsiz_sta
821 mem_tot = mem_tot + mem
822 ALLOCATE(diag(mem),stat=allocok)
823 IF (allocok > 0) THEN
824 iflag = -13
825 ierror = mem
826 cycle
827 ENDIF
828 diagpos = 1
829 poselt_diag = poselt + int(begs_blr(ip)-1,8)*int(nfront,8)
830 & + int(begs_blr(ip)-1,8)
831 DO i=1,diagsiz_sta
832 diag(diagpos:diagpos+diagsiz_dyn-1) =
833 & a(poselt_diag:poselt_diag+int(diagsiz_dyn-1,8))
834 diagpos = diagpos + diagsiz_dyn
835 poselt_diag = poselt_diag + int(nfront,8)
836 ENDDO
838 & iw(ioldps+xxf),
839 & ip, diag)
840 ENDDO
841#if defined(BLR_MT)
842
843
844#endif
846 & (keep(405).NE.0), keep8, iflag, ierror, .true., .true.)
847#if defined(BLR_MT)
848
849#endif
850 IF (iflag.LT.0) GOTO 447
851 IF (uu.GT.0) THEN
852 DO ip=1,npartsass
853 nelim_loc = begs_blr_tmp(ip+1)-begs_blr(ip+1)
855 & iw(ioldps+xxf), 0, ip, blr_panel)
856#if defined(BLR_MT)
857
858#endif
860 & keep(34))
861#if defined(BLR_MT)
862
863#endif
865 & ierror, nfront, begs_blr_tmp,
866 & nb_blr, dkeep(8), keep(466), k473_loc,
867 & blr_panel, ip,
868 & 'V', work, tau, jpvt, lwork, rwork,
869 & block, maxi_cluster, nelim_loc,
870 & .false., 0, 0,
871 & 1, keep(483), keep8,
872 & end_i_in=npartsass, frswap=.true.
873 & )
874#if defined(BLR_MT)
875
876#endif
877 IF (iflag.LT.0) GOTO 445
878#if defined(BLR_MT)
879
880#endif
881 begs_blr_tmp(ip+1) = begs_blr(ip+1)
882#if defined(BLR_MT)
883
884#endif
885 ENDDO
886#if defined(BLR_MT)
887
888#endif
889 445 CONTINUE
890 ENDIF
891 447 CONTINUE
892 ENDIF
893 IF (keep(480) .GE. 2) THEN
894#if defined(BLR_MT)
895
896#endif
898 & begs_blr_static)
899#if defined(BLR_MT)
900
901#endif
903 & begs_blr_static, begs_blr, npartscb, npartsass, nass,
904 & iw(ioldps+xxf),
905 & iw(hf+ioldps+nfront), block,
906 & acc_lua, maxi_cluster, maxi_rank,
907 & 1, iflag, ierror,
908 & keep(481), dkeep(11), keep(466), keep(477),
909 & keep(480), keep(479), keep(478), keep(476),
910 & keep(484), keep8)
911#if defined(BLR_MT)
912
913#endif
914 END IF
915 IF (iflag.LT.0) GOTO 450
916#if defined(BLR_MT)
917
918#endif
919 IF (compress_cb
920 & .OR.
921 & (
922 & (keep(486).EQ.2)
923 & )
924 & ) THEN
926 & begs_blr)
927 ENDIF
928 IF (compress_cb) THEN
929 iend_blr = begs_blr(current_blr+2)
930 IF ( iend_blr - ibeg_blr + 1 .GT. maxi_cluster ) THEN
931 maxi_cluster = iend_blr - ibeg_blr + 1
932 lwork = maxi_cluster*maxi_cluster
933 DEALLOCATE(block, work, rwork, tau, jpvt)
934 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
935 & rwork(2*maxi_cluster*omp_num),
936 & tau(maxi_cluster*omp_num),
937 & jpvt(maxi_cluster*omp_num),
938 & work(lwork*omp_num),stat=allocok)
939 IF (allocok > 0) THEN
940 iflag = -13
941 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
942 ENDIF
943 ENDIF
944 ENDIF
945#if defined(BLR_MT)
946
947
948#endif
949 IF (iflag.LT.0) GOTO 450
950 IF (compress_cb) THEN
951#if defined(BLR_MT)
952
953#endif
954 nfs4father = -9999
955 IF ( (keep(219).NE.0).AND.(keep(50).EQ.2) ) THEN
957 & nfs4father )
958 IF (nfs4father.GE.0) nfs4father = nfs4father + nelim
959 ENDIF
960 ALLOCATE(m_array(
max(nfs4father,1)), stat=allocok)
961 IF ( allocok.GT.0 ) THEN
962 iflag = -13
963 ierror =
max(nfs4father,1)
964 ENDIF
965#if defined(BLR_MT)
966
967
968#endif
969 IF (iflag.LT.0) GOTO 448
971 & begs_blr, begs_blr, npartscb, npartscb, npartsass,
972 & nfront-nass, nfront-nass, inode,
973 & iw(ioldps+xxf), 2, 1, iflag, ierror,
974 & dkeep(12), keep(466), keep(484), keep(489), cb_lrb,
975 & work, tau, jpvt, lwork, rwork, block,
976 & maxi_cluster, keep8,
977 & nfs4father, npiv, nvschur+keep(253), keep(1),
978 & m_array=m_array,
979 & nelim=nelim )
980#if defined(BLR_MT)
981
982#endif
983 IF (iflag.LT.0) GOTO 448
984#if defined(BLR_MT)
985
986#endif
987 IF ( (keep(219).NE.0).AND.(keep(50).EQ.2).AND.
988 & nfs4father.GT.0 ) THEN
989 info_tmp(1) = iflag
990 info_tmp(2) = ierror
992 & m_array, info_tmp)
993 iflag = info_tmp(1)
994 ierror = info_tmp(2)
995 ENDIF
996 DEALLOCATE(m_array)
997#if defined(BLR_MT)
998
999
1000#endif
1001 448 CONTINUE
1002 ENDIF
1003 450 CONTINUE
1004#if defined(BLR_MT)
1005
1006#endif
1007 IF ( (
1008 & (keep(486).EQ.2)
1009 & )
1010 & .AND.uu.GT.0) THEN
1011 deallocate(begs_blr_tmp)
1012 ENDIF
1013 IF (iflag.LT.0) GOTO 500
1015 DO ip=1,npartsass
1017 & iw(ioldps+xxf), 0, ip, blr_panel)
1019 & )
1020 ENDDO
1022 ENDIF
1023 IF (.NOT. compress_panel) THEN
1025 & lda, ioldps,poselt, keep,keep8,
1026 & (pivot_option.NE.3), etatass,
1027 & typef_l, lafac, monbloc, nextpiv2bewritten,
1028 & liwfac, myid, iflag, ioldps+6+xsize+nfront, inode )
1029 ENDIF
1030 IF (keep(486).NE.0) THEN
1031 IF (.NOT.lr_activated) THEN
1033 ENDIF
1034 ENDIF
1035 IF (ooc_effective_on_front) THEN
1036 strat = strat_write_max
1037 monbloc%Last = .true.
1038 monbloc%LastPiv = iw(ioldps+1+xsize)
1039 last_call = .true.
1041 & ( strat, typef_l,
1042 & a(poselt), lafac, monbloc,
1043 & nextpiv2bewritten, idummy,
1044 & iw(ioldps), liwfac,
1045 & myid, keep8(31), iflag_ooc,last_call )
1046 IF (iflag_ooc < 0 ) THEN
1047 iflag=iflag_ooc
1048 GOTO 500
1049 ENDIF
1051 & ioldps, iw, liw, monbloc , nfront, keep)
1052 ENDIF
1053 GOTO 600
1054 490 CONTINUE
1055 500 CONTINUE
1056 600 CONTINUE
1057 IF (lr_activated) THEN
1058 IF (allocated(rwork)) DEALLOCATE(rwork)
1059 IF (allocated(work)) DEALLOCATE(work)
1060 IF (allocated(tau)) deallocate(tau)
1061 IF (allocated(jpvt)) deallocate(jpvt)
1062 IF (allocated(block)) deallocate(block)
1063 IF (associated(acc_lua)) THEN
1064 IF (keep(480).GE.3) THEN
1065 DO my_num=1,omp_num
1066 CALL dealloc_lrb(acc_lua(my_num), keep8, keep(34))
1067 ENDDO
1068 ENDIF
1069 DEALLOCATE(acc_lua)
1070 ENDIF
1071 IF (associated(begs_blr)) THEN
1072 DEALLOCATE(begs_blr)
1073 NULLIFY(begs_blr)
1074 ENDIF
1075 ENDIF
1076 IF (lr_activated.AND.keep(480).NE.0) THEN
1077 IF (.NOT.
1078 & (
1079 & (keep(486).EQ.2)
1080 & )
1081 & ) THEN
1083 & keep8, keep(34))
1084 ENDIF
1085 ENDIF
1086 IF (lr_activated) THEN
1087 IF (.NOT.
1088 & (
1089 & (keep(486).EQ.2)
1090 & )
1091 & .AND. .NOT.compress_cb) THEN
1093 & keep(34), mtk405=keep(405))
1094 ENDIF
1095 ENDIF
1096 RETURN
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_ldlt_copyscale_u(irowmax, irowmin, sizecopy, lda, ncols, liw, iw, offset_iw, la, a, poselt, a_lpos, a_upos, a_dpos)
subroutine dmumps_get_size_schur_in_front(n, ncb, size_schur, row_indices, perm, nvschur)
subroutine dmumps_fac_mq_ldlt(iend_block, nfront, nass, npiv, inode, a, la, lda, poselt, ifinb, pivsiz, maxfromm, is_maxfromm_avail, is_max_useful, parpiv_t1, last_row, iend_blr, nvschur_k253, lr_activated)
subroutine dmumps_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 dmumps_fac_t_ldlt(nfront, nass, iw, liw, a, la, lda, ioldps, poselt, keep, keep8, postpone_col_update, etatass, typefile, lafac, monbloc, nextpiv2bewritten, liwfac, myid, iflag, offset_iw, inode)
subroutine dmumps_fac_i_ldlt(nfront, nass, inode, ibeg_block, iend_block, iw, liw, a, la, inopv, nnegw, nb22t1w, nbtinyw, det_expw, det_mantw, det_signw, iflag, ioldps, poselt, uu, seuil, keep, keep8, pivsiz, dkeep, pivnul_list, lpn_list, xsize, pp_first2swap_l, pp_lastpanelondisk, pp_lastpivrptrindexfilled, maxfromm, is_maxfromm_avail, pivot_option, iend_blr, inextpiv, ooc_effective_on_front, nvschur, parpiv_t1, lr_activated)
subroutine dmumps_blr_upd_cb_left_ldlt(a, la, poselt, nfront, begs_blr, begs_blr_dyn, nb_incb, nb_inasm, nass, iwhandler, 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)
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_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 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_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_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 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_retrieve_nfs4father(iwhandler, nfs4father)
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_save_m_array(iwhandler, m_array, info)
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)