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

◆ srcchk()

subroutine srcchk ( 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,
real, dimension(2, maxerr)  errdbuf 
)

Definition at line 15698 of file blacstest.f.

15701*
15702* .. Scalar Arguments ..
15703 INTEGER IPRE, IPOST, PADVAL, M, N, LDI, MYROW, MYCOL, TESTNUM
15704 INTEGER MAXERR, NERR
15705* ..
15706* .. Array Arguments ..
15707 INTEGER RA(*), CA(*), ERRIBUF(6, MAXERR)
15708 REAL ERRDBUF(2, MAXERR)
15709* ..
15710* .. Parameters ..
15711 INTEGER ERR_PRE, ERR_POST, ERR_GAP, ERR_TRI, ERR_MAT
15712 parameter( err_pre = 1, err_post = 2, err_gap = 3, err_tri = 4 )
15713 parameter( err_mat = 5 )
15714* ..
15715* .. External Functions ..
15716 INTEGER IBTNPROCS
15717 EXTERNAL ibtnprocs
15718* ..
15719* .. Local Scalars ..
15720 INTEGER I, J, K, IAM
15721* ..
15722* .. Executable Statements ..
15723*
15724 iam = myrow * ibtnprocs() + mycol
15725*
15726* Check pre padding
15727*
15728 IF( ldi .NE. -1 ) THEN
15729 IF( ipre .GT. 0 ) THEN
15730 DO 10 i = 1, ipre
15731 IF( ra(i) .NE. padval ) THEN
15732 nerr = nerr + 1
15733 IF( nerr .LE. maxerr ) THEN
15734 erribuf(1, nerr) = testnum
15735 erribuf(2, nerr) = ldi
15736 erribuf(3, nerr) = iam
15737 erribuf(4, nerr) = i
15738 erribuf(5, nerr) = ipre - i + 1
15739 erribuf(6, nerr) = -err_pre
15740 errdbuf(1, nerr) = real( ra(i) )
15741 errdbuf(2, nerr) = real( padval )
15742 END IF
15743 ENDIF
15744 IF( ca(i) .NE. padval ) THEN
15745 nerr = nerr + 1
15746 IF( nerr .LE. maxerr ) THEN
15747 erribuf(1, nerr) = testnum
15748 erribuf(2, nerr) = ldi
15749 erribuf(3, nerr) = iam
15750 erribuf(4, nerr) = i
15751 erribuf(5, nerr) = ipre - i + 1
15752 erribuf(6, nerr) = -10 - err_pre
15753 errdbuf(1, nerr) = real( ca(i) )
15754 errdbuf(2, nerr) = real( padval )
15755 END IF
15756 ENDIF
15757 10 CONTINUE
15758 END IF
15759*
15760* Check post padding
15761*
15762 IF( ipost .GT. 0 ) THEN
15763 k = ipre + ldi*n
15764 DO 20 i = k+1, k+ipost
15765 IF( ra(i) .NE. padval ) THEN
15766 nerr = nerr + 1
15767 IF( nerr .LE. maxerr ) THEN
15768 erribuf(1, nerr) = testnum
15769 erribuf(2, nerr) = ldi
15770 erribuf(3, nerr) = iam
15771 erribuf(4, nerr) = i - k
15772 erribuf(5, nerr) = i
15773 erribuf(6, nerr) = -err_post
15774 errdbuf(1, nerr) = real( ra(i) )
15775 errdbuf(2, nerr) = real( padval )
15776 END IF
15777 ENDIF
15778 IF( ca(i) .NE. padval ) THEN
15779 nerr = nerr + 1
15780 IF( nerr .LE. maxerr ) THEN
15781 erribuf(1, nerr) = testnum
15782 erribuf(2, nerr) = ldi
15783 erribuf(3, nerr) = iam
15784 erribuf(4, nerr) = i - k
15785 erribuf(5, nerr) = i
15786 erribuf(6, nerr) = -10 - err_post
15787 errdbuf(1, nerr) = real( ca(i) )
15788 errdbuf(2, nerr) = real( padval )
15789 END IF
15790 ENDIF
15791 20 CONTINUE
15792 END IF
15793*
15794* Check all (LDI-M) gaps
15795*
15796 IF( ldi .GT. m ) THEN
15797 k = ipre + m + 1
15798 DO 40 j = 1, n
15799 DO 30 i = m+1, ldi
15800 k = ipre + (j-1)*ldi + i
15801 IF( ra(k) .NE. padval) THEN
15802 nerr = nerr + 1
15803 IF( nerr .LE. maxerr ) THEN
15804 erribuf(1, nerr) = testnum
15805 erribuf(2, nerr) = ldi
15806 erribuf(3, nerr) = iam
15807 erribuf(4, nerr) = i
15808 erribuf(5, nerr) = j
15809 erribuf(6, nerr) = -err_gap
15810 errdbuf(1, nerr) = real( ra(k) )
15811 errdbuf(2, nerr) = real( padval )
15812 END IF
15813 END IF
15814 IF( ca(k) .NE. padval) THEN
15815 nerr = nerr + 1
15816 IF( nerr .LE. maxerr ) THEN
15817 erribuf(1, nerr) = testnum
15818 erribuf(2, nerr) = ldi
15819 erribuf(3, nerr) = iam
15820 erribuf(4, nerr) = i
15821 erribuf(5, nerr) = j
15822 erribuf(6, nerr) = -10 - err_gap
15823 errdbuf(1, nerr) = real( ca(k) )
15824 errdbuf(2, nerr) = real( padval )
15825 END IF
15826 END IF
15827 30 CONTINUE
15828 40 CONTINUE
15829 END IF
15830*
15831* if RA and CA don't exist, buffs better be untouched
15832*
15833 ELSE
15834 DO 50 i = 1, ipre+ipost
15835 IF( ra(i) .NE. padval) THEN
15836 nerr = nerr + 1
15837 IF( nerr .LE. maxerr ) THEN
15838 erribuf(1, nerr) = testnum
15839 erribuf(2, nerr) = ldi
15840 erribuf(3, nerr) = iam
15841 erribuf(4, nerr) = i
15842 erribuf(5, nerr) = ipre+ipost
15843 erribuf(6, nerr) = -err_pre
15844 errdbuf(1, nerr) = real( ra(i) )
15845 errdbuf(2, nerr) = real( padval )
15846 END IF
15847 END IF
15848 IF( ca(i) .NE. padval) THEN
15849 nerr = nerr + 1
15850 IF( nerr .LE. maxerr ) THEN
15851 erribuf(1, nerr) = testnum
15852 erribuf(2, nerr) = ldi
15853 erribuf(3, nerr) = iam
15854 erribuf(4, nerr) = i
15855 erribuf(5, nerr) = ipre+ipost
15856 erribuf(6, nerr) = -10 - err_pre
15857 errdbuf(1, nerr) = real( ca(i) )
15858 errdbuf(2, nerr) = real( padval )
15859 END IF
15860 END IF
15861 50 CONTINUE
15862 ENDIF
15863*
15864 RETURN
ibtnprocs
integer function ibtnprocs()
Definition btprim.f:81
Here is the caller graph for this function: