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

◆ crcchk()

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

Definition at line 17328 of file blacstest.f.

17331*
17332* .. Scalar Arguments ..
17333 INTEGER IPRE, IPOST, PADVAL, M, N, LDI, MYROW, MYCOL, TESTNUM
17334 INTEGER MAXERR, NERR
17335* ..
17336* .. Array Arguments ..
17337 INTEGER RA(*), CA(*), ERRIBUF(6, MAXERR)
17338 COMPLEX ERRDBUF(2, MAXERR)
17339* ..
17340* .. Parameters ..
17341 INTEGER ERR_PRE, ERR_POST, ERR_GAP, ERR_TRI, ERR_MAT
17342 parameter( err_pre = 1, err_post = 2, err_gap = 3, err_tri = 4 )
17343 parameter( err_mat = 5 )
17344* ..
17345* .. External Functions ..
17346 INTEGER IBTNPROCS
17347 EXTERNAL ibtnprocs
17348* ..
17349* .. Local Scalars ..
17350 INTEGER I, J, K, IAM
17351* ..
17352* .. Executable Statements ..
17353*
17354 iam = myrow * ibtnprocs() + mycol
17355*
17356* Check pre padding
17357*
17358 IF( ldi .NE. -1 ) THEN
17359 IF( ipre .GT. 0 ) THEN
17360 DO 10 i = 1, ipre
17361 IF( ra(i) .NE. padval ) THEN
17362 nerr = nerr + 1
17363 IF( nerr .LE. maxerr ) THEN
17364 erribuf(1, nerr) = testnum
17365 erribuf(2, nerr) = ldi
17366 erribuf(3, nerr) = iam
17367 erribuf(4, nerr) = i
17368 erribuf(5, nerr) = ipre - i + 1
17369 erribuf(6, nerr) = -err_pre
17370 errdbuf(1, nerr) = cmplx( ra(i) )
17371 errdbuf(2, nerr) = cmplx( padval )
17372 END IF
17373 ENDIF
17374 IF( ca(i) .NE. padval ) THEN
17375 nerr = nerr + 1
17376 IF( nerr .LE. maxerr ) THEN
17377 erribuf(1, nerr) = testnum
17378 erribuf(2, nerr) = ldi
17379 erribuf(3, nerr) = iam
17380 erribuf(4, nerr) = i
17381 erribuf(5, nerr) = ipre - i + 1
17382 erribuf(6, nerr) = -10 - err_pre
17383 errdbuf(1, nerr) = cmplx( ca(i) )
17384 errdbuf(2, nerr) = cmplx( padval )
17385 END IF
17386 ENDIF
17387 10 CONTINUE
17388 END IF
17389*
17390* Check post padding
17391*
17392 IF( ipost .GT. 0 ) THEN
17393 k = ipre + ldi*n
17394 DO 20 i = k+1, k+ipost
17395 IF( ra(i) .NE. padval ) THEN
17396 nerr = nerr + 1
17397 IF( nerr .LE. maxerr ) THEN
17398 erribuf(1, nerr) = testnum
17399 erribuf(2, nerr) = ldi
17400 erribuf(3, nerr) = iam
17401 erribuf(4, nerr) = i - k
17402 erribuf(5, nerr) = i
17403 erribuf(6, nerr) = -err_post
17404 errdbuf(1, nerr) = cmplx( ra(i) )
17405 errdbuf(2, nerr) = cmplx( padval )
17406 END IF
17407 ENDIF
17408 IF( ca(i) .NE. padval ) THEN
17409 nerr = nerr + 1
17410 IF( nerr .LE. maxerr ) THEN
17411 erribuf(1, nerr) = testnum
17412 erribuf(2, nerr) = ldi
17413 erribuf(3, nerr) = iam
17414 erribuf(4, nerr) = i - k
17415 erribuf(5, nerr) = i
17416 erribuf(6, nerr) = -10 - err_post
17417 errdbuf(1, nerr) = cmplx( ca(i) )
17418 errdbuf(2, nerr) = cmplx( padval )
17419 END IF
17420 ENDIF
17421 20 CONTINUE
17422 END IF
17423*
17424* Check all (LDI-M) gaps
17425*
17426 IF( ldi .GT. m ) THEN
17427 k = ipre + m + 1
17428 DO 40 j = 1, n
17429 DO 30 i = m+1, ldi
17430 k = ipre + (j-1)*ldi + i
17431 IF( ra(k) .NE. padval) THEN
17432 nerr = nerr + 1
17433 IF( nerr .LE. maxerr ) THEN
17434 erribuf(1, nerr) = testnum
17435 erribuf(2, nerr) = ldi
17436 erribuf(3, nerr) = iam
17437 erribuf(4, nerr) = i
17438 erribuf(5, nerr) = j
17439 erribuf(6, nerr) = -err_gap
17440 errdbuf(1, nerr) = cmplx( ra(k) )
17441 errdbuf(2, nerr) = cmplx( padval )
17442 END IF
17443 END IF
17444 IF( ca(k) .NE. padval) THEN
17445 nerr = nerr + 1
17446 IF( nerr .LE. maxerr ) THEN
17447 erribuf(1, nerr) = testnum
17448 erribuf(2, nerr) = ldi
17449 erribuf(3, nerr) = iam
17450 erribuf(4, nerr) = i
17451 erribuf(5, nerr) = j
17452 erribuf(6, nerr) = -10 - err_gap
17453 errdbuf(1, nerr) = cmplx( ca(k) )
17454 errdbuf(2, nerr) = cmplx( padval )
17455 END IF
17456 END IF
17457 30 CONTINUE
17458 40 CONTINUE
17459 END IF
17460*
17461* if RA and CA don't exist, buffs better be untouched
17462*
17463 ELSE
17464 DO 50 i = 1, ipre+ipost
17465 IF( ra(i) .NE. padval) THEN
17466 nerr = nerr + 1
17467 IF( nerr .LE. maxerr ) THEN
17468 erribuf(1, nerr) = testnum
17469 erribuf(2, nerr) = ldi
17470 erribuf(3, nerr) = iam
17471 erribuf(4, nerr) = i
17472 erribuf(5, nerr) = ipre+ipost
17473 erribuf(6, nerr) = -err_pre
17474 errdbuf(1, nerr) = cmplx( ra(i) )
17475 errdbuf(2, nerr) = cmplx( padval )
17476 END IF
17477 END IF
17478 IF( ca(i) .NE. padval) THEN
17479 nerr = nerr + 1
17480 IF( nerr .LE. maxerr ) THEN
17481 erribuf(1, nerr) = testnum
17482 erribuf(2, nerr) = ldi
17483 erribuf(3, nerr) = iam
17484 erribuf(4, nerr) = i
17485 erribuf(5, nerr) = ipre+ipost
17486 erribuf(6, nerr) = -10 - err_pre
17487 errdbuf(1, nerr) = cmplx( ca(i) )
17488 errdbuf(2, nerr) = cmplx( padval )
17489 END IF
17490 END IF
17491 50 CONTINUE
17492 ENDIF
17493*
17494 RETURN
cmplx
float cmplx[2]
Definition pblas.h:136
ibtnprocs
integer function ibtnprocs()
Definition btprim.f:81
Here is the caller graph for this function: