15 & ISON, NBROWS, NBCOLS, ROWLIST,
16 & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER,
17 & OPASSW, IWPOSCB, MYID, KEEP,KEEP8, IS_ofType5or6,
25 INTEGER INODE,ISON, IWPOSCB
26 INTEGER NBROWS, NBCOLS, LDA_VALSON
27 INTEGER(8) :: PTRAST(KEEP(28))
28 INTEGER IW(LIW), STEP(N), PIMASTER(KEEP(28)),
29 & ptlust_s(keep(28)), rowlist(nbrows)
30 COMPLEX A(LA), VALSON(LDA_VALSON,NBROWS)
31 DOUBLE PRECISION OPASSW
32 LOGICAL,
INTENT(IN) :: IS_ofType5or6
33 INTEGER(8) :: POSELT, POSEL1, APOS, JJ2
34 INTEGER HF,HS, NSLAVES, NFRONT, NASS1,
35 & ioldps, istchk, lstk, nslson,nelim,
36 & npivs,ncols,j1,jj,jj1,nrows,
37 & ldafs_pere, ibeg, diag
38 include
'mumps_headers.h'
40 IOLDPS = ptlust_s(step(inode))
41 poselt = ptrast(step(inode))
42 nfront = iw(ioldps+keep(ixsz))
43 nass1 = iabs(iw(ioldps + 2+keep(ixsz)))
44 nslaves= iw(ioldps+5+keep(ixsz))
45 IF (keep(50).EQ.0)
THEN
48 IF ( nslaves .eq. 0 )
THEN
54 hf = 6 + nslaves + keep(ixsz)
55 posel1 = poselt - int(ldafs_pere,8)
56 istchk = pimaster(step(ison))
57 lstk = iw(istchk+keep(ixsz))
58 nslson = iw(istchk + 5+keep(ixsz))
59 hs = 6 + nslson + keep(ixsz)
60 opassw = opassw + dble(nbrows*nbcols)
61 nelim = iw(istchk + 1+keep(ixsz))
62 npivs = iw(istchk + 3+keep(ixsz))
63 IF (npivs.LT.0) npivs = 0
65 same_proc = (istchk.LT.iwposcb)
69 nrows = iw(istchk+2+keep(ixsz))
71 j1 = istchk + nrows + hs + npivs
72 IF (keep(50).EQ.0)
THEN
73 IF (is_oftype5or6)
THEN
74 apos = posel1 + int(rowlist(1),8) * int(ldafs_pere,8)
77 jj2 = apos + int(jj1-1,8)
78 a(jj2)=a(jj2)+valson(jj1,jj)
80 apos = apos + int(ldafs_pere,8)
84 apos = posel1 + int(rowlist(jj),8) * int(ldafs_pere,8)
85 DO 160 jj1 = 1, nbcols
86 jj2 = apos + int(iw(j1 + jj1 - 1) - 1,8)
87 a(jj2) = a(jj2) + valson(jj1,jj)
92 IF (is_oftype5or6)
THEN
93 apos = posel1 + int(rowlist(1),8) * int(ldafs_pere,8)
97 jj2 = apos+int(jj1-1,8)
98 a(jj2) = a(jj2) + valson(jj1,jj)
101 apos = apos + int(ldafs_pere,8)
105 IF (rowlist(jj).LE.nass1.and..NOT.is_oftype5or6)
THEN
106 apos = posel1 + int(rowlist(jj) - 1,8)
108 jj2 = apos + int(iw(j1+jj1-1),8)*int(ldafs_pere,8)
109 a(jj2) = a(jj2) + valson(jj1,jj)
115 apos = posel1 + int(rowlist(jj),8) * int(ldafs_pere,8)
116 DO jj1 = ibeg, nbcols
117 IF (rowlist(jj).LT.iw(j1 + jj1 - 1))
EXIT
118 jj2 = apos + int(iw(j1 + jj1 - 1) - 1,8)
119 a(jj2) = a(jj2) + valson(jj1,jj)
127 & (n, inode, iw, liw, a, la,
129 & opassw, opeliw, step, ptrist, ptrast, itloc,
130 & rhs_mumps, fils, ptrarw, ptraiw, intarr, dblarr,
131 & icntl, keep,keep8, myid, lrgroups)
136 INTEGER KEEP(500), ICNTL(60)
137 INTEGER(8) KEEP8(150)
139 INTEGER NBROWS, NBCOLS
140 INTEGER(8) :: PTRAST(KEEP(28))
141 INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(),
142 & ptrist(keep(28)), fils(n)
143 INTEGER(8),
INTENT(IN) :: PTRARW(N), PTRAIW(N)
144 COMPLEX :: RHS_MUMPS(KEEP(255))
146 INTEGER :: INTARR(KEEP8(27))
147 COMPLEX :: DBLARR(KEEP8(26))
148 DOUBLE PRECISION OPASSW, OPELIW
149 INTEGER,
INTENT(IN) :: LRGROUPS(N)
151 COMPLEX,
DIMENSION(:),
POINTER :: A_PTR
153 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
154 & k1,k2,k,j,jpos,nass
156 parameter( zero = (0.0e0,0.0e0) )
157 include
'mumps_headers.h'
158 ioldps = ptrist(step(inode))
160 & ptrast(step(inode)), iw(ioldps+xxd), iw(ioldps+xxr),
161 & a_ptr, poselt, la_ptr )
162 nbcolf = iw(ioldps+keep(ixsz))
163 nbrowf = iw(ioldps+2+keep(ixsz))
164 nass = iw(ioldps+1+keep(ixsz))
165 nslaves = iw(ioldps+5+keep(ixsz))
166 hf = 6 + nslaves + keep(ixsz)
169 iw(ioldps+1+keep(ixsz)) = nass
171 & ioldps, a_ptr(poselt), la_ptr, 1_8, keep, keep8,
172 & itloc, fils, ptraiw, ptrarw, intarr, dblarr,
173 & keep8(27), keep8(26),
174 & rhs_mumps, lrgroups)
176 IF (nbrows.GT.0)
THEN
177 k1 = ioldps + hf + nbrowf
189 & (n, inode, iw, liw, nbrows, step, ptrist,
190 & itloc, rhs_mumps, keep,keep8)
194 INTEGER(8) KEEP8(150)
197 INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N),
199 COMPLEX :: RHS_MUMPS(KEEP(255))
200 include
'mumps_headers.h'
201 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
203 ioldps = ptrist(step(inode))
204 nbcolf = iw(ioldps+keep(ixsz))
205 nbrowf = iw(ioldps+2+keep(ixsz))
206 nslaves = iw(ioldps+5+keep(ixsz))
207 hf = 6 + nslaves+keep(ixsz)
208 IF (nbrows.GT.0)
THEN
209 k1 = ioldps + hf + nbrowf
219 & NBROWS, NBCOLS, ROWLIST, COLLIST, VALSON,
220 & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,
222 & ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, LDA_VALSON)
227 INTEGER KEEP(500), ICNTL(60)
228 INTEGER(8) KEEP8(150)
230 LOGICAL,
intent(in) :: IS_ofType5or6
231 INTEGER NBROWS, NBCOLS, LDA_VALSON
232 INTEGER ROWLIST(NBROWS), COLLIST(NBCOLS)
233 INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N),
234 & ptrist(keep(28)), fils(n)
235 COMPLEX :: RHS_MUMPS(KEEP(255))
236 INTEGER(8) :: PTRAST(KEEP(28))
237 COMPLEX A(LA), VALSON(LDA_VALSON,NBROWS)
238 DOUBLE PRECISION OPASSW, OPELIW
239 INTEGER(8) :: POSEL1, POSELT, APOS, K8
240 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
242 COMPLEX,
POINTER,
DIMENSION(:) :: A_PTR
244 include
'mumps_headers.h'
245 ioldps = ptrist(step(inode))
247 & ptrast(step(inode)), iw(ioldps+xxd), iw(ioldps+xxr),
248 & a_ptr, poselt, la_ptr )
249 nbcolf = iw(ioldps+keep(ixsz))
250 nbrowf = iw(ioldps+2+keep(ixsz))
251 nass = iw(ioldps+1+keep(ixsz))
252 IF ( nbrows .GT. nbrowf )
THEN
253 WRITE(*,*)
' ERR: ERROR : NBROWS > NBROWF'
254 WRITE(*,*)
' ERR: INODE =', inode
255 WRITE(*,*)
' ERR: NBROW=',nbrows,
'NBROWF=',nbrowf
256 WRITE(*,*)
' ERR: ROW_LIST=', rowlist
257 WRITE(*,*)
' ERR: NBCOLF/NASS=', nbcolf, nass
260 nslaves = iw(ioldps+5+keep(ixsz))
261 hf = 6 + nslaves+keep(ixsz)
262 IF (nbrows.GT.0)
THEN
263 posel1 = poselt - int(nbcolf,8)
264 IF (keep(50).EQ.0)
THEN
265 IF (is_oftype5or6)
THEN
266 apos = posel1 + int(rowlist(1),8) * int(nbcolf,8)
269 a_ptr(apos+int(j-1,8)) = a_ptr( apos+int(j-1,8)) +
272 apos = apos + int(nbcolf,8)
276 apos = posel1 + int(rowlist(i),8) * int(nbcolf,8)
278 k8 = apos + int(itloc(collist(j)),8) - 1_8
279 a_ptr(k8) = a_ptr(k8) + valson(j,i)
284 IF (is_oftype5or6)
THEN
285 apos = posel1 + int(rowlist(1),8) * int(nbcolf,8)
286 & + int((nbrows-1),8)*int(nbcolf,8)
291 a_ptr(k8) = a_ptr(k8) + valson(j,i)
293 apos = apos - int(nbcolf,8)
298 apos = posel1 + int(rowlist(i),8) * int(nbcolf,8)
300 IF (itloc(collist(j)) .EQ. 0)
THEN
303 k8 = apos + int(itloc(collist(j)),8) - 1_8
304 a_ptr(k8) = a_ptr(k8) + valson(j,i)
309 opassw = opassw + dble(nbrows*nbcols)
314 & IAFATH, NFRONT, NASS1,
316 & IW, NROWS, NELIM, ETATASS,
319 INTEGER NFRONT, NASS1
321 INTEGER NCOLS, NROWS, NELIM
324 INTEGER(8) :: IAFATH, IACB
327 LOGICAL CB_IS_COMPRESSED
329 PARAMETER( ZERO = (0.0e0,0.0e0) )
331 INTEGER(8) :: APOS, POSELT
332 INTEGER(8) :: IPOSCB, IBEGCBROW, IENDFRONT
333 LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS,
334 & risk_of_same_pos_this_line
335 iendfront = iafath+int(nfront,8)*int(nfront,8)-1_8
337 reset_to_zero = iacb .LT. iendfront + 1_8
338 risk_of_same_pos = iacb + lcb .EQ. iendfront + 1_8
339 risk_of_same_pos_this_line = .false.
341 poselt = int(iw(i)-1,8) * int(nfront,8)
342 IF (.NOT. cb_is_compressed )
THEN
343 iposcb = 1_8 + int(i - 1,8) * int(ncols,8)
344 IF (iacb+iposcb-1_8 .GE. iendfront + 1_8)
THEN
345 reset_to_zero = .false.
348 IF ( risk_of_same_pos )
THEN
349 IF (i.EQ.nrows .OR. .NOT. cb_is_compressed)
THEN
350 IF ( iafath + poselt + int(iw(i)-1,8) .EQ.
351 & iacb+iposcb+int(i-1-1,8))
THEN
352 risk_of_same_pos_this_line = .true.
356 IF (reset_to_zero)
THEN
357 IF ( risk_of_same_pos_this_line )
THEN
359 apos = poselt + int(iw( j ),8)
360 IF (iafath + apos - 1_8.NE. iacb+iposcb-1_8)
THEN
361 a(iafath+ apos -1_8) = a(iacb+iposcb-1_8)
362 a(iacb+iposcb-1_8) = zero
364 iposcb = iposcb + 1_8
371 apos = poselt + int(iw( j ),8)
372 a(iafath+ apos -1_8) = a(iacb+iposcb-1_8)
373 a(iacb+iposcb-1_8) = zero
374 iposcb = iposcb + 1_8
382 apos = poselt + int(iw( j ),8)
383 a(iafath+ apos -1_8) = a(iacb+iposcb-1_8)
384 iposcb = iposcb + 1_8
387 IF (.NOT. cb_is_compressed )
THEN
388 ibegcbrow = iacb+iposcb-1_8
389 IF ( ibegcbrow .LE. iendfront )
THEN
390 a(ibegcbrow:ibegcbrow+int(ncols-i,8)-1_8)=zero
393 IF (iacb+iposcb-1_8 .GE. iendfront + 1_8)
THEN
394 reset_to_zero = .false.
400 & IAFATH, NFRONT, NASS1,
402 & IW, NROWS, NELIM, ETATASS,
407 INTEGER NFRONT, NASS1
409 INTEGER NCOLS, NROWS, NELIM
416 LOGICAL CB_IS_COMPRESSED
419 PARAMETER( ZERO = (0.0e0,0.0e0) )
421 INTEGER(8) :: APOS, POSELT
424 IF ((etatass.EQ.0) .OR. (etatass.EQ.1))
THEN
430 poselt = int( iw( i ) - 1, 8 ) * int(nfront, 8)
431 IF (.NOT. cb_is_compressed)
THEN
432 iposcb = 1_8 + int( i - 1, 8 ) * int(ncols,8)
438 apos = poselt + int(iw( j ),8)
439 a(iafath+ apos -1_8) = a(iafath+ apos -1_8)
441 iposcb = iposcb + 1_8
445 IF ((etatass.EQ.0).OR.(etatass.EQ.1))
THEN
448 DO i = nelim + 1, nrows
449 IF (cb_is_compressed)
THEN
450 iposcb = (int(i,8) * int(i-1,8)) / 2_8 + 1_8
452 iposcb = int(i-1,8) * int(ncols,8) + 1_8
454 poselt = int(iw( i ),8)
455 IF (poselt.LE. int(nass1,8))
THEN
460 apos = poselt + int( iw( j ) - 1, 8 ) * int(nfront,8)
461 a(iafath+apos-1_8) = a(iafath+apos-1_8) +
463 iposcb = iposcb + 1_8
466 poselt = int( iw( i ) - 1, 8 ) * int(nfront, 8)
471 apos = poselt + int(iw( j ), 8)
472 a(iafath+apos-1_8) = a(iafath+apos-1_8)
474 iposcb = iposcb + 1_8
477 IF (etatass.EQ.1)
THEN
478 poselt = int( iw( i ) - 1, 8 ) * int(nfront, 8)
480 IF (iw(j).GT.nass1)
EXIT
481 apos = poselt + int(iw( j ), 8)
482 a(iafath+apos-1_8) = a(iafath+apos-1_8)
487 poselt = int( iw( i ) - 1, 8 ) * int(nfront, 8)
492 apos = poselt + int(iw( j ), 8)
493 a(iafath+apos-1_8) = a(iafath+apos-1_8)
495 iposcb = iposcb + 1_8
501 DO i= nrows, nelim+1, -1
502 IF (cb_is_compressed)
THEN
503 iposcb = (int(i,8)*int(i+1,8))/2_8
505 iposcb = int(i-1,8) * int(ncols,8) + int(i,8)
507 poselt = int(iw( i ),8)
508 IF (poselt.LE.int(nass1,8))
EXIT
509 poselt = int( iw( i ) - 1, 8 ) * int(nfront, 8)
511 IF (iw(j).LE.nass1)
EXIT
512 apos = poselt + int(iw( j ), 8)
513 a(iafath+apos-1_8) = a(iafath+apos-1_8)
515 iposcb = iposcb - 1_8
522 & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8)
524 INTEGER N, ISON, INODE, IWPOSCB
525 INTEGER KEEP(500), STEP(N)
526 INTEGER(8) KEEP8(150)
527 INTEGER PIMASTER(KEEP(28)), PTLUST_S(KEEP(28))
530 INTEGER ISTCHK, LSTK, NSLSON, HS, NROWS, NCOLS, NPIVS, NELIM
531 INTEGER IOLDPS, NFRONT, NSLAVES, ICT11, HF
532 INTEGER J1, J2, J3, JJ, JPOS
534 include
'mumps_headers.h'
535 istchk = pimaster(step(ison))
536 lstk = iw(istchk+keep(ixsz))
537 nslson = iw(istchk+5+keep(ixsz))
538 hs = 6 + nslson + keep(ixsz)
539 nelim = iw(istchk + 1+keep(ixsz))
540 npivs = iw(istchk + 3+keep(ixsz))
542 IF ( npivs < 0 ) npivs = 0
543 same_proc = istchk < iwposcb
547 nrows = iw(istchk+2+keep(ixsz))
549 j1 = istchk + nrows + hs + npivs
550 IF (keep(50).NE.0)
THEN
553 iw(jj) = iw(jj - nrows)
559 iw(jj) = iw(jj - nrows)
561 IF (nelim .NE. 0)
THEN
562 ioldps = ptlust_s(step(inode))
563 nfront = iw(ioldps+keep(ixsz))
564 nslaves= iw(ioldps+5+keep(ixsz))
565 hf = 6 + nslaves+keep(ixsz)
566 ict11 = ioldps + hf - 1 + nfront
569 jpos = iw(jj) + ict11
577 & N, INODE, IW, LIW, A, LA,
579 & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER,
580 & OPASSW, IWPOSCB,MYID, KEEP,KEEP8 )
584 INTEGER(8) KEEP8(150)
587 INTEGER INODE,ISON,IWPOSCB
589 INTEGER IW(LIW), STEP(N),
590 & pimaster(keep(28)),
592 INTEGER(8) PTRAST((28))
595 DOUBLE PRECISION OPASSW
596 INTEGER HF,HS, NSLAVES, NASS1,
598 & lstk, nslson,nelim,npivs,ncols, j1,
600 INTEGER(8) POSELT, APOS, JJ2
601 INCLUDE
'mumps_headers.h'
604 ioldps = ptlust_s(step(inode))
605 poselt = ptrast(step(inode))
606 nass1 = iabs(iw(ioldps + 2 + keep(ixsz)))
607 nslaves= iw(ioldps+5 + keep(ixsz))
608 hf = 6 + nslaves + keep(ixsz)
609 istchk = pimaster(step(ison))
610 lstk = iw(istchk + keep(ixsz))
611 nslson = iw(istchk + 5 + keep(ixsz))
612 hs = 6 + nslson + keep(ixsz)
613 nelim = iw(istchk + 1 + keep(ixsz))
614 npivs = iw(istchk + 3 + keep(ixsz))
615 IF (npivs.LT.0) npivs = 0
617 same_proc = (istchk.LT.iwposcb)
621 nrows = iw(istchk+2 + keep(ixsz))
623 j1 = istchk + nrows + hs + npivs
624 apos = poselt + int(nass1,8)*int(nass1,8) - 1_8
626 jj2 = apos+int(iw(j1 + jj1 - 1),8)
627 IF(real(a(jj2)) .LT. valson(jj1))
THEN
628 a(jj2) =
cmplx(valson(jj1),kind=kind(a))
634 & A, LA, POSELT, KEEP, KEEP8,
635 & ITLOC, FILS, PTRAIW, PTRARW, INTARR, DBLARR,
636 & LINTARR, LDBLARR, RHS_MUMPS, LRGROUPS)
642 INTEGER,
intent(in) :: N, LIW, IOLDPS, INODE
643 INTEGER(8),
intent(in) :: LA, POSELT
644 INTEGER(8),
intent(in) :: LINTARR, LDBLARR
645 INTEGER,
intent(in) :: IW(LIW)
646 INTEGER,
intent(in) :: KEEP(500)
647 INTEGER(8),
intent(in) :: KEEP8(150)
648 INTEGER,
intent(inout) :: ITLOC(N+KEEP(253))
649 COMPLEX,
intent(inout) :: A(LA)
650 COMPLEX,
intent(in) :: RHS_MUMPS(KEEP(255))
651 COMPLEX,
intent(in) :: DBLARR(LDBLARR)
652 INTEGER,
intent(in) :: (LINTARR)
653 INTEGER,
intent(in) :: FILS(N)
654 INTEGER(8),
intent(in) :: PTRAIW(N), PTRARW(N)
655 INTEGER,
INTENT(IN) :: LRGROUPS(N)
657!$
INTEGER(8) :: CHUNK8
659 include
'mumps_headers.h'
660 INTEGER :: HF, NBROWF, NBCOLF, NASS, NSLAVES
661 INTEGER :: ILOC, J, K, K1, K2, JPOS, IJROW
663 INTEGER(8) :: , J28, JJ8, JK8
664 INTEGER(8) :: APOS, ICT12
665 INTEGER(8) :: AINPUT8
666 INTEGER,
POINTER,
DIMENSION(:) :: BEGS_BLR_LS
667 INTEGER :: NB_BLR_LS, NPARTSCB, , MAXI_CLUSTER,
668 & ibcksz2, minsize, topdiag
670 INTEGER :: K1RHS, K2RHS,
672 parameter( zero = (0.0e0,0.0e0) )
673 nbcolf = iw(ioldps+keep(ixsz))
674 nbrowf = iw(ioldps+2+keep(ixsz))
675 nass = iw(ioldps+1+keep(ixsz))
676 nslaves= iw(ioldps+5 + keep(ixsz))
677 hf = 6 + nslaves + keep(ixsz)
679 IF (keep(50) .EQ. 0 .OR. nbrowf .LT. keep(63))
THEN
684 DO jj8=poselt, poselt+int(nbrowf,8)*int(nbcolf,8)-1_8
690 IF (iw(ioldps+xxlr).GE.1)
THEN
691 CALL get_cut(iw(ioldps+hf:ioldps+hf+nbrowf-1), 0,
692 & nbrowf, lrgroups, npartscb,
693 & npartsass, begs_blr_ls)
695 call max_cluster(begs_blr_ls,nb_blr_ls+1,maxi_cluster)
696 DEALLOCATE(begs_blr_ls)
698 minsize = int(ibcksz2 / 2)
699 topdiag =
max(2*minsize + maxi_cluster-1, topdiag)
705 DO jj8 = 0_8, int(nbrowf-1,8)
706 apos = poselt+ jj8*int(nbcolf,8)
707 jj3 =
min( int(nbcolf,8) - 1_8,
708 & jj8 + int(nbcolf-nbrowf,8) + topdiag )
709 a(apos: apos+jj3) = zero
713 k1 = ioldps + hf + nbrowf
724 IF ((keep(253).GT.0).AND.(keep(50).NE.0))
THEN
730 IF ((k1rhs.EQ.0).AND.(j.GT.n))
THEN
736 IF (k1rhs.GT.0) k2rhs=k2
737 IF ( k2rhs.GE.k1rhs )
THEN
744 apos = poselt+int(iloc-1,8)*int(nbcolf,8) +
746 a(apos) = a(apos) + rhs_mumps(
747 & (jfirstrhs+(k-k1rhs)-1)*keep(254)+in)
765 j28 = j18 + intarr(jk8)
766 ijrow = -itloc(intarr(j18))
767 ict12 = poselt +int(- nbcolf + ijrow - 1,8)
769 iloc = itloc(intarr(jj8))
771 apos = ict12 + int(iloc,8)*int(nbcolf,8)
774 ainput8 = ainput8 + 1_8
779 k2 = k1 + nbrowf + nass - 1
787 & LR_ACTIVATED, PARPIV_T1)
789 INTEGER,
intent(in) :: INODE, NFRONT, NASS1, KEEP(500)
790 LOGICAL,
intent(in) :: LR_ACTIVATED
791 INTEGER,
intent(out) :: PARPIV_T1
793 LOGICAL,
EXTERNAL :: CMUMPS_IS_TRSM_LARGE_ENOUGH,
795 parpiv_t1 = keep(269)
796 IF (parpiv_t1.EQ.-3)
THEN
799 IF (parpiv_t1.EQ.77)
THEN
802 IF (parpiv_t1.EQ.0)
RETURN
803 IF ( (parpiv_t1.EQ.-2).AND.lr_activated )
THEN
807 IF (parpiv_t1.EQ.-2)
THEN
809 & ( cmumps_is_trsm_large_enough( nass1, ncb
822 IF (ncb.EQ.keep(253))
THEN
831 INTEGER,
INTENT(in) :: m, n
832 DOUBLE PRECISION :: ai
835 & ( dble(m)/dble(2) + dble(2)*dble(n) )
843 INTEGER,
INTENT(in) :: m, n, k
844 DOUBLE PRECISION :: ai
845 INTEGER,
PARAMETER :: thres_ai = 400
846 ai = ( dble(2)*dble(m)*dble(n)*dble(k) ) /
847 & ( dble(m)*dble(n) + dble(m)*dble(k) + dble(k)*dble(n) )
852 & A, LAELL8, KEEP, NFRONT,
853 & NASS1, NVSCHUR_K253, NB_POSTPONED)
855 INTEGER(8),
intent(in) :: LAELL8
856 INTEGER,
intent(in) ::
857 INTEGER,
intent(in) :: KEEP(500), NFRONT, NASS1,
859 INTEGER,
intent(in) :: NB_POSTPONED
860 COMPLEX,
intent(inout) :: (LAELL8)
861 INTEGER(8) :: APOSMAX, APOS, NASS1_8, NFRONT_8
865 parameter( zero = (0.0e0,0.0e0) )
866 nass1_8 = int(nass1, 8)
867 nfront_8 = int(nfront, 8)
868 ncb = nfront-nass1-nvschur_k253
869 IF ((ncb.EQ.0).AND.(nvschur_k253.EQ.0))
CALL mumps_abort()
870 aposmax = laell8 - nass1_8 + 1_8
871 a(aposmax:aposmax+nass1_8-1_8)= zero
873 IF (keep(50).EQ.2)
THEN
874 apos = 1_8 + (nass1_8*nfront_8)
877 rmax = real(a(aposmax+int(j,8)-1_8))
878 rmax =
max(rmax, abs(a(apos+int(j,8)-1_8)))
879 a(aposmax+int(j,8)-1_8) =
cmplx(rmax,kind=kind(a))
886 rmax = real(a(aposmax+int(i,8)-1_8))
888 rmax =
max(rmax, abs(a(apos+int(j,8)-1)))
890 a(aposmax+int(i,8)-1_8) =
cmplx(rmax,kind=kind
895 & keep, a(aposmax), nass1, nb_postponed
899 & KEEP, PARPIV, LPARPIV,
902 INTEGER,
intent(in) :: INODE, LPARPIV, KEEP(500)
903 COMPLEX,
intent(inout):: PARPIV(LPARPIV)
904 INTEGER,
intent(in) :: NB_POSTPONED
906 REAL :: EPS, RMIN, RZERO, RTMP
908 LOGICAL :: UPDATE_PARPIV
909 parameter( rzero = 0.0e0 )
910 update_parpiv=.false.
913 eps = sqrt(epsilon(rzero))*0.01e0
915 rtmp = real(parpiv(i))
916 IF (rtmp.GT.rzero)
THEN
917 rmin =
min(rmin, rtmp)
921 IF (rtmp.LE.eps) update_parpiv=.true.
922 rmax=
max(rmax,real(parpiv(i)))
924 IF (update_parpiv)
THEN
925 IF (rmin.LT.huge(rmin))
THEN
927 DO i = 1, lparpiv-nb_postponed
928 rtmp = real(parpiv(i))
929 IF (rtmp.LE.eps)
THEN
930 parpiv(i) =
cmplx(-rmax, kind=kind(parpiv))
933 IF (nb_postponed.GT.0)
THEN
934 DO i=lparpiv-nb_postponed+1, lparpiv
935 rtmp = real(parpiv(i))
936 IF (rtmp.LE.eps)
THEN
937 parpiv(i) =
cmplx(-rmax, kind=kind(parpiv))
946 & (n, inode, iw, liw, a, la, keep, perm,
948 & nfront, nass1, lr_activated, parpiv_t1,
952 INTEGER,
intent(in) :: N, INODE, LIW, IOLDPS,
953 & nfront, nass1, nb_postponed
954 INTEGER(8),
intent(in) :: LA, POSELT
955 INTEGER,
intent(in) :: IW (), PERM(N), KEEP(500)
956 LOGICAL,
intent(in) :: LR_ACTIVATED
957 COMPLEX,
intent(inout) :: A(LA)
958 INTEGER,
intent(inout) :: PARPIV_T1
959 INTEGER :: NVSCHUR_K253, IROW_L
960 INTEGER(8) :: LAELL8, NFRONT8
961 include
'mumps_headers.h'
962 IF (parpiv_t1.EQ.-999)
THEN
964 & lr_activated, parpiv_t1)
965 ELSE IF ((parpiv_t1.NE.0.AND.parpiv_t1.NE.1))
THEN
968 IF (parpiv_t1.NE.0)
THEN
969 IF ((keep(114).EQ.1) .AND. (keep(116).GT.0) )
THEN
970 irow_l = ioldps+6+keep(ixsz)+nass1
978 nvschur_k253 = keep(253)
980 nfront8 = int(nfront,8)
981 laell8 = nfront8 * nfront8 + int(nass1,8)
983 & a(poselt), laell8, keep,
984 & nfront, nass1, nvschur_k253,
subroutine cmumps_ldlt_asm_niv12_ip(a, la, iafath, nfront, nass1, iacb, ncols, lcb, iw, nrows, nelim, etatass, cb_is_compressed)
subroutine cmumps_asm_slave_to_slave_end(n, inode, iw, liw, nbrows, step, ptrist, itloc, rhs_mumps, keep, keep8)
subroutine cmumps_asm_slave_arrowheads(inode, n, iw, liw, ioldps, a, la, poselt, keep, keep8, itloc, fils, ptraiw, ptrarw, intarr, dblarr, lintarr, ldblarr, rhs_mumps, lrgroups)
subroutine cmumps_restore_indices(n, ison, inode, iwposcb, pimaster, ptlust_s, iw, liw, step, keep, keep8)
subroutine cmumps_asm_slave_to_slave_init(n, inode, iw, liw, a, la, nbrows, nbcols, opassw, opeliw, step, ptrist, ptrast, itloc, rhs_mumps, fils, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, myid, lrgroups)
subroutine cmumps_ldlt_asm_niv12(a, la, son_a, iafath, nfront, nass1, ncols, lcb, iw, nrows, nelim, etatass, cb_is_compressed)
subroutine cmumps_asm_slave_to_slave(n, inode, iw, liw, a, la, nbrows, nbcols, rowlist, collist, valson, opassw, opeliw, step, ptrist, ptrast, itloc, rhs_mumps, fils, icntl, keep, keep8, myid, is_oftype5or6, lda_valson)
subroutine cmumps_asm_max(n, inode, iw, liw, a, la, ison, nbcols, valson, ptlust_s, ptrast, step, pimaster, opassw, iwposcb, myid, keep, keep8)
subroutine cmumps_update_parpiv_entries(inode, keep, parpiv, lparpiv, nb_postponed)
logical function cmumps_is_gemm_large_enough(m, n, k)
subroutine cmumps_parpivt1_set_nvschur_max(n, inode, iw, liw, a, la, keep, perm, ioldps, poselt, nfront, nass1, lr_activated, parpiv_t1, nb_postponed)
subroutine cmumps_set_parpivt1(inode, nfront, nass1, keep, lr_activated, parpiv_t1)
subroutine cmumps_parpivt1_set_max(inode, a, laell8, keep, nfront, nass1, nvschur_k253, nb_postponed)
subroutine cmumps_asm_slave_master(n, inode, iw, liw, a, la, ison, nbrows, nbcols, rowlist, valson, ptlust_s, ptrast, step, pimaster, opassw, iwposcb, myid, keep, keep8, is_oftype5or6, lda_valson)
logical function cmumps_is_trsm_large_enough(m, n)
subroutine get_cut(iwr, nass, ncb, lrgroups, npartscb, npartsass, cut)
subroutine cmumps_dm_set_dynptr(cb_state, a, la, pamaster_or_ptrast, ixxd, ixxr, son_a, iachk, recsize)
subroutine cmumps_get_size_schur_in_front(n, ncb, size_schur, row_indices, perm, nvschur)
subroutine max_cluster(cut, cut_size, maxi_cluster)
subroutine compute_blr_vcs(k472, ibcksz, maxsize, nass)