OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
smumps_fac2_ldlt_m Module Reference

Functions/Subroutines

subroutine smumps_fac2_ldlt (comm_load, ass_irecv, n, inode, fpere, iw, liw, a, la, uu, nnegw, npvw, nb22t2w, nbtinyw, det_expw, det_mantw, det_signw, comm, myid, bufr, lbufr, lbufr_bytes, nbfin, leaf, iflag, ierror, ipool, lpool, slavef, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, comp, ptrist, ptrast, ptlust_s, ptrfac, step, pimaster, pamaster, nstk_s, perm, procnode_steps, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, nd, frere, lptrar, nelt, frtptr, frtelt, seuil, istep_to_iniv2, tab_pos_in_pere, avoid_delayed, dkeep, pivnul_list, lpn_list, lrgroups)
subroutine smumps_reset_to_one (front_index_list, npiv, ibeg_block, k109_save, k109, pivnul_list, lpn_list, a, poselt, la, ldafs)

Function/Subroutine Documentation

◆ smumps_fac2_ldlt()

subroutine smumps_fac2_ldlt_m::smumps_fac2_ldlt ( integer comm_load,
integer ass_irecv,
integer n,
integer inode,
integer fpere,
integer, dimension( liw ), target iw,
integer liw,
real, dimension( la ) a,
integer(8) la,
real uu,
integer, intent(inout) nnegw,
integer, intent(inout) npvw,
integer, intent(inout) nb22t2w,
integer, intent(inout) nbtinyw,
integer, intent(inout) det_expw,
real, intent(inout) det_mantw,
integer, intent(inout) det_signw,
integer comm,
integer myid,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer nbfin,
integer leaf,
integer iflag,
integer ierror,
integer, dimension(lpool) ipool,
integer lpool,
integer slavef,
integer(8) posfac,
integer iwpos,
integer iwposcb,
integer(8) iptrlu,
integer(8) lrlu,
integer(8) lrlus,
integer comp,
integer, dimension(keep(28)) ptrist,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(keep(28)) ptlust_s,
integer(8), dimension(keep(28)) ptrfac,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer, dimension(keep(28)) nstk_s,
integer, dimension(n) perm,
integer, dimension(keep(28)) procnode_steps,
type (smumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension(n+keep(253)) itloc,
real, dimension(keep(255)) rhs_mumps,
integer, dimension(n) fils,
integer, dimension( keep(28) ) dad,
integer(8), dimension(lptrar), intent(in) ptrarw,
integer(8), dimension(lptrar), intent(in) ptraiw,
integer, dimension(keep8(27)) intarr,
real, dimension(keep8(26)) dblarr,
integer, dimension(60) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer, dimension( keep(28) ) nd,
integer, dimension( keep(28) ) frere,
integer lptrar,
integer nelt,
integer, dimension( n + 1 ) frtptr,
integer, dimension( nelt ) frtelt,
real seuil,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
logical avoid_delayed,
real, dimension(230) dkeep,
integer, dimension(lpn_list) pivnul_list,
integer lpn_list,
integer, dimension(n) lrgroups )

Definition at line 16 of file sfac_front_LDLT_type2.F.

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

◆ smumps_reset_to_one()

subroutine smumps_fac2_ldlt_m::smumps_reset_to_one ( integer, dimension(npiv), intent(in) front_index_list,
integer, intent(in) npiv,
integer, intent(in) ibeg_block,
integer, intent(inout) k109_save,
integer, intent(in) k109,
integer, dimension(lpn_list), intent(in) pivnul_list,
integer, intent(in) lpn_list,
real, dimension(la), intent(inout) a,
integer(8), intent(in) poselt,
integer(8), intent(in) la,
integer, intent(in) ldafs )

Definition at line 976 of file sfac_front_LDLT_type2.F.

979 INTEGER, INTENT(IN) :: NPIV, IBEG_BLOCK
980 INTEGER, INTENT(IN) :: FRONT_INDEX_LIST(NPIV)
981 INTEGER, INTENT(IN) :: K109
982 INTEGER, INTENT(INOUT) :: K109_SAVE
983 INTEGER, INTENT(IN) :: LPN_LIST
984 INTEGER, INTENT(IN) :: PIVNUL_LIST(LPN_LIST)
985 INTEGER(8), INTENT(IN) :: POSELT, LA
986 INTEGER, INTENT(IN) :: LDAFS
987 REAL, INTENT(INOUT) :: A(LA)
988 LOGICAL :: TO_UPDATE
989 INTEGER :: I, JJ, K
990 REAL ONE
991 parameter(one = 1.0e0)
992 DO k = k109_save+1, k109
993 to_update = .false.
994 i = pivnul_list(k)
995 DO jj=ibeg_block, npiv
996 IF (front_index_list(jj) .EQ.i) THEN
997 to_update=.true.
998 EXIT
999 ENDIF
1000 ENDDO
1001 IF (to_update) THEN
1002 a(poselt+int(jj,8)+int(ldafs,8)*int(jj-1,8))= one
1003 to_update=.false.
1004 ELSE
1005 write(*,*) ' Internal error related ',
1006 & 'to null pivot row detection'
1007 CALL mumps_abort()
1008 ENDIF
1009 ENDDO
1010 k109_save = k109
1011 RETURN