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

Functions/Subroutines

subroutine cmumps_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 cmumps_fac_mq_ldlt_niv2 (iend_block, nass, npiv, inode, a, la, ldafs, poselt, ifinb, pivsiz, k219, pivot_option, iend_blr, lr_activated)
subroutine cmumps_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)

Function/Subroutine Documentation

◆ cmumps_fac_i_ldlt_niv2()

subroutine cmumps_fac_front_type2_aux_m::cmumps_fac_i_ldlt_niv2 ( real, dimension(sizediag_orig) diag_orig,
integer sizediag_orig,
real gw_factcumul,
integer nfront,
integer nass,
integer ibeg_block_to_send,
integer ibeg_block,
integer iend_block,
integer nass2,
integer, dimension( nass2 ) tipiv,
integer n,
integer inode,
integer, dimension(liw) iw,
integer liw,
complex, dimension(la) a,
integer(8) la,
integer, intent(inout) nnegw,
integer, intent(inout) nb22t2w,
integer, intent(inout) nbtinyw,
integer, intent(inout) det_expw,
complex, intent(inout) det_mantw,
integer, intent(inout) det_signw,
integer inopv,
integer iflag,
integer ioldps,
integer(8) poselt,
real uu,
real seuil,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer pivsiz,
real, dimension(230) dkeep,
integer, dimension(lpn_list) pivnul_list,
integer lpn_list,
integer pp_first2swap_l,
integer pp_lastpanelondisk,
integer pp_lastpivrptrindexfilled,
integer, intent(in) pivot_option,
integer, intent(inout) inextpiv,
integer, intent(in) iend_blr,
logical, intent(in) lr_activated,
logical, intent(in) ooc_effective_on_front )

Definition at line 16 of file cfac_front_type2_aux.F.

