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 , 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 REAL A(LA), VALSON(LDA_VALSON,NBROWS)
31 DOUBLE PRECISION OPASSW
32 LOGICAL,
INTENT(IN) :: IS_ofType5or6
33 INTEGER(8) :: POSELT, POSEL1, APOS,
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
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 (500), ICNTL(60)
137 INTEGER(8) KEEP8(150)
139 INTEGER NBROWS, NBCOLS
140 INTEGER(8) :: PTRAST(KEEP(28))
141 INTEGER IW(LIW), ITLOC(N+(253)), STEP(N),
142 & ptrist(keep(28)), fils(n)
143 INTEGER(8),
INTENT(IN) :: PTRARW(N), PTRAIW(N)
144 REAL :: RHS_MUMPS(KEEP(255))
146 INTEGER :: INTARR(KEEP8(27))
147 REAL :: DBLARR(KEEP8(26))
148 DOUBLE PRECISION OPASSW, OPELIW
149 INTEGER,
INTENT(IN) :: LRGROUPS(N)
151 REAL,
DIMENSION(:),
POINTER :: A_PTR
153 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
154 & k1,k2,k,j,jpos,nass
156 parameter( zero = 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 REAL :: 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 REAL :: RHS_MUMPS(KEEP(255))
236 INTEGER(8) :: PTRAST(KEEP(28))
237 REAL A(LA), VALSON(LDA_VALSON,NBROWS)
238 DOUBLE PRECISION OPASSW, OPELIW
239 INTEGER(8) :: , POSELT, APOS, K8
240 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,
242 REAL,
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 )
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, , NELIM
416 LOGICAL CB_IS_COMPRESSED
419 PARAMETER( ZERO = 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()
526 INTEGER(8) KEEP8(150)
527 INTEGER PIMASTER(KEEP(28)), (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(KEEP(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
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 REAL,
intent(inout) :: A(LA)
650 REAL,
intent(in) :: RHS_MUMPS(KEEP(255))
651 REAL,
intent(in) :: DBLARR(LDBLARR)
652 INTEGER,
intent(in) :: INTARR(LINTARR)
653 INTEGER,
intent(in) :: FILS(N)
654 INTEGER(8),
intent(in) :: PTRAIW(N), PTRARW(N)
655 INTEGER,
INTENT(IN) :: LRGROUPS(N)
659 include
'mumps_headers.h'
660 INTEGER :: HF, NBROWF, NBCOLF, NASS, NSLAVES
661 INTEGER :: ILOC, J, K, K1, K2, JPOS, IJROW
663 INTEGER(8) :: J18, 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, NPARTSASS, MAXI_CLUSTER,
668 & ibcksz2, minsize, topdiag
670 INTEGER :: K1RHS, K2RHS, JFirstRHS
672 parameter( zero = 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)
772 a(apos) = a(apos) + dblarr(ainput8)
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 :: SMUMPS_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 & ( smumps_is_trsm_large_enough( nass1, ncb
822 IF (ncb.EQ.keep(253))
THEN
831 INTEGER,
INTENT(in) :: m, n
832 DOUBLE PRECISION :: ai
833 INTEGER,
PARAMETER :: thres_ai = 400
834 ai = ( dble(m)*dble(n) ) /
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) :: INODE
857 INTEGER,
intent(in) :: KEEP(500), NFRONT, NASS1,
859 INTEGER,
intent(in) :: NB_POSTPONED
860 REAL,
intent(inout) :: A(LAELL8)
861 INTEGER(8) :: APOSMAX, APOS, NASS1_8, NFRONT_8
865 parameter( zero = 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) = rmax
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) = rmax
895 & keep, a(aposmax), nass1, nb_postponed)
899 & KEEP, PARPIV, LPARPIV,
902 INTEGER,
intent(in) :: INODE, LPARPIV, KEEP(500)
903 REAL,
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
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
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 (LIW), PERM(N), KEEP(500)
956 LOGICAL,
intent(in) :: LR_ACTIVATED
957 REAL,
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
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 compute_blr_vcs(k472, ibcksz, maxsize, nass)
subroutine get_cut(iwr, nass, ncb, lrgroups, npartscb, npartsass, cut)
subroutine smumps_dm_set_dynptr(cb_state, a, la, pamaster_or_ptrast, ixxd, ixxr, son_a, iachk, recsize)
subroutine smumps_get_size_schur_in_front(n, ncb, size_schur, row_indices, perm, nvschur)
subroutine max_cluster(cut, cut_size, maxi_cluster)
logical function smumps_is_trsm_large_enough(m, n)
subroutine smumps_parpivt1_set_max(inode, a, laell8, keep, nfront, nass1, nvschur_k253, nb_postponed)
subroutine smumps_ldlt_asm_niv12(a, la, son_a, iafath, nfront, nass1, ncols, lcb, iw, nrows, nelim, etatass, cb_is_compressed)
subroutine smumps_ldlt_asm_niv12_ip(a, la, iafath, nfront, nass1, iacb, ncols, lcb, iw, nrows, nelim, etatass, cb_is_compressed)
subroutine smumps_update_parpiv_entries(inode, keep, parpiv, lparpiv, nb_postponed)
subroutine smumps_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 smumps_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 smumps_parpivt1_set_nvschur_max(n, inode, iw, liw, a, la, keep, perm, ioldps, poselt, nfront, nass1, lr_activated, parpiv_t1, nb_postponed)
subroutine smumps_asm_max(n, inode, iw, liw, a, la, ison, nbcols, valson, ptlust_s, ptrast, step, pimaster, opassw, iwposcb, myid, keep, keep8)
subroutine smumps_restore_indices(n, ison, inode, iwposcb, pimaster, ptlust_s, iw, liw, step, keep, keep8)
logical function smumps_is_gemm_large_enough(m, n, k)
subroutine smumps_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 smumps_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)
subroutine smumps_set_parpivt1(inode, nfront, nass1, keep, lr_activated, parpiv_t1)
subroutine smumps_asm_slave_to_slave_end(n, inode, iw, liw, nbrows, step, ptrist, itloc, rhs_mumps, keep, keep8)