12034
12035
12036 CHARACTER*1 SCOPE
12037 INTEGER ICTXT, M, N, LDA, TESTNUM, MAXERR, NERR
12038
12039
12040 INTEGER ERRIBUF(6, MAXERR), ISEED(*)
12041 INTEGER A(LDA,*), ERRDBUF(2, MAXERR)
12042
12043
12044 INTEGER IBTMYPROC, IBTNPROCS
12045 INTEGER IBTRAN
12047
12048
12049 INTEGER NPROCS, NPROW, NPCOL, MYROW, MYCOL, NODE, NNODES, DEST
12050 INTEGER I, J, K
12051 INTEGER ANS
12052
12053
12054
12056 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
12057 dest = myrow*nprocs + mycol
12058
12059
12060
12061 IF( scope .EQ. 'R' ) THEN
12062 nnodes = npcol
12063 DO 10 i = 0, nnodes-1
12064 node = myrow * nprocs + i
12065 iseed(i*4+1) = mod( 1002 + testnum*5 + node*3, 4096 )
12066 iseed(i*4+2) = mod( 2027 + testnum*7 + node, 4096 )
12067 iseed(i*4+3) = mod( 1234 + testnum + node*3, 4096 )
12068 iseed(i*4+4) = mod( 4311 + testnum*10 + node*2, 4096 )
12069 10 CONTINUE
12070 ELSE IF( scope .EQ. 'C' ) THEN
12071 nnodes = nprow
12072 DO 20 i = 0, nnodes-1
12073 node = i * nprocs + mycol
12074 iseed(i*4+1) = mod( 1002 + testnum*5 + node*3, 4096 )
12075 iseed(i*4+2) = mod( 2027 + testnum*7 + node, 4096 )
12076 iseed(i*4+3) = mod( 1234 + testnum + node*3, 4096 )
12077 iseed(i*4+4) = mod( 4311 + testnum*10 + node*2, 4096 )
12078 20 CONTINUE
12079 ELSE
12080 nnodes = nprow * npcol
12081 DO 30 i = 0, nnodes-1
12082 node = (i / npcol) * nprocs + mod(i, npcol)
12083 iseed(i*4+1) = mod( 1002 + testnum*5 + node*3, 4096 )
12084 iseed(i*4+2) = mod( 2027 + testnum*7 + node, 4096 )
12085 iseed(i*4+3) = mod( 1234 + testnum + node*3, 4096 )
12086 iseed(i*4+4) = mod( 4311 + testnum*10 + node*2, 4096 )
12087 30 CONTINUE
12088 END IF
12089
12090 DO 100 j = 1, n
12091 DO 90 i = 1, m
12092 ans = 0
12093 DO 40 k = 0, nnodes-1
12094 ans = ans +
ibtran( iseed(k*4+1) )
12095 40 CONTINUE
12096
12097
12098
12099
12100
12101
12102
12103
12104 IF( ans .NE. a(i,j) ) THEN
12105 nerr = nerr + 1
12106 IF( nerr .LE. maxerr ) THEN
12107 erribuf(1, nerr) = testnum
12108 erribuf(2, nerr) = nnodes
12109 erribuf(3, nerr) = dest
12110 erribuf(4, nerr) = i
12111 erribuf(5, nerr) = j
12112 erribuf(6, nerr) = 5
12113 errdbuf(1, nerr) = a(i,j)
12114 errdbuf(2, nerr) = ans
12115 END IF
12116 END IF
12117 90 CONTINUE
12118 100 CONTINUE
12119
12120 RETURN
12121
12122
12123
integer function ibtran(iseed)
integer function ibtnprocs()
integer function ibtmyproc()