31 USE mumps_ooc_common, ONLY : typef_l
32 USE cmumps_fac_front_aux_m
33 IMPLICIT NONE
34 INTEGER SIZEDIAG_ORIG
35 REAL DIAG_ORIG(SIZEDIAG_ORIG)
36 REAL GW_FACTCUMUL
37 INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV
38 INTEGER NASS2, IBEG_BLOCK_TO_SEND, IBEG_BLOCK, IEND_BLOCK
39 INTEGER, intent(inout) :: NNEGW, NB22T2W, NBTINYW
40 INTEGER, intent(inout) :: DET_EXPW, DET_SIGNW
41 COMPLEX, intent(inout) :: DET_MANTW
42 INTEGER TIPIV( NASS2 )
43 INTEGER PIVSIZ,LPIV
44 INTEGER, intent(in) :: PIVOT_OPTION, IEND_BLR
45 LOGICAL, intent(in) :: LR_ACTIVATED
46 INTEGER, intent(inout) :: Inextpiv
47 LOGICAL, intent(in) :: OOC_EFFECTIVE_ON_FRONT
48 INTEGER(8) :: LA
49 COMPLEX A(LA)
50 REAL UU, UULOC, SEUIL
51 COMPLEX CSEUIL
52 INTEGER IW(LIW)
53 INTEGER IOLDPS
54 INTEGER(8) :: POSELT
55 INTEGER KEEP(500)
56 INTEGER(8) KEEP8(150)
57 INTEGER LPN_LIST
58 INTEGER PIVNUL_LIST(LPN_LIST)
59 REAL DKEEP(230)
60 INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk
61 INTEGER PP_LastPIVRPTRIndexFilled
62 include 'mpif.h'
63 INTEGER(8) :: POSPV1,POSPV2,OFFDAG,APOSJ
64 INTEGER JMAX
65 INTEGER :: IPIVNUL, HF
66 REAL RMAX,AMAX,TMAX,RMAX_NORELAX,MAX_PREV_in_PARPIV
67 REAL MAXPIV, ABS_PIVOT
68 REAL RMAX_NOSLAVE, TMAX_NOSLAVE
69 COMPLEX PIVOT,DETPIV
70 REAL ABSDETPIV
71 include 'mumps_headers.h'
72 INTEGER(8) :: APOSMAX, APOSROW
73 INTEGER(8) :: APOS
74 INTEGER(8) :: J1, J2, JJ, KK
75 REAL :: GROWTH, RSWOP
76 REAL :: UULOCM1
77 INTEGER :: LDAFS
78 INTEGER(8) :: LDAFS8
79 REAL, PARAMETER :: RZERO = 0.0e0
80 REAL, PARAMETER :: RONE = 1.0e0
81 COMPLEX ZERO, ONE
82 parameter( zero = (0.0e0,0.0e0) )
83 parameter( one = (1.0e0,0.0e0) )
84 REAL PIVNUL, VALTMP
85 COMPLEX FIXA
86 INTEGER NPIV,IPIV,K219
87 INTEGER NPIVP1,ILOC,K,J
88 INTEGER ISHIFT, K206, IPIV_END, IPIV_SHIFT
89 INTRINSIC max
90 INTEGER I_PIVRPTR, I_PIVR, NBPANELS_L
91 REAL GW_FACT
92 gw_fact = rone
93 amax = rzero
94 rmax = rzero
95 tmax = rzero
96 rmax_noslave = rzero
97 pivot = one
98 hf = 6 + iw(ioldps+5+keep(ixsz)) + keep(ixsz)
99 k206 = keep(206)
100 pivnul = dkeep(1)
101 fixa = cmplx(dkeep(2),kind=kind(fixa))
102 cseuil = cmplx(seuil,kind=kind(cseuil))
103 ldafs = nass
104 ldafs8 = int(ldafs,8)
105 IF ((keep(50).NE.1) .AND. ooc_effective_on_front) THEN
106 CALL cmumps_get_ooc_perm_ptr(typef_l, nbpanels_l,
107 & i_pivrptr, i_pivr,
108 & ioldps+2*nfront+6+iw(ioldps+5+keep(ixsz))
109 & +keep(ixsz),
110 & iw, liw)
111 ENDIF
112 uuloc = uu
113 k219 = keep(219)
114 IF (uuloc.GT.rzero) THEN
115 uulocm1 = rone/uuloc
116 ELSE
117 k219=0
118 uulocm1 = rone
119 ENDIF
120 IF (k219.LT.2) gw_factcumul = rone
121 pivsiz = 1
122 npiv = iw(ioldps+1+keep(ixsz))
123 npivp1 = npiv + 1
124 iloc = npivp1 - ibeg_block_to_send + 1
125 tipiv( iloc ) = iloc
126 aposmax = poselt+ldafs8*ldafs8-1_8
127 IF(inopv .EQ. -1) THEN
128 apos = poselt + ldafs8*int(npivp1-1,8) + int(npiv,8)
129 pospv1 = apos
130 abs_pivot = abs(pivot)
131 CALL cmumps_update_minmax_pivot
132 & ( abs_pivot,
133 & dkeep, keep, .true.)
134 IF(abs_pivot.LT.seuil) THEN
135 IF(real(a(apos)) .GE. rzero) THEN
136 a(apos) = cseuil
137 ELSE
138 a(apos) = -cseuil
139 ENDIF
140 nbtinyw = nbtinyw + 1
141 ELSE IF (keep(258) .NE.0 ) THEN
142 CALL cmumps_updatedeter( a(apos), det_mantw, det_expw )
143 ENDIF
144 IF ((keep(50).NE.1) .AND. ooc_effective_on_front) THEN
145 CALL cmumps_store_perminfo( iw(i_pivrptr), nbpanels_l,
146 & iw(i_pivr), nass, npivp1, npivp1,
147 & pp_lastpanelondisk,
148 & pp_lastpivrptrindexfilled)
149 ENDIF
150 GO TO 420
151 ENDIF
152 inopv = 0
153 IF ((k219.GE.2).AND.(npivp1.EQ.1)) THEN
154 gw_factcumul = rone
155 IF (k219.EQ.3) THEN
156 DO ipiv=1,nass
157 diag_orig(ipiv) = abs(a(poselt +
158 & (ldafs8+1_8)*int(ipiv-1,8)))
159 ENDDO
160 ELSE IF (k219.GE.4) THEN
161 diag_orig = rzero
162 DO ipiv=1,nass
163 apos = poselt + ldafs8*int(ipiv-1,8)
164 pospv1 = apos + int(ipiv - 1,8)
165 diag_orig(ipiv) = max( abs(a(pospv1)), diag_orig(ipiv) )
166 DO j=ipiv+1,nass
167 diag_orig(ipiv) = max( abs(a(pospv1)), diag_orig(ipiv) )
168 diag_orig(ipiv+j-ipiv) = max( abs(a(pospv1)),
169 & diag_orig(ipiv+j-ipiv) )
170 pospv1 = pospv1 + ldafs8
171 ENDDO
172 ENDDO
173 ENDIF
174 ENDIF
175 ishift = 0
176 ipiv_end = iend_block
177 IF (k206.GE.1) THEN
178 IF (inextpiv.GT.npivp1.AND.inextpiv.LE.iend_block) THEN
179 ishift = inextpiv - npivp1
180 ENDIF
181 IF ( k206.EQ.1
182 & .OR. (k206 .GT.1 .AND. iend_block.EQ.iend_blr) ) THEN
183 ipiv_end = iend_block + ishift
184 ENDIF
185 ENDIF
186 DO 460 ipiv_shift = npivp1+ishift, ipiv_end
187 IF (ipiv_shift .LE. iend_block) THEN
188 ipiv=ipiv_shift
189 ELSE
190 ipiv = ipiv_shift-iend_block-1+npivp1
191 IF (ibeg_block.EQ.npivp1) THEN
192 EXIT
193 ENDIF
194 ENDIF
195 apos = poselt + ldafs8*int(ipiv-1,8) + int(npiv,8)
196 pospv1 = apos + int(ipiv - npivp1,8)
197 pivot = a(pospv1)
198 abs_pivot = abs(pivot)
199 IF (uuloc.EQ.rzero.OR.pivot_option.EQ.0) THEN
200 IF(abs_pivot.LT.seuil) THEN
201 CALL cmumps_update_minmax_pivot
202 & ( abs_pivot,
203 & dkeep, keep, .true.)
204 IF(real(pivot) .GE. rzero) THEN
205 a(pospv1) = cseuil
206 ELSE
207 a(pospv1) = -cseuil
208 ENDIF
209 nbtinyw = nbtinyw + 1
210 ELSE IF (abs_pivot.EQ.rzero) THEN
211 GO TO 630
212 ELSE
213 CALL cmumps_update_minmax_pivot
214 & ( abs_pivot, dkeep, keep, .false.)
215 IF (keep(258) .NE. 0) THEN
216 CALL cmumps_updatedeter(pivot, det_mantw, det_expw )
217 ENDIF
218 ENDIF
219 GO TO 420
220 ENDIF
221 amax = -rone
222 jmax = 0
223 j1 = apos
224 j2 = pospv1 - 1_8
225 DO jj=j1,j2
226 IF(abs(a(jj)) .GT. amax) THEN
227 amax = abs(a(jj))
228 jmax = ipiv - int(pospv1-jj)
229 ENDIF
230 ENDDO
231 j1 = pospv1 + ldafs8
232 DO j=1, iend_block - ipiv
233 IF(abs(a(j1)) .GT. amax) THEN
234 amax = abs(a(j1))
235 jmax = ipiv + j
236 ENDIF
237 j1 = j1 + ldafs8
238 ENDDO
239 rmax_noslave = rzero
240 IF (pivot_option.EQ.2) THEN
241 DO j=1,nass - iend_block
242 rmax_noslave = max(abs(a(j1+ldafs8*int(j-1,8))),
243 & rmax_noslave)
244 ENDDO
245 ENDIF
246 IF (k219.NE.0) THEN
247 rmax_norelax = real(a(aposmax+int(ipiv,8)))
248 rmax = rmax_norelax
249 IF (k219.GE.2) THEN
250 IF (abs_pivot.NE.rzero.AND.
251 & abs_pivot.GE.uuloc*max(rmax,rmax_noslave,amax))
252 & THEN
253 growth = rone
254 IF (k219.EQ.3) THEN
255 IF (diag_orig(ipiv).EQ.rzero) THEN
256 diag_orig(ipiv) = abs_pivot
257 ELSE
258 growth = abs_pivot / diag_orig(ipiv)
259 ENDIF
260 ELSE IF (k219.GE.4) THEN
261 IF (diag_orig(ipiv).EQ.rzero) THEN
262 diag_orig(ipiv) = max(amax,rmax_noslave)
263 ELSE
264 growth = max(abs_pivot,amax,rmax_noslave)/
265 & diag_orig(ipiv)
266 ENDIF
267 ENDIF
268 rmax = rmax*max(growth,gw_factcumul)
269 ENDIF
270 ENDIF
271 ELSE
272 rmax = rzero
273 rmax_norelax = rzero
274 ENDIF
275 rmax_noslave = max(rmax_norelax,rmax_noslave)
276 rmax = max(rmax,rmax_noslave)
277 IF (max(amax,rmax,abs_pivot).LE.pivnul) THEN
278 IF ((k219.NE.0)
279 & .AND.(k219.NE.-1)
280 & .AND.(rmax_norelax.LT.0)
281 & .AND.(ipiv.GT.1)) THEN
282 max_prev_in_parpiv = rzero
283 DO jj=1,ipiv-1
284 max_prev_in_parpiv= max( max_prev_in_parpiv,
285 & real(a(aposmax+int(jj,8))) )
286 ENDDO
287 IF (max_prev_in_parpiv.GT.pivnul) THEN
288 aposrow = poselt + ldafs8*int(ipiv-1,8)
289 DO jj=1,ipiv-1
290 IF (abs(a(aposrow+jj-1)).GT.pivnul) THEN
291 GOTO 460
292 ENDIF
293 ENDDO
294 ENDIF
295 ENDIF
296 CALL cmumps_update_minmax_pivot
297 & ( abs(a(pospv1)), dkeep, keep, .true.)
298 keep(109) = keep(109) + 1
299 ipivnul = keep(109)
300 pivnul_list(ipivnul) = iw( ioldps+hf+npiv+ipiv-npivp1 )
301 IF (real(fixa).GT.rzero) THEN
302 IF(real(pivot) .GE. rzero) THEN
303 a(pospv1) = fixa
304 ELSE
305 a(pospv1) = -fixa
306 ENDIF
307 ELSE
308 j1 = apos
309 j2 = pospv1 - 1_8
310 DO jj=j1,j2
311 a(jj) = zero
312 ENDDO
313 DO j=1, nass-ipiv
314 a(pospv1+int(j,8)*ldafs8) = zero
315 ENDDO
316 valtmp = max(1.0e10*rmax, sqrt(huge(rmax))/1.0e8)
317 a(pospv1) = cmplx(valtmp,kind=kind(a))
318 ENDIF
319 pivot = a(pospv1)
320 abs_pivot = abs(pivot)
321 GO TO 415
322 ENDIF
323 rmax = max(rmax,abs(rmax_norelax))
324 IF (abs_pivot.GE.uuloc*max(rmax,amax)
325 & .AND. abs_pivot .GT. max(seuil, tiny(rmax))) THEN
326 CALL cmumps_update_minmax_pivot
327 & ( abs_pivot, dkeep, keep, .false.)
328 IF (keep(258) .NE.0 ) THEN
329 CALL cmumps_updatedeter(pivot, det_mantw, det_expw )
330 ENDIF
331 GO TO 415
332 END IF
333 IF (npivp1.EQ.iend_block) THEN
334 GOTO 460
335 ELSE IF (jmax .EQ.0) THEN
336 GOTO 460
337 ENDIF
338 IF (max(abs(pivot),rmax,amax).LE.tiny(rmax)) THEN
339 GOTO 460
340 ENDIF
341 IF (rmax_noslave.LT.amax) THEN
342 j1 = apos
343 j2 = pospv1 - 1_8
344 DO jj=j1,j2
345 IF(int(pospv1-jj) .NE. ipiv-jmax) THEN
346 rmax_noslave = max(rmax_noslave,abs(a(jj)))
347 ENDIF
348 ENDDO
349 DO j=1,nass-ipiv
350 IF(ipiv+j .NE. jmax) THEN
351 rmax_noslave = max(abs(a(pospv1+ldafs8*int(j,8))),
352 & rmax_noslave)
353 ENDIF
354 ENDDO
355 rmax = max(rmax, rmax_noslave)
356 ENDIF
357 aposj = poselt + int(jmax-1,8)*ldafs8 + int(npiv,8)
358 pospv2 = aposj + int(jmax - npivp1,8)
359 IF (ipiv.LT.jmax) THEN
360 offdag = aposj + int(ipiv - npivp1,8)
361 ELSE
362 offdag = apos + int(jmax - npivp1,8)
363 END IF
364 tmax_noslave = rzero
365 IF(jmax .LT. ipiv) THEN
366 jj = pospv2
367 DO k = 1, nass-jmax
368 jj = jj+ldafs8
369 IF (jmax+k.NE.ipiv) THEN
370 tmax_noslave=max(tmax_noslave,abs(a(jj)))
371 ENDIF
372 ENDDO
373 DO kk = aposj, pospv2-1_8
374 tmax_noslave = max(tmax_noslave,abs(a(kk)))
375 ENDDO
376 ELSE
377 jj = pospv2
378 DO k = 1, nass-jmax
379 jj = jj+ldafs8
380 tmax_noslave=max(tmax_noslave,abs(a(jj)))
381 ENDDO
382 DO kk = aposj, pospv2 - 1_8
383 IF (kk.NE.offdag) THEN
384 tmax_noslave = max(tmax_noslave,abs(a(kk)))
385 ENDIF
386 ENDDO
387 ENDIF
388 IF (k219.NE.0) THEN
389 tmax = max(seuil*uulocm1,
390 & abs(real(a(aposmax+int(jmax,8))))
391 & )
392 ELSE
393 tmax = seuil*uulocm1
394 ENDIF
395 IF (k219.GE.2) THEN
396 growth = rone
397 IF (k219.EQ.3) THEN
398 IF (diag_orig(jmax).EQ.rzero) THEN
399 diag_orig(jmax) = abs(a(pospv2))
400 ELSE
401 growth = abs(a(pospv2))/diag_orig(jmax)
402 ENDIF
403 ELSE IF (k219.EQ.4) THEN
404 IF (diag_orig(jmax).EQ.rzero) THEN
405 diag_orig(jmax)=max(abs(a(pospv2)),amax,tmax_noslave)
406 ELSE
407 growth = max(abs(a(pospv2)),amax,tmax_noslave)
408 & / diag_orig(jmax)
409 ENDIF
410 ENDIF
411 tmax = tmax*max(growth,gw_factcumul)
412 ENDIF
413 tmax = max(tmax,tmax_noslave)
414 detpiv = a(pospv1)*a(pospv2) - a(offdag)*a(offdag)
415 absdetpiv = abs(detpiv)
416 IF (seuil.GT.rzero) THEN
417 IF (sqrt(absdetpiv) .LE. seuil ) THEN
418 GOTO 460
419 ENDIF
420 ENDIF
421 maxpiv = max(abs(a(pospv1)),abs(a(pospv2)))
422 IF (maxpiv.EQ.rzero) maxpiv = rone
423 IF ((abs(a(pospv2))*rmax+amax*tmax)*uuloc.GT.
424 & absdetpiv .OR. absdetpiv .EQ. rzero) THEN
425 GO TO 460
426 ENDIF
427 IF ((abs(a(pospv1))*tmax+amax*rmax)*uuloc.GT.
428 & absdetpiv .OR. absdetpiv .EQ. rzero) THEN
429 GO TO 460
430 ENDIF
431 CALL cmumps_update_minmax_pivot
432 & ( sqrt(abs(detpiv)),
433 & dkeep, keep, .false.)
434 IF (keep(258).NE.0) THEN
435 CALL cmumps_updatedeter(detpiv, det_mantw, det_expw )
436 ENDIF
437 pivsiz = 2
438 nb22t2w = nb22t2w+1
439 415 CONTINUE
440 IF (k206.GE.1) THEN
441 inextpiv = max(npivp1+pivsiz, ipiv+1)
442 ENDIF
443 DO k=1,pivsiz
444 IF (pivsiz .EQ. 2 ) THEN
445 IF (k==1) THEN
446 lpiv = min(ipiv, jmax)
447 tipiv(iloc) = -(lpiv - ibeg_block_to_send + 1)
448 ELSE
449 lpiv = max(ipiv, jmax)
450 tipiv(iloc+1) = -(lpiv - ibeg_block_to_send + 1)
451 ENDIF
452 ELSE
453 lpiv = ipiv
454 tipiv(iloc) = ipiv - ibeg_block_to_send + 1
455 ENDIF
456 IF (lpiv.EQ.npivp1) THEN
457 GOTO 416
458 ENDIF
459 keep8(80) = keep8(80)+1
460 CALL cmumps_swap_ldlt( a, la, iw, liw,
461 & ioldps, npivp1, lpiv, poselt, nass,
462 & ldafs, nfront, 2, k219, keep(50),
463 & keep(ixsz), ibeg_block_to_send )
464 IF (k219.GE.3) THEN
465 rswop = diag_orig(lpiv)
466 diag_orig(lpiv) = diag_orig(npivp1)
467 diag_orig(npivp1) = rswop
468 ENDIF
469 416 CONTINUE
470 IF ((keep(50).NE.1) .AND. ooc_effective_on_front) THEN
471 CALL cmumps_store_perminfo(
472 & iw(i_pivrptr), nbpanels_l,
473 & iw(i_pivr), nass, npivp1, lpiv, pp_lastpanelondisk,
474 & pp_lastpivrptrindexfilled)
475 ENDIF
476 npivp1 = npivp1+1
477 ENDDO
478 IF(pivsiz .EQ. 2) THEN
479 a(poselt+ldafs8*int(npiv,8)+int(npiv+1,8)) = detpiv
480 ENDIF
481 GOTO 420
482 460 CONTINUE
483 IF (k206 .GE. 1) THEN
484 inextpiv=iend_block+1
485 ENDIF
486 IF (iend_block.EQ.nass) THEN
487 inopv = 1
488 ELSE
489 inopv = 2
490 ENDIF
491 GO TO 420
492 630 CONTINUE
493 iflag = -10
494 420 CONTINUE
495 IF (k219.GE.2) THEN
496 IF(inopv .EQ. 0) THEN
497 IF(pivsiz .EQ. 1) THEN
498 gw_fact = max(amax,rmax_noslave)/abs_pivot
499 ELSE IF(pivsiz .EQ. 2) THEN
500 gw_fact = max(
501 & (abs(a(pospv2))*rmax_noslave+amax*tmax_noslave)
502 & / absdetpiv ,
503 & (abs(a(pospv1))*tmax_noslave+amax*rmax_noslave)
504 & / absdetpiv
505 & )
506 ENDIF
507 gw_fact = min(gw_fact, uulocm1)
508 gw_factcumul = max(gw_fact,gw_factcumul)
509 ENDIF
510 ENDIF
511 RETURN
cmplx
float cmplx[2]
Definition pblas.h:136
cmumps_updatedeter
subroutine cmumps_updatedeter(piv, deter, nexp)
Definition cfac_determinant.F:15
cmumps_get_ooc_perm_ptr
subroutine cmumps_get_ooc_perm_ptr(typef, nbpanels, i_pivptr, i_piv, ipos, iw, liw)
Definition cooc_panel_piv.F:133
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
cmumps_fac_front_aux_m
Definition cfac_front_aux.F:14
cmumps_fac_front_aux_m::cmumps_store_perminfo
subroutine cmumps_store_perminfo(pivrptr, nbpanels, pivr, nass, k, p, lastpanelondisk, lastpivrptrindexfilled)
Definition cfac_front_aux.F:2440
cmumps_fac_front_aux_m::cmumps_swap_ldlt
subroutine cmumps_swap_ldlt(a, la, iw, liw, ioldps, npivp1, ipiv, poselt, lastrow2swap, lda, nfront, level, parpiv, k50, xsize, ibeg_block_to_send)
Definition cfac_front_aux.F:2027
cmumps_fac_front_aux_m::cmumps_update_minmax_pivot
subroutine cmumps_update_minmax_pivot(diag, dkeep, keep, nullpivot)
Definition cfac_front_aux.F:2464
mumps_ooc_common
Definition mumps_ooc_common.F:14
mumps_ooc_common::typef_l
integer, public typef_l
Definition mumps_ooc_common.F:18

