117 SUBROUTINE dort01( ROWCOL, M, N, U, LDU, WORK, LWORK, RESID )
126 INTEGER ldu, lwork, m, n
127 DOUBLE PRECISION resid
130 DOUBLE PRECISION u( ldu, * ), work( * )
136 DOUBLE PRECISION zero, one
137 parameter( zero = 0.0d+0, one = 1.0d+0 )
141 INTEGER i,
j, k, ldwork, mnmin
142 DOUBLE PRECISION eps, tmp
153 INTRINSIC abs, dble, max, min
161 IF( m.LE.0 .OR. n.LE.0 )
164 eps =
dlamch(
'Precision' )
165 IF( m.LT.n .OR. ( m.EQ.n .AND.
lsame( rowcol,
'R' ) ) )
THEN
174 IF( ( mnmin+1 )*mnmin.LE.lwork )
THEN
179 IF( ldwork.GT.0 )
THEN
183 CALL
dlaset(
'Upper', mnmin, mnmin, zero, one, work, ldwork )
184 CALL
dsyrk(
'Upper', transu, mnmin, k, -one, u, ldu, one, work,
189 resid =
dlansy(
'1',
'Upper', mnmin, work, ldwork,
190 $ work( ldwork*mnmin+1 ) )
191 resid = ( resid / dble( k ) ) / eps
192 ELSE IF( transu.EQ.
'T' )
THEN
203 tmp = tmp -
ddot( m, u( 1, i ), 1, u( 1,
j ), 1 )
204 resid = max( resid, abs( tmp ) )
207 resid = ( resid / dble( m ) ) / eps
219 tmp = tmp -
ddot( n, u(
j, 1 ), ldu, u( i, 1 ), ldu )
220 resid = max( resid, abs( tmp ) )
223 resid = ( resid / dble( n ) ) / eps
LOGICAL function lsame(CA, CB)
LSAME
DOUBLE PRECISION function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
DSYRK
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
DOUBLE PRECISION function ddot(N, DX, INCX, DY, INCY)
DDOT
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
DORT01