17 & N, INODE, FPERE, IW, LIW, A, LA,
18 & UU, NOFFW, NPVW, NBTINYW,
19 & DET_EXPW, DET_MANTW, DET_SIGNW,
20 & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF,
21 & IFLAG, IERROR, IPOOL,LPOOL,
22 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
24 & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP,
26 & NSTK_S,PERM,PROCNODE_STEPS, root,
27 & OPASSW, OPELIW, ITLOC, RHS_MUMPS,
28 & FILS, DAD, PTRARW, PTRAIW,
29 & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,
30 & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL,
31 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED,
32 & DKEEP,PIVNUL_LIST,LPN_LIST
49 INTEGER COMM_LOAD, ASS_IRECV
50 INTEGER N, INODE, FPERE, LIW
51 INTEGER,
intent(inout) :: NOFFW, NPVW, NBTINYW
52 INTEGER,
intent(inout) :: DET_EXPW, DET_SIGNW
53 COMPLEX(kind=8),
intent(inout) :: DET_MANTW
56 COMPLEX(kind=8) A( LA )
57 DOUBLE PRECISION UU, SEUIL
58 TYPE (zmumps_root_struc) :: root
59 INTEGER COMM, MYID, LBUFR, LBUFR_BYTES
61 INTEGER ICNTL(60), KEEP(500)
63 INTEGER NBFIN, SLAVEF,
64 & IFLAG, IERROR, LEAF, LPOOL
65 INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS
66 INTEGER IWPOS, IWPOSCB, COMP
67 INTEGER FRTPTR( N + 1 ), ( NELT )
68 INTEGER BUFR( LBUFR ), IPOOL(LPOOL),
69 & itloc(n+keep(253)), fils(n), dad( keep(28) ),
70 & nd( keep(28) ), frere( keep(28) )
71 INTEGER(8),
INTENT(IN) :: (LPTRAR), PTRAIW(LPTRAR)
72 COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255))
73 INTEGER(8) :: (KEEP(28))
74 INTEGER(8) :: PTRFAC(KEEP(28))
75 INTEGER(8) :: PAMASTER(KEEP(28))
76 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)),
77 & step(n), pimaster(keep(28)),
78 & nstk_s(keep(28)), perm(n),
79 & procnode_steps(keep(28))
80 INTEGER ISTEP_TO_INIV2(KEEP(71)),
81 & tab_pos_in_pere(slavef+2,
max(1,keep(56)))
82 DOUBLE PRECISION OPASSW, OPELIW
83 COMPLEX(kind=8) DBLARR(KEEP8(26))
84 INTEGER INTARR(KEEP8(27))
87 INTEGER PIVNUL_LIST(LPN_LIST)
88 DOUBLE PRECISION (230)
89 INTEGER :: LRGROUPS(N)
90 INTEGER INOPV, IFINB, NFRONT, NPIV, IBEG_BLOCK, IEND_BLOCK
92 INTEGER , NBKJIB_ORIG, XSIZE
93 INTEGER NBLR_ORIG, IBEG_BLR, IEND_BLR
97 INTEGER IOLDPS, allocok, K263,J
99 DOUBLE PRECISION UUTEMP
101 DOUBLE PRECISION SEUIL_LOC
102 INTEGER ,
ALLOCATABLE,
DIMENSION ( : ) :: IPIV
104 INTEGER LIWFAC, STRAT, LNextPiv2beWritten,
105 & unextpiv2bewritten, iflag_ooc,
106 & pp_first2swap_l, pp_first2swap_u,
107 & pp_lastpivrptrfilled_l,
108 & pp_lastpivrptrfilled_u
109 TYPE(io_block) :: MonBloc
111 INTEGER CURRENT_BLR, NELIM
112 LOGICAL LR_ACTIVATED, COMPRESS_PANEL
113 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR,
114 & ooc_effective_on_front,
115 & ooc_eff_and_write_bypanel
116 INTEGER :: IROW_L, NVSCHUR, NSLAVES
117 INTEGER :: PIVOT_OPTION, LAST_COL, FIRST_COL
119 INTEGER FIRST_BLOCK, LAST_BLOCK
120 INTEGER :: INFO_TMP(2)
122 INTEGER HF, NPARTSASS, NPARTSCB, NB_BLR, END_I
123 INTEGER MAXI_CLUSTER, LWORK
124 TYPE(LRB_TYPE),
DIMENSION(1),
TARGET :: BLR_DUMMY
125 INTEGER,
POINTER,
DIMENSION(:) :: PTDummy
126 TYPE(LRB_TYPE),
POINTER,
DIMENSION(:) :: ACC_LUA
127 INTEGER,
POINTER,
DIMENSION(:) :: BEGS_BLR
128 TYPE(
lrb_type),
POINTER,
DIMENSION(:) :: BLR_L, BLR_U, BLR_SEND
129 COMPLEX(kind=8),
POINTER,
DIMENSION(:) ::
130 TYPE(
lrb_type),
POINTER,
DIMENSION(:) :: BLR_PANEL
131 INTEGER,
POINTER,
DIMENSION(:) :: BEGS_BLR_TMP, BEGS_BLR_STATIC
132 INTEGER :: DIAGSIZ_STA, DIAGSIZ_DYN, DPOS, LorU, I, IP, MEM,
134 INTEGER(8) :: POSELT_DIAG
135 CHARACTER(len=1) :: DIR
136 COMPLEX(kind=8),
ALLOCATABLE :: WORK(:), TAU(:)
137 INTEGER,
ALLOCATABLE :: (:)
138 DOUBLE PRECISION,
ALLOCATABLE :: RWORK(:)
139 COMPLEX(kind=8),
ALLOCATABLE :: BLOCK(:,:)
143 include
'mumps_headers.h'
148 NULLIFY(blr_l, blr_u, blr_send)
151 NULLIFY( begs_blr_tmp, begs_blr_static)
152 IF (keep(206).GE.1)
THEN
158 ioldps = ptlust_s(step( inode ))
159 poselt = ptrast(step( inode ))
161 nfront = iw(ioldps+xsize)
162 nass = iabs(iw(ioldps+2+xsize))
163 iw(ioldps+3+xsize) = -99999
164 lr_activated = (iw(ioldps+xxlr).GT.0)
165 compress_panel = (iw(ioldps+xxlr).GE.2)
166 oocwrite_compatible_with_blr =
167 & ( .NOT.lr_activated.OR. (.NOT.compress_panel).OR.
170 ooc_effective_on_front= ((keep(201).EQ.1).AND.
171 & oocwrite_compatible_with_blr)
175 IF(keep(97) .EQ. 0)
THEN
180 IF (avoid_delayed)
THEN
183 seuil_loc =
max(seuil,epsilon(seuil))
188 IF (.not.lr_activated)
THEN
189 nblr_orig = keep(420)
193 IF ((keep(114).EQ.1) .AND.
194 & (keep(116).GT.0) .AND. ((nfront-nass-keep(253)).GT.0)
196 nslaves = iw(ioldps+5+xsize)
197 irow_l = ioldps+6+xsize+nslaves+nass
200 & nfront-nass-keep(253),
207 IF (lr_activated)
THEN
211 IF (k263 .NE. 0 .AND. nass/nblr_orig < 4)
THEN
212 IF ( nblr_orig .GT. nbkjib_orig * 4 )
THEN
213 nblr_orig =
max(nbkjib_orig, (nass+3)/4)
219 pivot_option = keep(468)
220 IF ( uutemp == 0.0d0 .AND.
222 & ooc_effective_on_front
225 IF (k263.EQ.1.AND.(.NOT.lr_activated))
THEN
232 ALLOCATE( ipiv( nass ), stat = allocok )
233 IF ( allocok .GT. 0 )
THEN
234 WRITE(*,*) myid,
' : ZMUMPS_FAC2_LU :failed to allocate ',
241 liwfac = iw(ioldps+xxi)
242 IF ( ooc_effective_on_front )
THEN
243 lnextpiv2bewritten = 1
244 unextpiv2bewritten = 1
245 pp_first2swap_l = lnextpiv2bewritten
246 pp_first2swap_u = unextpiv2bewritten
247 monbloc%LastPanelWritten_L = 0
248 monbloc%LastPanelWritten_U = 0
249 monbloc%INODE = inode
250 monbloc%MASTER = .true.
253 monbloc%NCOL = nfront
255 monbloc%Last = .false.
256 monbloc%LastPiv = -68877
257 NULLIFY(monbloc%INDICES)
259 IF (lr_activated)
THEN
261 IF (keep(475).EQ.1)
THEN
263 ELSEIF (keep(475).EQ.2)
THEN
265 ELSEIF (keep(475).EQ.3)
THEN
266 IF (uutemp == 0.0d0)
THEN
274 hf = 6 + iw(ioldps+5+xsize)+xsize
275 ooc_eff_and_write_bypanel = ( (pivot_option.GE.3) .AND.
276 & ooc_effective_on_front )
277 IF (lr_activated)
THEN
278 CALL get_cut(iw(ioldps+hf:ioldps+hf+nfront-1), nass,
279 & nfront-nass, lrgroups, npartscb,
280 & npartsass, begs_blr)
281 CALL regrouping2(begs_blr, npartsass, nass, npartscb,
282 & nfront-nass, keep(488), .false., keep(472))
283 nb_blr = npartsass + npartscb
285 maxi_rank = keep(479)*maxi_cluster
286 lwork = maxi_cluster*maxi_cluster
291 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
292 & rwork(2*maxi_cluster*omp_num),
293 & tau(maxi_cluster*omp_num),
294 & jpvt(maxi_cluster*omp_num),
295 & work(lwork*omp_num),stat=allocok)
296 IF (allocok > 0)
THEN
298 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
301 ALLOCATE(acc_lua(omp_num),stat=allocok)
302 IF (allocok > 0)
THEN
307 IF (keep(480).GE.3)
THEN
309 CALL alloc_lrb(acc_lua(my_num), maxi_rank,
310 & maxi_cluster, maxi_cluster, .true.,
311 & iflag, ierror, keep8)
312 IF (iflag.LT.0)
GOTO 500
313 acc_lua(my_num)%K = 0
317 IF (lr_activated.AND.
330 IF (iflag.LT.0)
GOTO 500
341 IF (iflag.LT.0)
GOTO 500
344 DO WHILE (iend_blr < nass )
345 current_blr = current_blr + 1
346 ibeg_blr = iw(ioldps+1+keep(ixsz)) + 1
347 IF (.NOT. lr_activated)
THEN
348 iend_blr =
min(iend_blr + nblr_orig, nass)
350 iend_blr = begs_blr(current_blr+1)-1
351 begs_blr( current_blr ) = ibeg_blr
352 IF ( iend_blr - ibeg_blr + 1 .GT. maxi_cluster )
THEN
353 maxi_cluster = iend_blr - ibeg_blr + 1
354 lwork = maxi_cluster*maxi_cluster
355 DEALLOCATE(block, work, rwork, tau, jpvt)
356 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
357 & rwork(2*maxi_cluster*omp_num),
358 & tau(maxi_cluster*omp_num),
359 & jpvt(maxi_cluster*omp_num),
360 & work(lwork*omp_num),stat=allocok)
361 IF (allocok > 0)
THEN
363 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
366 IF (keep(480).GE.3)
THEN
369 CALL alloc_lrb(acc_lua(my_num), maxi_rank,
370 & maxi_cluster, maxi_cluster, .true.,
371 & iflag, ierror, keep8)
372 IF (iflag.LT.0)
GOTO 500
373 acc_lua(my_num)%K = 0
378 DO WHILE (iend_block < iend_blr )
379 ibeg_block = iw(ioldps+1+keep(ixsz)) + 1
380 IF (keep(405).EQ.0)
THEN
381 keep(425)=
max(keep(425),iend_block-ibeg_block)
384 keep(425)=
max(keep(425),iend_block-ibeg_block)
387 iend_block =
min(iend_block + nbkjib_orig, iend_blr)
390 ibeg_block_for_ipiv = ibeg_block
392 ibeg_block_for_ipiv = ibeg_blr
395 & ibeg_block_for_ipiv,iend_block,n,inode,
396 & iw,liw,a,la,inopv,noffw,nbtinyw,
397 & det_expw, det_mantw, det_signw,
398 & iflag,ioldps,poselt,uu,seuil_loc,keep,keep8,
399 & dkeep(1),pivnul_list(1),lpn_list,
400 & pp_first2swap_l, monbloc%LastPanelWritten_L,
401 & pp_lastpivrptrfilled_l,
402 & pp_first2swap_u, monbloc%LastPanelWritten_U,
403 & pp_lastpivrptrfilled_u,
404 & pivot_option, lr_activated, iend_blr,
405 & inextpiv, ooc_effective_on_front,
406 & nvschur, parpiv_t1,
409 IF (iflag.LT.0)
GOTO 500
416 ELSE IF (inopv .LE. 0)
THEN
418 IF (pivot_option.GE.3)
THEN
420 ELSEIF (pivot_option.EQ.2)
THEN
426 & nfront, nass, iw(ioldps+1+xsize),
427 & last_col, a, la, poselt, ifinb,
429 iw(ioldps+1+xsize) = iw(ioldps+1+xsize) + 1
433 ELSE IF (ifinb .EQ. -1)
THEN
437 npiv = iw(ioldps+1+xsize)
439 nelim = iend_blr - npiv
441 & n, inode, fpere, iw, liw, ioldps, poselt, a, la,
442 & nfront, ibeg_block, npiv, ipiv, nass,lastbl, idummy,
443 & comm, myid, bufr, lbufr, lbufr_bytes,nbfin,leaf,
444 & iflag, ierror, ipool,lpool,
445 & slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
446 & lrlus,
comp, ptrist, ptrast, ptlust_s, ptrfac, step,
447 & pimaster, pamaster, nstk_s,perm,procnode_steps,
448 & root, opassw, opeliw, itloc, rhs_mumps,
449 & fils, dad, ptrarw, ptraiw, intarr,dblarr,
451 & dkeep,nd,frere, lptrar, nelt, frtptr, frtelt,
452 & istep_to_iniv2, tab_pos_in_pere
454 & , npartsass, current_blr
455 & , blr_dummy, lrgroups
458 IF ( iflag .LT. 0 )
GOTO 500
459 IF ( ooc_eff_and_write_bypanel )
THEN
460 monbloc%LastPiv= iw(ioldps+1+xsize)
461 strat = strat_try_write
465 & a(poselt), lafac, monbloc,
466 & lnextpiv2bewritten, unextpiv2bewritten,
467 & iw(ioldps), liwfac,
468 & myid, keep8(31), iflag_ooc,last_call )
469 IF (iflag_ooc < 0 )
THEN
474 npiv = iw(ioldps+1+xsize)
475 IF ( iend_blr .GT. iend_block )
THEN
477 IF (pivot_option.GE.3)
THEN
479 ELSEIF (pivot_option.EQ.2)
THEN
485 & npiv, nfront, iend_blr, last_col,
488 & .true., .false., .true.,
494 npiv = iw(ioldps+1+xsize)
495 IF (lr_activated)
THEN
496 ALLOCATE(blr_u(nb_blr-current_blr),stat=allocok)
497 IF (allocok > 0)
THEN
499 ierror = nb_blr-current_blr
502 ALLOCATE(blr_l(npartsass-current_blr),stat=allocok)
503 IF (allocok > 0)
THEN
505 ierror = npartsass-current_blr
508 nelim = iend_blr - npiv
509 IF (nelim .EQ. iend_blr - ibeg_blr + 1)
THEN
516 DO j=1,nb_blr-current_blr
520 blr_u(j)%ISLR=.false.
527 & current_blr, blr_u)
528 DO j=1,npartsass-current_blr
532 blr_l(j)%ISLR=.false.
539 & current_blr, blr_l)
551 & begs_blr, nb_blr, dkeep(8), keep(466), keep(473), blr_u,
553 &
'H', work, tau, jpvt, lwork, rwork,
554 & block, maxi_cluster, nelim,
555 & .false., 0, 0, 2, keep(483), keep8,
558 IF (iflag.LT.0)
GOTO 300
559 IF ((keep(480).NE.0.AND.nb_blr.GT.current_blr)
565 IF (keep(480).LT.5)
THEN
569 & current_blr, blr_u)
575 IF (pivot_option.LT.3)
THEN
576 IF (pivot_option.LT.2)
THEN
577 first_block = current_blr+1
579 first_block = npartsass+1
584 & nb_blr, blr_u, current_blr,
585 & first_block, last_block, 2, 0, 1,
594 IF (lr_activated .OR. (k263.NE.0.AND.pivot_option.GE.3))
THEN
595 nelim = iend_blr - npiv
597 IF (
associated(blr_u))
THEN
601 & n, inode, fpere, iw, liw, ioldps, poselt, a, la, nfront,
602 & ibeg_blr, npiv, ipiv, nass,lastbl, idummy,
603 & comm, myid, bufr, lbufr, lbufr_bytes,nbfin,leaf,
604 & iflag, ierror, ipool,lpool,
605 & slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
606 & lrlus,
comp, ptrist, ptrast, ptlust_s, ptrfac, step,
607 & pimaster, pamaster, nstk_s,perm,procnode_steps,
608 & root, opassw, opeliw, itloc, rhs_mumps,
609 & fils, dad, ptrarw, ptraiw,
610 & intarr,dblarr,icntl,keep,keep8,dkeep,nd,frere,
611 & lptrar, nelt, frtptr, frtelt,
612 & istep_to_iniv2, tab_pos_in_pere
613 & , nelim, lr_activated
614 & , npartsass, current_blr
615 & , blr_send, lrgroups
618 IF (.NOT. lr_activated)
THEN
620 IF (pivot_option.EQ.2)
THEN
625 IF (iend_blr.LT.nass .OR. pivot_option.LT.3)
THEN
627 & npiv, nfront, nass, last_col,
628 & a, la, poselt, first_col, .true., (pivot_option.LT.3),
629 & .true., (keep(377).EQ.1),
632 IF (k263.NE.0 .AND. pivot_option.LT.3)
THEN
633 nelim = iend_blr - npiv
635 IF (
associated(blr_u))
THEN
639 & n, inode, fpere, iw, liw, ioldps, poselt, a, la,
640 & nfront, ibeg_blr, npiv, ipiv, nass,lastbl, idummy,
641 & comm, myid, bufr, lbufr, lbufr_bytes,nbfin,leaf,
642 & iflag, ierror, ipool,lpool,
643 & slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
644 & lrlus,
comp, ptrist, ptrast, ptlust_s, ptrfac, step,
645 & pimaster, pamaster, nstk_s,perm,procnode_steps,
646 & root, opassw, opeliw, itloc, rhs_mumps,
647 & fils, dad, ptrarw, ptraiw,
648 & intarr,dblarr,icntl,keep,keep8,dkeep,nd,frere,
649 & lptrar, nelt, frtptr, frtelt,
650 & istep_to_iniv2, tab_pos_in_pere
651 & , nelim, lr_activated
652 & , npartsass, current_blr
653 & , blr_send, lrgroups
657 nelim = iend_blr - npiv
658 IF (nelim .EQ. iend_blr - ibeg_blr + 1)
THEN
659 IF (keep(480).GE.2)
THEN
660 IF (iend_blr.LT.nass)
THEN
665 & nfront, iw(ioldps+xxf), 0,
666 & begs_blr, begs_blr, current_blr, acc_lua,
667 & nb_blr, npartsass, nelim,
669 & .false., iflag, ierror, 0,
670 & keep(481), dkeep(11), keep(466), keep(477),
671 & keep(480), keep(479), keep(478), keep(476),
672 & keep(483), maxi_cluster, maxi_rank,
673 & keep(474), 0, blr_u, keep8
675 IF (iflag.LT.0)
GOTO 600
677 & nfront, iw(ioldps+xxf), 1,
678 & begs_blr, begs_blr, current_blr, acc_lua,
679 & nb_blr, npartsass, nelim,
681 & .false., iflag, ierror, 0,
682 & keep(481), dkeep(11), keep(466), keep(477),
683 & keep(480), keep(479), keep(478), keep(476),
684 & keep(483), maxi_cluster, maxi_rank,
685 & keep(474), 0, blr_u, keep8,
692 IF (iflag.LT.0)
GOTO 500
695 IF (keep(486).EQ.3)
THEN
696 IF (keep(480).EQ.0)
THEN
697 DEALLOCATE(blr_u,blr_l)
704 IF (keep(475).EQ.0)
THEN
705 IF (iend_blr.LT.nfront)
THEN
707 & npiv, nfront, nass,
711 & .true., .false., .false.,
721 & begs_blr, npartsass, dkeep(8), keep(466), keep(473),
723 & current_blr,
'V', work, tau, jpvt, lwork, rwork,
724 & block, maxi_cluster, nelim,
726 & 2, keep(483), keep8
731 IF ((keep(480).NE.0.AND.nb_blr.GT.current_blr)
737 IF (keep(480).LT.5)
THEN
741 & current_blr, blr_l)
748 IF (iflag.LT.0)
GOTO 400
749 IF (keep(475).GT.0)
THEN
752 & npartsass, blr_l, current_blr, current_blr+1,
753 & npartsass, 2, 0, 0, .false.)
758 IF (keep(480).GE.2)
THEN
759 upos = poselt+int(begs_blr(current_blr)-1,8)*int(nfront,8)
760 & +int(begs_blr(current_blr+1)-nelim-1,8)
761 lpos = poselt+int(begs_blr(current_blr+1)-1,8)*int(nfront,8)
762 & +int(begs_blr(current_blr+1)-nelim-1,8)
764 & iflag, ierror, nfront, nfront,
765 & begs_blr, current_blr, blr_l, npartsass,
766 & current_blr+1, nelim,
'N')
767 IF (iflag.LT.0)
GOTO 444
768 IF (iend_blr.LT.nass)
THEN
770 & nfront, iw(ioldps+xxf), 0,
771 & begs_blr, begs_blr, current_blr, acc_lua,
772 & nb_blr, npartsass, nelim,
774 & .false., iflag, ierror, 0,
775 & keep(481), dkeep(11), keep(466), keep(477),
776 & keep(480), keep(479), keep(478), keep(476),
777 & keep(483), maxi_cluster, maxi_rank,
778 & keep(474), 0, blr_u, keep8
780 IF (iflag.LT.0)
GOTO 442
782 & nfront, iw(ioldps+xxf), 1,
783 & begs_blr, begs_blr, current_blr, acc_lua,
784 & nb_blr, npartsass, nelim,
786 & .false., iflag, ierror, 0,
787 & keep(481), dkeep(11), keep(466), keep(477),
788 & keep(480), keep(479), keep(478), keep(476),
789 & keep(483), maxi_cluster, maxi_rank,
790 & keep(474), 0, blr_u, keep8,
798 & iflag, ierror, nfront,
799 & begs_blr, begs_blr, current_blr, blr_l, npartsass,
800 & blr_u, nb_blr, nelim, .false., 0,
802 & keep(481), dkeep(11), keep(466), keep(477)
808 IF (iflag.LT.0)
GOTO 400
809 IF (keep(475).GT.0)
THEN
810 first_block = current_blr+1
811 IF (keep(486).EQ.2.AND.uu.EQ.0)
THEN
812 last_block = current_blr
814 last_block = npartsass
818 & begs_blr(current_blr),
819 & begs_blr(current_blr+1), npartsass, blr_l, current_blr,
'V',
821 & beg_i_in=first_block, end_i_in=last_block)
825 IF (keep(475).GE.2)
THEN
826 IF (keep(475).EQ.2)
THEN
827 first_block = npartsass+1
829 first_block = current_blr+1
831 IF (keep(486).NE.2)
THEN
834 last_block = npartsass
836 last_block = current_blr
840 & begs_blr(current_blr),
841 & begs_blr(current_blr+1), nb_blr, blr_u, current_blr,
'H',
843 & beg_i_in=first_block, end_i_in=last_block)
849 IF (iflag.LT.0)
GOTO 500
850 IF (keep(486).EQ.3)
THEN
851 IF (keep(480).EQ.0.OR.nb_blr.EQ.current_blr)
THEN
856 DEALLOCATE(blr_u,blr_l)
862 IF ( ooc_effective_on_front )
THEN
863 strat = strat_try_write
864 monbloc%LastPiv = npiv
869 & lnextpiv2bewritten, unextpiv2bewritten,
870 & iw(ioldps), liwfac,
871 & myid, keep8(31), iflag_ooc,last_call )
872 IF (iflag_ooc < 0 )
THEN
879 IF (lr_activated)
THEN
880 ibeg_blr = iw(ioldps+1+xsize) + 1
881 begs_blr( current_blr + 1 ) = ibeg_blr
882 IF ( (keep(486).EQ.2)
887 allocate(begs_blr_tmp(nb_blr+1),stat=allocok)
888 IF (allocok > 0)
THEN
894 begs_blr_tmp(ip) = begs_blr_static(ip)
912 IF (iflag.LT.0) cycle
913 diagsiz_dyn = begs_blr(ip+1)-begs_blr(ip)
914 diagsiz_sta = begs_blr_static(ip+1)-begs_blr(ip)
915 mem = diagsiz_dyn*(2*diagsiz_sta-diagsiz_dyn)
916 mem_tot = mem_tot + mem
917 ALLOCATE(diag(mem), stat=allocok)
918 IF (allocok > 0)
THEN
924 poselt_diag = poselt + int(begs_blr(ip)-1,8)*int(nfront,8)
925 & + int(begs_blr(ip)-1,8)
927 IF (i.LE.diagsiz_dyn)
THEN
928 diag(dpos:dpos+diagsiz_sta-1) =
929 & a(poselt_diag:poselt_diag+int(diagsiz_sta-1,8))
930 dpos = dpos + diagsiz_sta
932 diag(dpos:dpos+diagsiz_dyn-1) =
933 & a(poselt_diag:poselt_diag+int(diagsiz_dyn-1,8))
934 dpos = dpos + diagsiz_dyn
936 poselt_diag = poselt_diag + int(nfront,8)
947 & .false., keep8, iflag, ierror, .true., .true.)
951 IF (iflag.LT.0)
GOTO 460
954 nelim = begs_blr_tmp(ip+1)-begs_blr(ip+1)
960 & iw(ioldps+xxf), loru, ip, blr_panel)
972 & ierror, nfront, begs_blr_tmp,
973 & nb_blr, dkeep(8), keep(466), keep(473),
975 & dir, work, tau, jpvt, lwork, rwork,
976 & block, maxi_cluster, nelim,
978 & 2, keep(483), keep8,
979 & end_i_in=npartsass, frswap=.true.
984 IF (iflag.LT.0)
GOTO 440
990 begs_blr_tmp(ip+1) = begs_blr(ip+1)
1005 deallocate(begs_blr_tmp)
1008 IF (iflag.LT.0)
GOTO 500
1009 IF ( (keep(486).EQ.2)
1014 IF (iflag.GE.0)
THEN
1018 & iw(ioldps+xxf), 0, ip, blr_panel)
1022 & iw(ioldps+xxf), 1, ip, blr_panel)
1029 IF (keep(486).NE.0)
THEN
1030 IF (.NOT.lr_activated)
THEN
1034 IF (iflag.LT.0)
GOTO 500
1035 IF ( ooc_effective_on_front )
THEN
1036 strat = strat_write_max
1037 monbloc%Last = .true.
1038 monbloc%LastPiv = iw(ioldps+1+xsize)
1042 & a(poselt), lafac, monbloc,
1043 & lnextpiv2bewritten, unextpiv2bewritten,
1044 & iw(ioldps), liwfac,
1045 & myid, keep8(31), iflag_ooc, last_call )
1046 IF (iflag_ooc < 0 )
THEN
1051 & ioldps, iw, liw, monbloc , nfront, keep)
1058 IF (lr_activated)
THEN
1059 IF (
allocated(rwork))
DEALLOCATE(rwork)
1060 IF (
allocated(work))
DEALLOCATE(work)
1061 IF (
allocated(tau))
DEALLOCATE(tau)
1062 IF (
allocated(jpvt))
DEALLOCATE(jpvt)
1063 IF (
allocated(block))
DEALLOCATE(block)
1064 IF (
associated(acc_lua))
THEN
1065 IF (keep(480).GE.3)
THEN
1067 CALL dealloc_lrb(acc_lua(my_num), keep8, keep(34))
1072 IF (
associated(begs_blr))
THEN
1073 DEALLOCATE(begs_blr)
1077 IF (lr_activated.AND.keep(480).NE.0)
THEN
1088 IF (lr_activated)
THEN