◆ cmumps_fac_mq_ldlt_niv2()

subroutine cmumps_fac_front_type2_aux_m::cmumps_fac_mq_ldlt_niv2 ( integer, intent(in) iend_block,
integer, intent(in) nass,
integer, intent(in) npiv,
integer, intent(in) inode,
complex, dimension(la), intent(inout) a,
integer(8), intent(in) la,
integer, intent(in) ldafs,
integer(8), intent(in) poselt,
integer, intent(out) ifinb,
integer, intent(in) pivsiz,
integer, intent(in) k219,
integer, intent(in) pivot_option,
integer, intent(in) iend_blr,
logical, intent(in) lr_activated )

Definition at line 513 of file cfac_front_type2_aux.F.

518 IMPLICIT NONE
519 INTEGER(8), intent(in) :: LA, POSELT
520 INTEGER, intent(in) :: K219
521 COMPLEX, intent(inout) :: A(LA)
522 INTEGER, intent(in) :: IEND_BLOCK
523 INTEGER, intent(in) :: NPIV, PIVSIZ
524 INTEGER, intent(in) :: NASS,INODE,LDAFS
525 INTEGER, intent(out) :: IFINB
526 INTEGER, intent(in) :: PIVOT_OPTION, IEND_BLR
527 LOGICAL, intent(in) :: LR_ACTIVATED
528 COMPLEX VALPIV
529 INTEGER NCB1
530 INTEGER(8) :: APOS, APOSMAX
531 INTEGER(8) :: LPOS, LPOS1, LPOS2, K1POS
532 INTEGER(8) :: JJ, K1, K2
533 INTEGER(8) :: POSPV1, POSPV2, OFFDAG, OFFDAG_OLD
534 INTEGER(8) :: LDAFS8
535 INTEGER NEL2
536 COMPLEX ONE, ALPHA
537 COMPLEX ZERO
538 INTEGER NPIV_NEW, I
539 INTEGER(8) :: IBEG, IEND, IROW, J8
540 INTEGER :: J2
541 COMPLEX SWOP,DETPIV,MULT1,MULT2, A11, A22, A12
542 parameter(one=(1.0e0,0.0e0), alpha=(-1.0e0,0.0e0))
543 parameter(zero=(0.0e0,0.0e0))
544 include 'mumps_headers.h'
545 ldafs8 = int(ldafs,8)
546 npiv_new = npiv + pivsiz
547 ifinb = 0
548 nel2 = iend_block - npiv_new
549 IF (nel2.EQ.0) THEN
550 IF (iend_block.EQ.nass) THEN
551 ifinb = -1
552 ELSE
553 ifinb = 1
554 ENDIF
555 ENDIF
556 IF(pivsiz .EQ. 1) THEN
557 apos = poselt + int(npiv,8)*(ldafs8 + 1_8)
558 valpiv = one/a(apos)
559 lpos = apos + ldafs8
560 DO i = 1, nel2
561 k1pos = lpos + int(i-1,8)*ldafs8
562 a(apos+int(i,8))=a(k1pos)
563 a(k1pos) = a(k1pos) * valpiv
564 DO jj=1_8, int(i,8)
565 a(k1pos+jj)=a(k1pos+jj) - a(k1pos) * a(apos+jj)
566 ENDDO
567 ENDDO
568 IF (pivot_option.EQ.2) THEN
569 ncb1 = nass - iend_block
570 ELSE
571 ncb1 = iend_blr - iend_block
572 ENDIF
573!$OMP PARALLEL DO PRIVATE(JJ,K1POS) IF (NCB1 > 300)
574 DO i=nel2+1, nel2 + ncb1
575 k1pos = lpos+ int(i-1,8)*ldafs8
576 a(apos+int(i,8))=a(k1pos)
577 a(k1pos) = a(k1pos) * valpiv
578 DO jj = 1_8, int(nel2,8)
579 a(k1pos+jj)=a(k1pos+jj) - a(k1pos) * a(apos+jj)
580 ENDDO
581 ENDDO
582!$OMP END PARALLEL DO
583 IF (k219.eq. -1) THEN
584 aposmax = poselt + int(nass,8) * ldafs8 + int(npiv,8)
585 a(aposmax) = a(aposmax) * abs(valpiv)
586 DO j8 = 1_8, int(nel2+ncb1,8)
587 a(aposmax+j8) = a(aposmax+j8) +
588 & a(aposmax) * abs(a(apos+j8))
589 ENDDO
590 ENDIF
591 ELSE
592 pospv1 = poselt + int(npiv,8)*(ldafs8 + 1_8)
593 pospv2 = pospv1+ldafs8+1_8
594 offdag_old = pospv2 - 1_8
595 offdag = pospv1+1_8
596 swop = a(pospv2)
597 detpiv = a(offdag)
598 a22 = a(pospv1)/detpiv
599 a11 = swop/detpiv
600 a12 = -a(offdag_old)/detpiv
601 a(offdag) = a(offdag_old)
602 a(offdag_old) = zero
603 lpos1 = pospv2 + ldafs8 - 1_8
604 lpos2 = lpos1 + 1_8
605 CALL ccopy(nass-npiv_new, a(lpos1), ldafs, a(pospv1+2_8), 1)
606 CALL ccopy(nass-npiv_new, a(lpos2), ldafs, a(pospv2+1_8), 1)
607 jj = pospv2 + int(nass-1,8)
608 ibeg = jj + 2_8
609 iend = ibeg
610 DO j2 = 1,nel2
611 k1 = jj
612 k2 = jj+1_8
613 mult1 = - (a11*a(k1)+a12*a(k2))
614 mult2 = - (a12*a(k1)+a22*a(k2))
615 k1 = pospv1+2_8
616 k2 = pospv2+1_8
617 DO irow = ibeg,iend
618 a(irow) = a(irow) + mult1*a(k1) + mult2*a(k2)
619 k1 = k1 + 1_8
620 k2 = k2 + 1_8
621 ENDDO
622 a(jj) = -mult1
623 a(jj+1_8) = -mult2
624 ibeg = ibeg + int(nass,8)
625 iend = iend + int(nass + 1,8)
626 jj = jj+int(nass,8)
627 ENDDO
628 iend = iend-1_8
629 DO j2 = iend_block+1,nass
630 k1 = jj
631 k2 = jj+1_8
632 mult1 = - (a11*a(k1)+a12*a(k2))
633 mult2 = - (a12*a(k1)+a22*a(k2))
634 k1 = pospv1+2_8
635 k2 = pospv2+1_8
636 DO irow = ibeg,iend
637 a(irow) = a(irow) + mult1*a(k1) + mult2*a(k2)
638 k1 = k1 + 1_8
639 k2 = k2 + 1_8
640 ENDDO
641 a(jj) = -mult1
642 a(jj+1_8) = -mult2
643 ibeg = ibeg + int(nass,8)
644 iend = iend + int(nass,8)
645 jj = jj+int(nass,8)
646 ENDDO
647 IF (k219.eq. -1) THEN
648 aposmax = poselt + int(nass,8) * ldafs8 + int(npiv,8)
649 jj = aposmax
650 k1 = jj
651 k2 = jj + 1_8
652 mult1 = abs(a11)*a(k1)+abs(a12)*a(k2)
653 mult2 = abs(a12)*a(k1)+abs(a22)*a(k2)
654 k1 = pospv1 + 2_8
655 k2 = pospv2 + 1_8
656 ibeg = aposmax + 2_8
657 iend = aposmax + 1_8 + nass - npiv_new
658 DO irow = ibeg, iend
659 a(irow) = a(irow) + mult1*abs(a(k1)) + mult2*abs(a(k2))
660 k1 = k1 + 1_8
661 k2 = k2 + 1_8
662 ENDDO
663 a(jj) = mult1
664 a(jj+1_8) = mult2
665 ENDIF
666 ENDIF
667 RETURN
alpha
#define alpha
Definition eval.h:35
ccopy
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
Definition ccopy.f:81

