rpl/lapack/lapack/dlange.f - diff

Return to dlange.f CVS log

Up to [local] / rpl / lapack / lapack

version 1.17, 2018/05/29 07:17:57	version 1.18, 2020/05/21 21:45:59
Line 119	Line 119
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--	* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016	* December 2016
*	*
	IMPLICIT NONE
* .. Scalar Arguments ..	* .. Scalar Arguments ..
CHARACTER NORM	CHARACTER NORM
INTEGER LDA, M, N	INTEGER LDA, M, N
Line 135	Line 136
* ..	* ..
* .. Local Scalars ..	* .. Local Scalars ..
INTEGER I, J	INTEGER I, J
DOUBLE PRECISION SCALE, SUM, VALUE, TEMP	DOUBLE PRECISION SUM, VALUE, TEMP
	* ..
	* .. Local Arrays ..
	DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 )
* ..	* ..
* .. External Subroutines ..	* .. External Subroutines ..
EXTERNAL DLASSQ	EXTERNAL DLASSQ, DCOMBSSQ
* ..	* ..
* .. External Functions ..	* .. External Functions ..
LOGICAL LSAME, DISNAN	LOGICAL LSAME, DISNAN
Line 194	Line 198
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN	ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
*	*
* Find normF(A).	* Find normF(A).
	* SSQ(1) is scale
	* SSQ(2) is sum-of-squares
	* For better accuracy, sum each column separately.
*	*
SCALE = ZERO	SSQ( 1 ) = ZERO
SUM = ONE	SSQ( 2 ) = ONE
DO 90 J = 1, N	DO 90 J = 1, N
CALL DLASSQ( M, A( 1, J ), 1, SCALE, SUM )	COLSSQ( 1 ) = ZERO
	COLSSQ( 2 ) = ONE
	CALL DLASSQ( M, A( 1, J ), 1, COLSSQ( 1 ), COLSSQ( 2 ) )
	CALL DCOMBSSQ( SSQ, COLSSQ )
90 CONTINUE	90 CONTINUE
VALUE = SCALE*SQRT( SUM )	VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF	END IF
*	*
DLANGE = VALUE	DLANGE = VALUE