17 & N, INODE, IW, LIW, A,
19 & IOLDPS, POSELT, IFLAG, IERROR, UU,
20 & NOFFW, NPVW, NBTINYW,
21 & DET_EXPW, DET_MANTW, DET_SIGNW,
23 & PROCNODE_STEPS, MYID, SLAVEF, SEUIL,
24 & AVOID_DELAYED, ETATASS,
25 & DKEEP,PIVNUL_LIST,LPN_LIST,
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 COMPLEX(kind=8),
INTENT(INOUT) ::
47 COMPLEX(kind=8) A( LA )
48 INTEGER MYID, SLAVEF, IOLDPS
51 INTEGER PROCNODE_STEPS( KEEP(28) ), STEP(N)
52 DOUBLE PRECISION UU, SEUIL
54 INTEGER ETATASS, IWPOS
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
63 INTEGER LAST_ROW, LAST_COL, FIRST_COL
64 LOGICAL CALL_LTRSM, CALL_UTRSM
65 DOUBLE PRECISION UUTEMP
67 DOUBLE PRECISION SEUIL_LOC
71 INTEGER LIWFAC, STRAT, LNextPiv2beWritten,
72 & unextpiv2bewritten, iflag_ooc,
73 & pp_first2swap_l, pp_first2swap_u,
74 & pp_lastpivrptrfilled_l,
75 & pp_lastpivrptrfilled_u
77 TYPE(io_block) :: MonBloc
82 LOGICAL COMPRESS_CB, COMPRESS_PANEL
83 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR,
84 & ooc_effective_on_front,
85 & ooc_eff_and_write_bypanel
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 COMPLEX(kind=8),
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 COMPLEX(kind=8),
ALLOCATABLE :: WORK(:), TAU(:)
104 INTEGER,
ALLOCATABLE :: JPVT(:)
105 DOUBLE PRECISION,
ALLOCATABLE :: RWORK(:)
106 COMPLEX(kind=8),
ALLOCATABLE :: BLOCK(:,:)
110 INTEGER(8) :: UPOS, LPOS
112 TYPE(
lrb_type),
POINTER,
DIMENSION(:) :: NEXT_BLR_U, NEXT_BLR_L
113 INTEGER,
POINTER,
DIMENSION(:) :: BEGS_BLR_STATIC
114 COMPLEX(kind=8) :: ZERO
115 parameter(zero=(0.0d0,0.0d0))
116 include
'mumps_headers.h'
120 IF (keep(206).GE.1)
THEN
127 IF(keep(97) .EQ. 0)
THEN
132 IF (avoid_delayed)
THEN
135 seuil_loc =
max(seuil,epsilon(seuil))
139 pivot_option = keep(468)
140 lrtrsm_option = keep(475)
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.
155 NULLIFY(begs_blr_tmp)
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
168 oocwrite_compatible_with_blr =
169 & ( .NOT.lr_activated.OR.(.NOT.compress_panel).OR.
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
178 ELSE IF (parpiv_t1.NE.0)
THEN
179 pivot_option =
min(pivot_option,2)
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)
188 IF (pivot_option.LE.1)
THEN
191 IF (nass.LT.keep(4))
THEN
193 ELSE IF (nass .GT. keep(3))
THEN
194 nbkjib_orig =
min( keep(6), nass )
196 nbkjib_orig =
min( keep(5), nass )
198 IF (.not.lr_activated)
THEN
199 nblr_orig = keep(420)
203 IF ((keep(114).EQ.1) .AND.
204 & (keep(116).GT.0) .AND. ((nfront-nass-keep(253)).GT.0)
206 irow_l = ioldps+6+xsize+nass
209 & nfront-nass-keep(253),
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.
233 monbloc%NROW = nfront
234 monbloc%NCOL = nfront
236 monbloc%Last = .false.
237 monbloc%LastPiv = -88877
238 NULLIFY(monbloc%INDICES)
240 IF (lr_activated)
THEN
241 IF (keep(405) .EQ. 1)
THEN
248 ELSE IF (keep(486).NE.0)
THEN
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
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),
273 IF (allocok > 0)
THEN
275 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
278 ALLOCATE(acc_lua(omp_num),stat=allocok)
279 IF (allocok > 0)
THEN
284 IF (keep(480).GE.3)
THEN
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
294 IF (lr_activated.AND.
314 IF (iflag.LT.0)
GOTO 500
316 IF (compress_cb.AND.npartscb.GT.0)
THEN
317 allocate(cb_lrb(npartscb,npartscb),stat=allocok)
318 IF (allocok > 0)
THEN
320 ierror = npartscb*npartscb
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)
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
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
344 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
347 IF (keep(480).GE.3)
THEN
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
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
365 ierror = nb_blr-current_blr
368 ALLOCATE(blr_l(nb_blr-current_blr),stat=allocok)
369 IF (allocok > 0)
THEN
371 ierror = nb_blr-current_blr
374 IF (nb_blr.GT.current_blr)
THEN
375 blr_u(1:nb_blr-current_blr)%ISLR=.false.
379 & current_blr, blr_u)
380 blr_l(1:nb_blr-current_blr)%ISLR=.false.
384 & current_blr, blr_l)
387 IF (nb_blr.GT.current_blr)
THEN
391 & current_blr, blr_u)
395 & current_blr, blr_l)
398 IF (current_blr.LT.npartsass)
THEN
399 ALLOCATE(next_blr_u(nb_blr-current_blr-1),stat=allocok)
400 IF (allocok > 0)
THEN
402 ierror = nb_blr-current_blr-1
405 ALLOCATE(next_blr_l(nb_blr-current_blr-1),stat=allocok)
406 IF (allocok > 0)
THEN
408 ierror = nb_blr-current_blr-1
411 IF (nb_blr.GT.current_blr+1)
THEN
415 & current_blr+1, next_blr_u)
419 & current_blr+1, next_blr_l)
423 ALLOCATE(blr_u(nb_blr-current_blr),stat=allocok)
424 IF (allocok > 0)
THEN
426 ierror = nb_blr-current_blr
429 ALLOCATE(blr_l(nb_blr-current_blr),stat=allocok)
430 IF (allocok > 0)
THEN
432 ierror = nb_blr-current_blr
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)
443 keep(425)=
max(keep(425),iend_block-ibeg_block)
446 iend_block =
min(iend_block + nbkjib_orig, iend_blr)
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,
462 IF (iflag.LT.0)
GOTO 500
468 ELSE IF ( inopv.LE.0 )
THEN
470 IF (pivot_option.GE.3)
THEN
472 ELSEIF (pivot_option.EQ.2)
THEN
478 & nfront, nass, iw(ioldps+1+xsize),
479 & last_col, a, la, poselt, ifinb,
482 iw(ioldps+1+xsize) = iw(ioldps+1+xsize) + 1
487 IF ( ooc_eff_and_write_bypanel )
THEN
488 monbloc%LastPiv= iw(ioldps+1+xsize)
489 strat = strat_try_write
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
502 npiv = iw(ioldps+1+xsize)
503 IF ( iend_blr .GT. iend_block )
THEN
504 IF (pivot_option.GE.3)
THEN
506 ELSEIF (pivot_option.EQ.2)
THEN
512 & npiv, nfront, iend_blr, last_col,
515 & .true., .false., .true.,
521 npiv = iw(ioldps+1+xsize)
522 IF (.NOT. lr_activated
523 & .OR. (.NOT. compress_panel)
525 IF (pivot_option.EQ.4)
THEN
530 IF (pivot_option.GE.3)
THEN
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),
543 nelim = iend_blr - npiv
544 IF (nelim .EQ. iend_blr - ibeg_blr + 1)
THEN
551 DO j=1,nb_blr-current_blr
555 blr_u(j)%ISLR=.false.
562 & current_blr, blr_u)
563 DO j=1,nb_blr-current_blr
567 blr_l(j)%ISLR=.false.
574 & current_blr, blr_l)
577 IF (keep(480).GE.2 .AND. iend_blr.LT.nass)
THEN
578 IF (lrtrsm_option.EQ.3)
THEN
581 first_block = npartsass-current_blr
587 & nfront, iw(ioldps+xxf), 0,
588 & begs_blr, begs_blr, current_blr, acc_lua,
589 & nb_blr, npartsass, nelim,
591 & .false., iflag, ierror, 0,
592 & keep(481), dkeep(11), keep(466), keep(477),
594 & keep(483), maxi_cluster, maxi_rank,
595 & keep(474), 0, blr_u,
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,
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,
610 & first_block=first_block)
615 IF (iflag.LT.0)
GOTO 500
618 IF (keep(486).EQ.3)
THEN
619 IF (keep(480).EQ.0)
THEN
620 DEALLOCATE(blr_u,blr_l)
627 IF (pivot_option.GE.3)
THEN
629 ELSEIF (pivot_option.EQ.2)
THEN
634 IF (lrtrsm_option.EQ.3)
THEN
636 ELSEIF (lrtrsm_option.EQ.2)
THEN
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,
649 & first_col, call_ltrsm,
650 & call_utrsm, .false.,
657!$omp parallel private(upos,lpos) firstprivate(first_block,last_block)
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,
667 & 1, keep(483), keep8,
673 IF (iflag.LT.0)
GOTO 400
676 & begs_blr, nb_blr, dkeep(8), keep(466), k473_loc, blr_l,
678 &
'V', work, tau, jpvt, lwork, rwork,
679 & block, maxi_cluster, nelim,
681 & 1, keep(483), keep8,
694 IF (keep(480).LT.5)
THEN
698 & current_blr, blr_u)
702 & current_blr, blr_l)
709 IF (iflag.LT.0)
GOTO 400
710 IF (lrtrsm_option.GT.0)
THEN
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
719 first_block = npartsass+1
722 & ibeg_blr, nb_blr, blr_u,
723 & current_blr, first_block, nb_blr,
729 & a, la, poselt, iflag, ierror, nfront,
730 & begs_blr, current_blr, blr_u, nb_blr,
731 & first_block, ibeg_blr, npiv, nelim)
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
752 first_block = npartsass-current_blr
755 & nfront, iw(ioldps+xxf), 0,
756 & begs_blr, begs_blr, current_blr, acc_lua,
757 & nb_blr, npartsass, nelim,
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,
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,
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,
778 & first_block=first_block)
784 & iflag, ierror, nfront,
785 & begs_blr, begs_blr, current_blr, blr_l, nb_blr,
789 & keep(481), dkeep(11), keep(466), keep(477)
795 IF (iflag.LT.0)
GOTO 400
796 IF (keep(486).NE.2)
THEN
799 last_block = npartsass
801 last_block = current_blr
803 IF (lrtrsm_option.GT.0)
THEN
804 first_block = current_blr+1
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)
814 IF (lrtrsm_option.GE.2)
THEN
815 IF (lrtrsm_option.EQ.2)
THEN
816 first_block = npartsass+1
818 first_block = current_blr+1
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)
831 IF (iflag.LT.0)
GOTO 500
832 IF (keep(486).EQ.3)
THEN
833 IF (keep(480).EQ.0)
THEN
838 DEALLOCATE(blr_u,blr_l)
844 IF ( ooc_eff_and_write_bypanel )
THEN
845 IF (pivot_option.LT.4)
THEN
850 monbloc%LastPiv= iw(ioldps+1+xsize)
851 strat = strat_try_write
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
866 IF (lr_activated)
THEN
867 ibeg_blr = iw(ioldps+1+keep(ixsz)) + 1
868 begs_blr( current_blr + 1 ) = ibeg_blr
875 allocate(begs_blr_tmp(nb_blr+1),stat=allocok)
876 IF (allocok > 0)
THEN
882 begs_blr_tmp(ip) = begs_blr_static(ip)
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
912 poselt_diag = poselt + int(begs_blr(ip)-1,8)*int(nfront,8)
913 & + int(begs_blr(ip)-1,8)
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
920 diag(dpos:dpos+diagsiz_dyn-1) =
921 & a(poselt_diag:poselt_diag+int(diagsiz_dyn-1,8))
922 dpos = dpos + diagsiz_dyn
924 poselt_diag = poselt_diag + int(nfront,8)
935 & (keep(405).NE.0), keep8, iflag, ierror, .true., .true.)
939 IF (iflag.LT.0)
GOTO 447
942 nelim_loc = begs_blr_tmp(ip+1)-begs_blr(ip+1)
945 & iw(ioldps+xxf), loru, ip, blr_panel)
960 & ierror, nfront, begs_blr_tmp,
961 & nb_blr, dkeep(8), keep(466), k473_loc,
963 & dir, work, tau, jpvt, lwork, rwork,
964 & block, maxi_cluster, nelim_loc,
967 & end_i_in=npartsass, frswap=.true.
972 IF (iflag.LT.0)
GOTO 445
978 begs_blr_tmp(ip+1) = begs_blr(ip+1)
990 IF (iflag .LT. 0)
GOTO 450
991 IF (keep(480) .GE. 2)
THEN
1001 & begs_blr_static, begs_blr_static,
1002 & npartscb, npartscb, npartsass, nass,
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,
1015 IF (iflag.LT.0)
GOTO 450
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
1041 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
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),
1074 deallocate(begs_blr_tmp)
1076 IF (iflag.LT.0)
GOTO 500
1081 & iw(ioldps+xxf), loru, ip, blr_panel)
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,
1094 & pp_first2swap_l, pp_first2swap_u,
1095 & lnextpiv2bewritten, unextpiv2bewritten,
1096 & pp_lastpivrptrfilled_l, pp_lastpivrptrfilled_u,
1098 & xsize, seuil, uu, dkeep, keep8, keep, iflag,
1099 & ooc_effective_on_front, nvschur )
1101 IF (keep(486).NE.0)
THEN
1102 IF (.NOT.lr_activated)
THEN
1106 IF ( ooc_effective_on_front )
THEN
1107 strat = strat_write_max
1108 monbloc%Last = .true.
1109 monbloc%LastPiv = iw(ioldps+1+xsize)
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
1122 & ioldps, iw, liw, monbloc , nfront, keep)
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
1137 CALL dealloc_lrb(acc_lua(my_num), keep8, keep(34))
1143 IF (
associated(begs_blr))
THEN
1144 DEALLOCATE(begs_blr)
1148 IF (lr_activated.AND.(keep(480).NE.0))
THEN
1158 IF (lr_activated)
THEN
1163 & .AND..NOT.compress_cb)
THEN
1165 & keep(34), mtk405=keep(405))
1168 npvw = npvw + iw(ioldps+1+xsize)