◆ cmumps_send_factored_blk()

subroutine cmumps_fac_front_type2_aux_m::cmumps_send_factored_blk ( integer comm_load,
integer ass_irecv,
integer n,
integer inode,
integer fpere,
integer, dimension(liw) iw,
integer liw,
integer ioldps,
integer(8) poselt,
complex, dimension(la) a,
integer(8) la,
integer lda_fs,
integer ibeg_block,
integer iend,
integer, dimension(lpiv) tipiv,
integer lpiv,
logical lastbl,
integer nb_bloc_fac,
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 (cmumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension(n+keep(253)) itloc,
complex, 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,
complex, dimension(keep8(26)) dblarr,
integer, dimension(60) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
real, dimension(230) dkeep,
integer, dimension( keep(28) ) nd,
integer, dimension( keep(28) ) frere,
integer lptrar,
integer nelt,
integer, dimension( n+1 ) frtptr,
integer, dimension( nelt ) frtelt,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer nelim,
logical, intent(in) lr_activated,
integer, intent(in) npartsass,
integer, intent(in) current_blr_panel,
type (lrb_type), dimension(:) blr_loru,
integer, dimension(n), intent(in) lrgroups )

Definition at line 669 of file cfac_front_type2_aux.F.

687 USE cmumps_buf
688 USE cmumps_load
689 USE cmumps_lr_type
690 USE cmumps_struc_def, ONLY : cmumps_root_struc
691 IMPLICIT NONE
692 include 'mpif.h'
693 TYPE (CMUMPS_ROOT_STRUC) :: root
694 INTEGER COMM_LOAD, ASS_IRECV
695 INTEGER N, INODE, FPERE, LIW, IBEG_BLOCK, IEND, LPIV,
696 & IOLDPS, LDA_FS, NB_BLOC_FAC
697 INTEGER(8) :: POSELT, LA
698 INTEGER IW(LIW), TIPIV(LPIV)
699 LOGICAL LASTBL
700 COMPLEX A(LA)
701 INTEGER COMM, MYID, LBUFR, LBUFR_BYTES
702 INTEGER NELT, LPTRAR
703 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
704 INTEGER KEEP(500)
705 INTEGER(8) KEEP8(150)
706 REAL DKEEP(230)
707 INTEGER NBFIN, IFLAG, IERROR, LEAF, LPOOL,
708 & SLAVEF, ICNTL(60)
709 INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS
710 INTEGER IWPOS, IWPOSCB, COMP
711 INTEGER BUFR( LBUFR ), IPOOL(LPOOL),
712 & ITLOC(N+KEEP(253)), FILS(N), DAD( KEEP(28) ),
713 & ND( KEEP(28) ), FRERE( KEEP(28) )
714 INTEGER(8), INTENT(IN) :: PTRARW(LPTRAR), PTRAIW(LPTRAR)
715 COMPLEX :: RHS_MUMPS(KEEP(255))
716 INTEGER(8) :: PTRAST (KEEP(28))
717 INTEGER(8) :: PTRFAC (KEEP(28))
718 INTEGER(8) :: PAMASTER(KEEP(28))
719 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)),
720 & STEP(N), PIMASTER(KEEP(28)),
721 & NSTK_S(KEEP(28)),
722 & PERM(N), PROCNODE_STEPS(KEEP(28))
723 INTEGER ISTEP_TO_INIV2(KEEP(71)),
724 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
725 DOUBLE PRECISION OPASSW, OPELIW
726 COMPLEX DBLARR(KEEP8(26))
727 INTEGER INTARR(KEEP8(27))
728 LOGICAL, intent(in) :: LR_ACTIVATED
729 TYPE (LRB_TYPE), DIMENSION(:) :: BLR_LorU
730 INTEGER, intent(in) :: LRGROUPS(N)
731 INTEGER :: NELIM
732 INTEGER, intent(in) :: NPARTSASS, CURRENT_BLR_PANEL
733 include 'mumps_headers.h'
734 INTEGER(8) :: APOS, LREQA
735 INTEGER NPIV, NCOL, PDEST, NSLAVES, WIDTH
736 INTEGER IERR, LREQI
737 INTEGER :: STATUS(MPI_STATUS_SIZE)
738 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED
739 DOUBLE PRECISION FLOP1,FLOP2
740 LOGICAL COMPRESS_CB
741 compress_cb = ((iw(ioldps+xxlr).EQ.1).OR.
742 & (iw(ioldps+xxlr).EQ.3))
743 nslaves= iw(ioldps+5+keep(ixsz))
744 IF (nslaves.EQ.0) THEN
745 WRITE(6,*) ' ERROR 1 in CMUMPS_SEND_FACTORED_BLK '
746 CALL mumps_abort()
747 ENDIF
748 npiv = iend - ibeg_block + 1
749 ncol = lda_fs - ibeg_block + 1
750 apos = poselt + int(lda_fs,8)*int(ibeg_block-1,8) +
751 & int(ibeg_block - 1,8)
752 IF (ibeg_block > 0) THEN
753 CALL mumps_get_flops_cost( lda_fs, ibeg_block-1, lpiv,
754 & keep(50),2,flop1)
755 ELSE
756 flop1=0.0d0
757 ENDIF
758 CALL mumps_get_flops_cost( lda_fs, iend, lpiv,
759 & keep(50),2,flop2)
760 flop2 = flop1 - flop2
761 CALL cmumps_load_update(1, .false., flop2, keep,keep8)
762 IF ((npiv.GT.0) .OR.
763 & ((npiv.EQ.0).AND.(lastbl))
764 & ) THEN
765 IF ((npiv.EQ.0).AND.(lastbl)) THEN
766 IF (compress_cb) THEN
767 iw(ioldps+xxlr) = iw(ioldps+xxlr) -1
768 compress_cb = .false.
769 ENDIF
770 ENDIF
771 pdest = ioldps + 6 + keep(ixsz)
772 IF (( npiv .NE. 0 ).AND.(keep(50).NE.0)) THEN
773 nb_bloc_fac = nb_bloc_fac + 1
774 END IF
775 ierr = -1
776 DO WHILE (ierr .EQ.-1)
777 width = nslaves
778 CALL cmumps_buf_send_blocfacto( inode, lda_fs, ncol,
779 & npiv, fpere, lastbl, tipiv, a(apos),
780 & iw(pdest), nslaves, keep,
781 & nb_bloc_fac,
782 & nslaves, width, comm,
783 & nelim, npartsass, current_blr_panel,
784 & lr_activated, blr_loru,
785 & ierr )
786 IF (ierr.EQ.-1) THEN
787 blocking = .false.
788 set_irecv = .true.
789 message_received = .false.
790 CALL cmumps_try_recvtreat( comm_load, ass_irecv,
791 & blocking, set_irecv, message_received,
792 & mpi_any_source, mpi_any_tag,
793 & status, bufr, lbufr,
794 & lbufr_bytes,
795 & procnode_steps, posfac, iwpos, iwposcb, iptrlu,
796 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
797 & ptlust_s, ptrfac,
798 & ptrast, step, pimaster, pamaster, nstk_s, comp, iflag,
799 & ierror, comm,
800 & perm,
801 & ipool, lpool, leaf, nbfin, myid, slavef,
802 & root, opassw, opeliw, itloc, rhs_mumps,
803 & fils, dad, ptrarw, ptraiw,
804 & intarr, dblarr, icntl, keep,keep8,dkeep, nd, frere,
805 & lptrar, nelt, frtptr, frtelt,
806 & istep_to_iniv2, tab_pos_in_pere, .true.
807 & , lrgroups
808 & )
809 IF (message_received) THEN
810 poselt = ptrast(step(inode))
811 apos = poselt + int(lda_fs,8)*int(ibeg_block-1,8) +
812 & int(ibeg_block - 1,8)
813 ENDIF
814 IF ( iflag .LT. 0 ) GOTO 500
815 ENDIF
816 ENDDO
817 IF (ierr .EQ. -2 .OR. ierr.EQ.-3 ) THEN
818 IF (ierr.EQ.-2) iflag = -17
819 IF (ierr.EQ.-3) iflag = -20
820 lreqa = int(ncol,8)*int(npiv,8)
821 lreqi = npiv + 6 + 2*nslaves + 2
822 CALL mumps_set_ierror(
823 & int(lreqi,8) * int(keep(34),8) + lreqa * int(keep(35),8),
824 & ierror)
825 GOTO 300
826 ENDIF
827 ENDIF
828 GOTO 500
829 300 CONTINUE
830 CALL cmumps_bdc_error( myid, slavef, comm, keep )
831 500 CONTINUE
832 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
cmumps_bdc_error
subroutine cmumps_bdc_error(myid, slavef, comm, keep)
Definition cbcast_int.F:38
cmumps_try_recvtreat
recursive subroutine cmumps_try_recvtreat(comm_load, ass_irecv, blocking, set_irecv, message_received, msgsou, msgtag, status, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef 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, stack_right_authorized, lrgroups)
Definition cfac_process_message.F:560
mumps_get_flops_cost
subroutine mumps_get_flops_cost(nfront, npiv, nass, keep50, level, cost)
Definition estim_flops.F:74
cmumps_buf
Definition cmumps_comm_buffer.F:14
cmumps_buf::cmumps_buf_send_blocfacto
subroutine, public cmumps_buf_send_blocfacto(inode, nfront, ncol, npiv, fpere, lastbl, ipiv, val, pdest, ndest, keep, nb_bloc_fac, nslaves_tot, width, comm, nelim, npartsass, current_blr_panel, lr_activated, blr_loru ierr)
Definition cmumps_comm_buffer.F:1824
cmumps_load
Definition cmumps_load.F:14
cmumps_load::myid
integer, save, private myid
Definition cmumps_load.F:57
cmumps_load::cmumps_load_update
subroutine, public cmumps_load_update(check_flops, process_bande, inc_load, keep, keep8)
Definition cmumps_load.F:824
cmumps_lr_type
Definition clr_type.F:14
cmumps_struc_def
Definition cmumps_struc_def.F:14
comp
int comp(int a, int b)
Definition set_surface_lines.cpp:102
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865