SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ drcchk()

subroutine drcchk ( integer  ipre,
integer  ipost,
integer  padval,
integer  m,
integer  n,
integer, dimension(*)  ra,
integer, dimension(*)  ca,
integer  ldi,
integer  myrow,
integer  mycol,
integer  testnum,
integer  maxerr,
integer  nerr,
integer, dimension(6, maxerr)  erribuf,
double precision, dimension(2, maxerr)  errdbuf 
)

Definition at line 16513 of file blacstest.f.

16516*
16517* .. Scalar Arguments ..
16518 INTEGER IPRE, IPOST, PADVAL, M, N, LDI, MYROW, MYCOL, TESTNUM
16519 INTEGER MAXERR, NERR
16520* ..
16521* .. Array Arguments ..
16522 INTEGER RA(*), CA(*), ERRIBUF(6, MAXERR)
16523 DOUBLE PRECISION ERRDBUF(2, MAXERR)
16524* ..
16525* .. Parameters ..
16526 INTEGER ERR_PRE, ERR_POST, ERR_GAP, ERR_TRI, ERR_MAT
16527 parameter( err_pre = 1, err_post = 2, err_gap = 3, err_tri = 4 )
16528 parameter( err_mat = 5 )
16529* ..
16530* .. External Functions ..
16531 INTEGER IBTNPROCS
16532 EXTERNAL ibtnprocs
16533* ..
16534* .. Local Scalars ..
16535 INTEGER I, J, K, IAM
16536* ..
16537* .. Executable Statements ..
16538*
16539 iam = myrow * ibtnprocs() + mycol
16540*
16541* Check pre padding
16542*
16543 IF( ldi .NE. -1 ) THEN
16544 IF( ipre .GT. 0 ) THEN
16545 DO 10 i = 1, ipre
16546 IF( ra(i) .NE. padval ) THEN
16547 nerr = nerr + 1
16548 IF( nerr .LE. maxerr ) THEN
16549 erribuf(1, nerr) = testnum
16550 erribuf(2, nerr) = ldi
16551 erribuf(3, nerr) = iam
16552 erribuf(4, nerr) = i
16553 erribuf(5, nerr) = ipre - i + 1
16554 erribuf(6, nerr) = -err_pre
16555 errdbuf(1, nerr) = dble( ra(i) )
16556 errdbuf(2, nerr) = dble( padval )
16557 END IF
16558 ENDIF
16559 IF( ca(i) .NE. padval ) THEN
16560 nerr = nerr + 1
16561 IF( nerr .LE. maxerr ) THEN
16562 erribuf(1, nerr) = testnum
16563 erribuf(2, nerr) = ldi
16564 erribuf(3, nerr) = iam
16565 erribuf(4, nerr) = i
16566 erribuf(5, nerr) = ipre - i + 1
16567 erribuf(6, nerr) = -10 - err_pre
16568 errdbuf(1, nerr) = dble( ca(i) )
16569 errdbuf(2, nerr) = dble( padval )
16570 END IF
16571 ENDIF
16572 10 CONTINUE
16573 END IF
16574*
16575* Check post padding
16576*
16577 IF( ipost .GT. 0 ) THEN
16578 k = ipre + ldi*n
16579 DO 20 i = k+1, k+ipost
16580 IF( ra(i) .NE. padval ) THEN
16581 nerr = nerr + 1
16582 IF( nerr .LE. maxerr ) THEN
16583 erribuf(1, nerr) = testnum
16584 erribuf(2, nerr) = ldi
16585 erribuf(3, nerr) = iam
16586 erribuf(4, nerr) = i - k
16587 erribuf(5, nerr) = i
16588 erribuf(6, nerr) = -err_post
16589 errdbuf(1, nerr) = dble( ra(i) )
16590 errdbuf(2, nerr) = dble( padval )
16591 END IF
16592 ENDIF
16593 IF( ca(i) .NE. padval ) THEN
16594 nerr = nerr + 1
16595 IF( nerr .LE. maxerr ) THEN
16596 erribuf(1, nerr) = testnum
16597 erribuf(2, nerr) = ldi
16598 erribuf(3, nerr) = iam
16599 erribuf(4, nerr) = i - k
16600 erribuf(5, nerr) = i
16601 erribuf(6, nerr) = -10 - err_post
16602 errdbuf(1, nerr) = dble( ca(i) )
16603 errdbuf(2, nerr) = dble( padval )
16604 END IF
16605 ENDIF
16606 20 CONTINUE
16607 END IF
16608*
16609* Check all (LDI-M) gaps
16610*
16611 IF( ldi .GT. m ) THEN
16612 k = ipre + m + 1
16613 DO 40 j = 1, n
16614 DO 30 i = m+1, ldi
16615 k = ipre + (j-1)*ldi + i
16616 IF( ra(k) .NE. padval) THEN
16617 nerr = nerr + 1
16618 IF( nerr .LE. maxerr ) THEN
16619 erribuf(1, nerr) = testnum
16620 erribuf(2, nerr) = ldi
16621 erribuf(3, nerr) = iam
16622 erribuf(4, nerr) = i
16623 erribuf(5, nerr) = j
16624 erribuf(6, nerr) = -err_gap
16625 errdbuf(1, nerr) = dble( ra(k) )
16626 errdbuf(2, nerr) = dble( padval )
16627 END IF
16628 END IF
16629 IF( ca(k) .NE. padval) THEN
16630 nerr = nerr + 1
16631 IF( nerr .LE. maxerr ) THEN
16632 erribuf(1, nerr) = testnum
16633 erribuf(2, nerr) = ldi
16634 erribuf(3, nerr) = iam
16635 erribuf(4, nerr) = i
16636 erribuf(5, nerr) = j
16637 erribuf(6, nerr) = -10 - err_gap
16638 errdbuf(1, nerr) = dble( ca(k) )
16639 errdbuf(2, nerr) = dble( padval )
16640 END IF
16641 END IF
16642 30 CONTINUE
16643 40 CONTINUE
16644 END IF
16645*
16646* if RA and CA don't exist, buffs better be untouched
16647*
16648 ELSE
16649 DO 50 i = 1, ipre+ipost
16650 IF( ra(i) .NE. padval) THEN
16651 nerr = nerr + 1
16652 IF( nerr .LE. maxerr ) THEN
16653 erribuf(1, nerr) = testnum
16654 erribuf(2, nerr) = ldi
16655 erribuf(3, nerr) = iam
16656 erribuf(4, nerr) = i
16657 erribuf(5, nerr) = ipre+ipost
16658 erribuf(6, nerr) = -err_pre
16659 errdbuf(1, nerr) = dble( ra(i) )
16660 errdbuf(2, nerr) = dble( padval )
16661 END IF
16662 END IF
16663 IF( ca(i) .NE. padval) THEN
16664 nerr = nerr + 1
16665 IF( nerr .LE. maxerr ) THEN
16666 erribuf(1, nerr) = testnum
16667 erribuf(2, nerr) = ldi
16668 erribuf(3, nerr) = iam
16669 erribuf(4, nerr) = i
16670 erribuf(5, nerr) = ipre+ipost
16671 erribuf(6, nerr) = -10 - err_pre
16672 errdbuf(1, nerr) = dble( ca(i) )
16673 errdbuf(2, nerr) = dble( padval )
16674 END IF
16675 END IF
16676 50 CONTINUE
16677 ENDIF
16678*
16679 RETURN
ibtnprocs
integer function ibtnprocs()
Definition btprim.f:81
Here is the caller graph for this function: