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

◆ zrcchk()

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

Definition at line 18145 of file blacstest.f.

18148*
18149* .. Scalar Arguments ..
18150 INTEGER IPRE, IPOST, PADVAL, M, N, LDI, MYROW, MYCOL, TESTNUM
18151 INTEGER MAXERR, NERR
18152* ..
18153* .. Array Arguments ..
18154 INTEGER RA(*), CA(*), ERRIBUF(6, MAXERR)
18155 DOUBLE COMPLEX ERRDBUF(2, MAXERR)
18156* ..
18157* .. Parameters ..
18158 INTEGER ERR_PRE, ERR_POST, ERR_GAP, ERR_TRI, ERR_MAT
18159 parameter( err_pre = 1, err_post = 2, err_gap = 3, err_tri = 4 )
18160 parameter( err_mat = 5 )
18161* ..
18162* .. External Functions ..
18163 INTEGER IBTNPROCS
18164 EXTERNAL ibtnprocs
18165* ..
18166* .. Local Scalars ..
18167 INTEGER I, J, K, IAM
18168* ..
18169* .. Executable Statements ..
18170*
18171 iam = myrow * ibtnprocs() + mycol
18172*
18173* Check pre padding
18174*
18175 IF( ldi .NE. -1 ) THEN
18176 IF( ipre .GT. 0 ) THEN
18177 DO 10 i = 1, ipre
18178 IF( ra(i) .NE. padval ) THEN
18179 nerr = nerr + 1
18180 IF( nerr .LE. maxerr ) THEN
18181 erribuf(1, nerr) = testnum
18182 erribuf(2, nerr) = ldi
18183 erribuf(3, nerr) = iam
18184 erribuf(4, nerr) = i
18185 erribuf(5, nerr) = ipre - i + 1
18186 erribuf(6, nerr) = -err_pre
18187 errdbuf(1, nerr) = dcmplx( ra(i) )
18188 errdbuf(2, nerr) = dcmplx( padval )
18189 END IF
18190 ENDIF
18191 IF( ca(i) .NE. padval ) THEN
18192 nerr = nerr + 1
18193 IF( nerr .LE. maxerr ) THEN
18194 erribuf(1, nerr) = testnum
18195 erribuf(2, nerr) = ldi
18196 erribuf(3, nerr) = iam
18197 erribuf(4, nerr) = i
18198 erribuf(5, nerr) = ipre - i + 1
18199 erribuf(6, nerr) = -10 - err_pre
18200 errdbuf(1, nerr) = dcmplx( ca(i) )
18201 errdbuf(2, nerr) = dcmplx( padval )
18202 END IF
18203 ENDIF
18204 10 CONTINUE
18205 END IF
18206*
18207* Check post padding
18208*
18209 IF( ipost .GT. 0 ) THEN
18210 k = ipre + ldi*n
18211 DO 20 i = k+1, k+ipost
18212 IF( ra(i) .NE. padval ) THEN
18213 nerr = nerr + 1
18214 IF( nerr .LE. maxerr ) THEN
18215 erribuf(1, nerr) = testnum
18216 erribuf(2, nerr) = ldi
18217 erribuf(3, nerr) = iam
18218 erribuf(4, nerr) = i - k
18219 erribuf(5, nerr) = i
18220 erribuf(6, nerr) = -err_post
18221 errdbuf(1, nerr) = dcmplx( ra(i) )
18222 errdbuf(2, nerr) = dcmplx( padval )
18223 END IF
18224 ENDIF
18225 IF( ca(i) .NE. padval ) THEN
18226 nerr = nerr + 1
18227 IF( nerr .LE. maxerr ) THEN
18228 erribuf(1, nerr) = testnum
18229 erribuf(2, nerr) = ldi
18230 erribuf(3, nerr) = iam
18231 erribuf(4, nerr) = i - k
18232 erribuf(5, nerr) = i
18233 erribuf(6, nerr) = -10 - err_post
18234 errdbuf(1, nerr) = dcmplx( ca(i) )
18235 errdbuf(2, nerr) = dcmplx( padval )
18236 END IF
18237 ENDIF
18238 20 CONTINUE
18239 END IF
18240*
18241* Check all (LDI-M) gaps
18242*
18243 IF( ldi .GT. m ) THEN
18244 k = ipre + m + 1
18245 DO 40 j = 1, n
18246 DO 30 i = m+1, ldi
18247 k = ipre + (j-1)*ldi + i
18248 IF( ra(k) .NE. padval) THEN
18249 nerr = nerr + 1
18250 IF( nerr .LE. maxerr ) THEN
18251 erribuf(1, nerr) = testnum
18252 erribuf(2, nerr) = ldi
18253 erribuf(3, nerr) = iam
18254 erribuf(4, nerr) = i
18255 erribuf(5, nerr) = j
18256 erribuf(6, nerr) = -err_gap
18257 errdbuf(1, nerr) = dcmplx( ra(k) )
18258 errdbuf(2, nerr) = dcmplx( padval )
18259 END IF
18260 END IF
18261 IF( ca(k) .NE. padval) THEN
18262 nerr = nerr + 1
18263 IF( nerr .LE. maxerr ) THEN
18264 erribuf(1, nerr) = testnum
18265 erribuf(2, nerr) = ldi
18266 erribuf(3, nerr) = iam
18267 erribuf(4, nerr) = i
18268 erribuf(5, nerr) = j
18269 erribuf(6, nerr) = -10 - err_gap
18270 errdbuf(1, nerr) = dcmplx( ca(k) )
18271 errdbuf(2, nerr) = dcmplx( padval )
18272 END IF
18273 END IF
18274 30 CONTINUE
18275 40 CONTINUE
18276 END IF
18277*
18278* if RA and CA don't exist, buffs better be untouched
18279*
18280 ELSE
18281 DO 50 i = 1, ipre+ipost
18282 IF( ra(i) .NE. padval) THEN
18283 nerr = nerr + 1
18284 IF( nerr .LE. maxerr ) THEN
18285 erribuf(1, nerr) = testnum
18286 erribuf(2, nerr) = ldi
18287 erribuf(3, nerr) = iam
18288 erribuf(4, nerr) = i
18289 erribuf(5, nerr) = ipre+ipost
18290 erribuf(6, nerr) = -err_pre
18291 errdbuf(1, nerr) = dcmplx( ra(i) )
18292 errdbuf(2, nerr) = dcmplx( padval )
18293 END IF
18294 END IF
18295 IF( ca(i) .NE. padval) THEN
18296 nerr = nerr + 1
18297 IF( nerr .LE. maxerr ) THEN
18298 erribuf(1, nerr) = testnum
18299 erribuf(2, nerr) = ldi
18300 erribuf(3, nerr) = iam
18301 erribuf(4, nerr) = i
18302 erribuf(5, nerr) = ipre+ipost
18303 erribuf(6, nerr) = -10 - err_pre
18304 errdbuf(1, nerr) = dcmplx( ca(i) )
18305 errdbuf(2, nerr) = dcmplx( padval )
18306 END IF
18307 END IF
18308 50 CONTINUE
18309 ENDIF
18310*
18311 RETURN
ibtnprocs
integer function ibtnprocs()
Definition btprim.f:81
Here is the caller graph for this function: