1 SUBROUTINE psqrt16( TRANS, M, N, NRHS, A, IA, JA, DESCA, X, IX,
2 $ JX, DESCX, B, IB, JB, DESCB, RWORK, RESID )
11 INTEGER IA, IB, IX, JA, JB, JX, M, N, NRHS
15 INTEGER DESCA( * ), DESCB( * ), DESCX( * )
16 REAL A( * ), B( * ), RWORK( * ), X( * )
180 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
181 $ lld_, mb_, m_, nb_, n_, rsrc_
182 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
183 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
184 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
186 parameter( zero = 0.0e+0, one = 1.0e+0 )
189 INTEGER ICTXT, IDUMM, J, MYCOL, MYROW, N1, N2, NPCOL,
191 REAL ANORM, BNORM, EPS, XNORM
198 REAL PSLAMCH, PSLANGE
199 EXTERNAL lsame, pslamch, pslange
202 EXTERNAL blacs_gridinfo, psasum, psgemm, sgamx2d
211 ictxt = desca( ctxt_ )
212 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
216 IF( m.LE.0 .OR. n.LE.0 .OR. nrhs.EQ.0 )
THEN
221 IF( lsame( trans,
'T' ) .OR. lsame( trans,
'C' ) )
THEN
222 anorm = pslange(
'I', m, n, a, ia, ja, desca, rwork )
226 anorm = pslange(
'1', m, n, a, ia, ja, desca, rwork )
231 eps = pslamch( ictxt,
'Epsilon' )
236 CALL psgemm( trans,
'No transpose', n1, nrhs, n2, -one, a, ia,
237 $ ja, desca, x, ix, jx, descx, one, b, ib, jb, descb )
246 CALL psasum( n1, bnorm, b, ib, jb+j-1, descb, 1 )
247 CALL psasum( n2, xnorm, x, ix, jx+j-1, descx, 1 )
255 CALL sgamx2d( ictxt,
'All',
' ', 2, 1, temp, 2, idumm, idumm,
262 IF( anorm.EQ.zero .AND. bnorm.EQ.zero )
THEN
264 ELSE IF( anorm.LE.zero .OR. xnorm.LE.zero )
THEN
267 resid =
max( resid, ( ( bnorm / anorm ) / xnorm ) /
268 $ (
max( m, n )*eps ) )