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

◆ ircchk()

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

Definition at line 14886 of file blacstest.f.

14889*
14890* .. Scalar Arguments ..
14891 INTEGER IPRE, IPOST, PADVAL, M, N, LDI, MYROW, MYCOL, TESTNUM
14892 INTEGER MAXERR, NERR
14893* ..
14894* .. Array Arguments ..
14895 INTEGER RA(*), CA(*), ERRIBUF(6, MAXERR)
14896 INTEGER ERRDBUF(2, MAXERR)
14897* ..
14898* .. Parameters ..
14899 INTEGER ERR_PRE, ERR_POST, ERR_GAP, ERR_TRI, ERR_MAT
14900 parameter( err_pre = 1, err_post = 2, err_gap = 3, err_tri = 4 )
14901 parameter( err_mat = 5 )
14902* ..
14903* .. External Functions ..
14904 INTEGER IBTNPROCS
14905 EXTERNAL ibtnprocs
14906* ..
14907* .. Local Scalars ..
14908 INTEGER I, J, K, IAM
14909* ..
14910* .. Executable Statements ..
14911*
14912 iam = myrow * ibtnprocs() + mycol
14913*
14914* Check pre padding
14915*
14916 IF( ldi .NE. -1 ) THEN
14917 IF( ipre .GT. 0 ) THEN
14918 DO 10 i = 1, ipre
14919 IF( ra(i) .NE. padval ) THEN
14920 nerr = nerr + 1
14921 IF( nerr .LE. maxerr ) THEN
14922 erribuf(1, nerr) = testnum
14923 erribuf(2, nerr) = ldi
14924 erribuf(3, nerr) = iam
14925 erribuf(4, nerr) = i
14926 erribuf(5, nerr) = ipre - i + 1
14927 erribuf(6, nerr) = -err_pre
14928 errdbuf(1, nerr) = int( ra(i) )
14929 errdbuf(2, nerr) = int( padval )
14930 END IF
14931 ENDIF
14932 IF( ca(i) .NE. padval ) THEN
14933 nerr = nerr + 1
14934 IF( nerr .LE. maxerr ) THEN
14935 erribuf(1, nerr) = testnum
14936 erribuf(2, nerr) = ldi
14937 erribuf(3, nerr) = iam
14938 erribuf(4, nerr) = i
14939 erribuf(5, nerr) = ipre - i + 1
14940 erribuf(6, nerr) = -10 - err_pre
14941 errdbuf(1, nerr) = int( ca(i) )
14942 errdbuf(2, nerr) = int( padval )
14943 END IF
14944 ENDIF
14945 10 CONTINUE
14946 END IF
14947*
14948* Check post padding
14949*
14950 IF( ipost .GT. 0 ) THEN
14951 k = ipre + ldi*n
14952 DO 20 i = k+1, k+ipost
14953 IF( ra(i) .NE. padval ) THEN
14954 nerr = nerr + 1
14955 IF( nerr .LE. maxerr ) THEN
14956 erribuf(1, nerr) = testnum
14957 erribuf(2, nerr) = ldi
14958 erribuf(3, nerr) = iam
14959 erribuf(4, nerr) = i - k
14960 erribuf(5, nerr) = i
14961 erribuf(6, nerr) = -err_post
14962 errdbuf(1, nerr) = int( ra(i) )
14963 errdbuf(2, nerr) = int( padval )
14964 END IF
14965 ENDIF
14966 IF( ca(i) .NE. padval ) THEN
14967 nerr = nerr + 1
14968 IF( nerr .LE. maxerr ) THEN
14969 erribuf(1, nerr) = testnum
14970 erribuf(2, nerr) = ldi
14971 erribuf(3, nerr) = iam
14972 erribuf(4, nerr) = i - k
14973 erribuf(5, nerr) = i
14974 erribuf(6, nerr) = -10 - err_post
14975 errdbuf(1, nerr) = int( ca(i) )
14976 errdbuf(2, nerr) = int( padval )
14977 END IF
14978 ENDIF
14979 20 CONTINUE
14980 END IF
14981*
14982* Check all (LDI-M) gaps
14983*
14984 IF( ldi .GT. m ) THEN
14985 k = ipre + m + 1
14986 DO 40 j = 1, n
14987 DO 30 i = m+1, ldi
14988 k = ipre + (j-1)*ldi + i
14989 IF( ra(k) .NE. padval) THEN
14990 nerr = nerr + 1
14991 IF( nerr .LE. maxerr ) THEN
14992 erribuf(1, nerr) = testnum
14993 erribuf(2, nerr) = ldi
14994 erribuf(3, nerr) = iam
14995 erribuf(4, nerr) = i
14996 erribuf(5, nerr) = j
14997 erribuf(6, nerr) = -err_gap
14998 errdbuf(1, nerr) = int( ra(k) )
14999 errdbuf(2, nerr) = int( padval )
15000 END IF
15001 END IF
15002 IF( ca(k) .NE. padval) THEN
15003 nerr = nerr + 1
15004 IF( nerr .LE. maxerr ) THEN
15005 erribuf(1, nerr) = testnum
15006 erribuf(2, nerr) = ldi
15007 erribuf(3, nerr) = iam
15008 erribuf(4, nerr) = i
15009 erribuf(5, nerr) = j
15010 erribuf(6, nerr) = -10 - err_gap
15011 errdbuf(1, nerr) = int( ca(k) )
15012 errdbuf(2, nerr) = int( padval )
15013 END IF
15014 END IF
15015 30 CONTINUE
15016 40 CONTINUE
15017 END IF
15018*
15019* if RA and CA don't exist, buffs better be untouched
15020*
15021 ELSE
15022 DO 50 i = 1, ipre+ipost
15023 IF( ra(i) .NE. padval) THEN
15024 nerr = nerr + 1
15025 IF( nerr .LE. maxerr ) THEN
15026 erribuf(1, nerr) = testnum
15027 erribuf(2, nerr) = ldi
15028 erribuf(3, nerr) = iam
15029 erribuf(4, nerr) = i
15030 erribuf(5, nerr) = ipre+ipost
15031 erribuf(6, nerr) = -err_pre
15032 errdbuf(1, nerr) = int( ra(i) )
15033 errdbuf(2, nerr) = int( padval )
15034 END IF
15035 END IF
15036 IF( ca(i) .NE. padval) THEN
15037 nerr = nerr + 1
15038 IF( nerr .LE. maxerr ) THEN
15039 erribuf(1, nerr) = testnum
15040 erribuf(2, nerr) = ldi
15041 erribuf(3, nerr) = iam
15042 erribuf(4, nerr) = i
15043 erribuf(5, nerr) = ipre+ipost
15044 erribuf(6, nerr) = -10 - err_pre
15045 errdbuf(1, nerr) = int( ca(i) )
15046 errdbuf(2, nerr) = int( padval )
15047 END IF
15048 END IF
15049 50 CONTINUE
15050 ENDIF
15051*
15052 RETURN
ibtnprocs
integer function ibtnprocs()
Definition btprim.f:81
Here is the caller graph for this function: