rpl/lapack/lapack/dlantp.f - diff

Return to dlantp.f CVS log

Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/dlantp.f between versions 1.11 and 1.18

version 1.11, 2012/12/14 12:30:23	version 1.18, 2020/05/21 21:45:59
Line 2	Line 2
*	*
* =========== DOCUMENTATION ===========	* =========== DOCUMENTATION ===========
*	*
* Online html documentation available at	* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/	* http://www.netlib.org/lapack/explore-html/
*	*
*> \htmlonly	*> \htmlonly
*> Download DLANTP + dependencies	*> Download DLANTP + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlantp.f">	*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlantp.f">
*> [TGZ]</a>	*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlantp.f">	*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlantp.f">
*> [ZIP]</a>	*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlantp.f">	*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlantp.f">
*> [TXT]</a>	*> [TXT]</a>
*> \endhtmlonly	*> \endhtmlonly
*	*
* Definition:	* Definition:
* ===========	* ===========
*	*
* DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK )	* DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK )
*	*
* .. Scalar Arguments ..	* .. Scalar Arguments ..
* CHARACTER DIAG, NORM, UPLO	* CHARACTER DIAG, NORM, UPLO
* INTEGER N	* INTEGER N
Line 27	Line 27
* .. Array Arguments ..	* .. Array Arguments ..
* DOUBLE PRECISION AP( * ), WORK( * )	* DOUBLE PRECISION AP( * ), WORK( * )
* ..	* ..
*	*
*	*
*> \par Purpose:	*> \par Purpose:
* =============	* =============
Line 112	Line 112
* Authors:	* Authors:
* ========	* ========
*	*
*> \author Univ. of Tennessee	*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley	*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver	*> \author Univ. of Colorado Denver
*> \author NAG Ltd.	*> \author NAG Ltd.
*	*
*> \date September 2012	*> \date December 2016
*	*
*> \ingroup doubleOTHERauxiliary	*> \ingroup doubleOTHERauxiliary
*	*
* =====================================================================	* =====================================================================
DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK )	DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK )
*	*
* -- LAPACK auxiliary routine (version 3.4.2) --	* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --	* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--	* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012	* December 2016
*	*
	IMPLICIT NONE
* .. Scalar Arguments ..	* .. Scalar Arguments ..
CHARACTER DIAG, NORM, UPLO	CHARACTER DIAG, NORM, UPLO
INTEGER N	INTEGER N
Line 146	Line 147
* .. Local Scalars ..	* .. Local Scalars ..
LOGICAL UDIAG	LOGICAL UDIAG
INTEGER I, J, K	INTEGER I, J, K
DOUBLE PRECISION SCALE, SUM, VALUE	DOUBLE PRECISION SUM, VALUE
* ..	* ..
* .. External Subroutines ..	* .. Local Arrays ..
EXTERNAL DLASSQ	DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 )
* ..	* ..
* .. External Functions ..	* .. External Functions ..
LOGICAL LSAME, DISNAN	LOGICAL LSAME, DISNAN
EXTERNAL LSAME, DISNAN	EXTERNAL LSAME, DISNAN
* ..	* ..
	* .. External Subroutines ..
	EXTERNAL DLASSQ, DCOMBSSQ
	* ..
* .. Intrinsic Functions ..	* .. Intrinsic Functions ..
INTRINSIC ABS, SQRT	INTRINSIC ABS, SQRT
* ..	* ..
Line 306	Line 310
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.
*	*
IF( LSAME( UPLO, 'U' ) ) THEN	IF( LSAME( UPLO, 'U' ) ) THEN
IF( LSAME( DIAG, 'U' ) ) THEN	IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE	SSQ( 1 ) = ONE
SUM = N	SSQ( 2 ) = N
K = 2	K = 2
DO 280 J = 2, N	DO 280 J = 2, N
CALL DLASSQ( J-1, AP( K ), 1, SCALE, SUM )	COLSSQ( 1 ) = ZERO
	COLSSQ( 2 ) = ONE
	CALL DLASSQ( J-1, AP( K ), 1,
	$ COLSSQ( 1 ), COLSSQ( 2 ) )
	CALL DCOMBSSQ( SSQ, COLSSQ )
K = K + J	K = K + J
280 CONTINUE	280 CONTINUE
ELSE	ELSE
SCALE = ZERO	SSQ( 1 ) = ZERO
SUM = ONE	SSQ( 2 ) = ONE
K = 1	K = 1
DO 290 J = 1, N	DO 290 J = 1, N
CALL DLASSQ( J, AP( K ), 1, SCALE, SUM )	COLSSQ( 1 ) = ZERO
	COLSSQ( 2 ) = ONE
	CALL DLASSQ( J, AP( K ), 1,
	$ COLSSQ( 1 ), COLSSQ( 2 ) )
	CALL DCOMBSSQ( SSQ, COLSSQ )
K = K + J	K = K + J
290 CONTINUE	290 CONTINUE
END IF	END IF
ELSE	ELSE
IF( LSAME( DIAG, 'U' ) ) THEN	IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE	SSQ( 1 ) = ONE
SUM = N	SSQ( 2 ) = N
K = 2	K = 2
DO 300 J = 1, N - 1	DO 300 J = 1, N - 1
CALL DLASSQ( N-J, AP( K ), 1, SCALE, SUM )	COLSSQ( 1 ) = ZERO
	COLSSQ( 2 ) = ONE
	CALL DLASSQ( N-J, AP( K ), 1,
	$ COLSSQ( 1 ), COLSSQ( 2 ) )
	CALL DCOMBSSQ( SSQ, COLSSQ )
K = K + N - J + 1	K = K + N - J + 1
300 CONTINUE	300 CONTINUE
ELSE	ELSE
SCALE = ZERO	SSQ( 1 ) = ZERO
SUM = ONE	SSQ( 2 ) = ONE
K = 1	K = 1
DO 310 J = 1, N	DO 310 J = 1, N
CALL DLASSQ( N-J+1, AP( K ), 1, SCALE, SUM )	COLSSQ( 1 ) = ZERO
	COLSSQ( 2 ) = ONE
	CALL DLASSQ( N-J+1, AP( K ), 1,
	$ COLSSQ( 1 ), COLSSQ( 2 ) )
	CALL DCOMBSSQ( SSQ, COLSSQ )
K = K + N - J + 1	K = K + N - J + 1
310 CONTINUE	310 CONTINUE
END IF	END IF
END IF	END IF
VALUE = SCALE*SQRT( SUM )	VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF	END IF
*	*
DLANTP = VALUE	DLANTP = VALUE

CVSweb interface <joel.bertrand@systella.fr>

Removed from v.1.11
changed lines
	Added in v.1.18