Skip to content

Commit 9343499

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #3833 from martin-frbg/lapack712+747
Set scale early in ?LATBS/?LATRS and fix documentation of ?LASCL2 (Reference-LAPACK PRs 712+747)
2 parents 1d5a3af + e00f0fb commit 9343499

File tree

16 files changed

+319
-81
lines changed

16 files changed

+319
-81
lines changed

‎lapack-netlib/SRC/clarscl2.f

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
*> \brief \b CLARSCL2 performs reciprocal diagonal scaling on a vector.
1+
*> \brief \b CLARSCL2 performs reciprocal diagonal scaling on a matrix.
22
*
33
* =========== DOCUMENTATION ===========
44
*
@@ -34,7 +34,7 @@
3434
*>
3535
*> \verbatim
3636
*>
37-
*> CLARSCL2 performs a reciprocal diagonal scaling on an vector:
37+
*> CLARSCL2 performs a reciprocal diagonal scaling on a matrix:
3838
*> x <-- inv(D) * x
3939
*> where the REAL diagonal matrix D is stored as a vector.
4040
*>
@@ -66,14 +66,14 @@
6666
*> \param[in,out] X
6767
*> \verbatim
6868
*> X is COMPLEX array, dimension (LDX,N)
69-
*> On entry, the vector X to be scaled by D.
70-
*> On exit, the scaled vector.
69+
*> On entry, the matrix X to be scaled by D.
70+
*> On exit, the scaled matrix.
7171
*> \endverbatim
7272
*>
7373
*> \param[in] LDX
7474
*> \verbatim
7575
*> LDX is INTEGER
76-
*> The leading dimension of the vector X. LDX >= M.
76+
*> The leading dimension of the matrix X. LDX >= M.
7777
*> \endverbatim
7878
*
7979
* Authors:

‎lapack-netlib/SRC/clascl2.f

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
*> \brief \b CLASCL2 performs diagonal scaling on a vector.
1+
*> \brief \b CLASCL2 performs diagonal scaling on a matrix.
22
*
33
* =========== DOCUMENTATION ===========
44
*
@@ -34,9 +34,9 @@
3434
*>
3535
*> \verbatim
3636
*>
37-
*> CLASCL2 performs a diagonal scaling on a vector:
37+
*> CLASCL2 performs a diagonal scaling on a matrix:
3838
*> x <-- D * x
39-
*> where the diagonal REAL matrix D is stored as a vector.
39+
*> where the diagonal REAL matrix D is stored as a matrix.
4040
*>
4141
*> Eventually to be replaced by BLAS_cge_diag_scale in the new BLAS
4242
*> standard.
@@ -66,14 +66,14 @@
6666
*> \param[in,out] X
6767
*> \verbatim
6868
*> X is COMPLEX array, dimension (LDX,N)
69-
*> On entry, the vector X to be scaled by D.
70-
*> On exit, the scaled vector.
69+
*> On entry, the matrix X to be scaled by D.
70+
*> On exit, the scaled matrix.
7171
*> \endverbatim
7272
*>
7373
*> \param[in] LDX
7474
*> \verbatim
7575
*> LDX is INTEGER
76-
*> The leading dimension of the vector X. LDX >= M.
76+
*> The leading dimension of the matrix X. LDX >= M.
7777
*> \endverbatim
7878
*
7979
* Authors:

‎lapack-netlib/SRC/clatbs.f

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -278,7 +278,7 @@ SUBROUTINE CLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
278278
$ CDOTU, CLADIV
279279
* ..
280280
* .. External Subroutines ..
281-
EXTERNAL CAXPY, CSSCAL, CTBSV, SLABAD, SSCAL, XERBLA
281+
EXTERNAL CAXPY, CSSCAL, CTBSV, SSCAL, XERBLA
282282
* ..
283283
* .. Intrinsic Functions ..
284284
INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL
@@ -324,17 +324,14 @@ SUBROUTINE CLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
324324
*
325325
* Quick return if possible
326326
*
327+
SCALE = ONE
327328
IF( N.EQ.0 )
328329
$ RETURN
329330
*
330331
* Determine machine dependent parameters to control overflow.
331332
*
332-
SMLNUM = SLAMCH( 'Safe minimum' )
333-
BIGNUM = ONE / SMLNUM
334-
CALL SLABAD( SMLNUM, BIGNUM )
335-
SMLNUM = SMLNUM / SLAMCH( 'Precision' )
333+
SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
336334
BIGNUM = ONE / SMLNUM
337-
SCALE = ONE
338335
*
339336
IF( LSAME( NORMIN, 'N' ) ) THEN
340337
*

‎lapack-netlib/SRC/clatrs.f

Lines changed: 71 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -274,7 +274,7 @@ SUBROUTINE CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
274274
$ CDOTU, CLADIV
275275
* ..
276276
* .. External Subroutines ..
277-
EXTERNAL CAXPY, CSSCAL, CTRSV, SLABAD, SSCAL, XERBLA
277+
EXTERNAL CAXPY, CSSCAL, CTRSV, SSCAL, XERBLA
278278
* ..
279279
* .. Intrinsic Functions ..
280280
INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL
@@ -318,17 +318,14 @@ SUBROUTINE CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
318318
*
319319
* Quick return if possible
320320
*
321+
SCALE = ONE
321322
IF( N.EQ.0 )
322323
$ RETURN
323324
*
324325
* Determine machine dependent parameters to control overflow.
325326
*
326-
SMLNUM = SLAMCH( 'Safe minimum' )
327-
BIGNUM = ONE / SMLNUM
328-
CALL SLABAD( SMLNUM, BIGNUM )
329-
SMLNUM = SMLNUM / SLAMCH( 'Precision' )
327+
SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
330328
BIGNUM = ONE / SMLNUM
331-
SCALE = ONE
332329
*
333330
IF( LSAME( NORMIN, 'N' ) ) THEN
334331
*
@@ -360,8 +357,74 @@ SUBROUTINE CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
360357
IF( TMAX.LE.BIGNUM*HALF ) THEN
361358
TSCAL = ONE
362359
ELSE
363-
TSCAL = HALF / ( SMLNUM*TMAX )
364-
CALL SSCAL( N, TSCAL, CNORM, 1 )
360+
*
361+
* Avoid NaN generation if entries in CNORM exceed the
362+
* overflow threshold
363+
*
364+
IF ( TMAX.LE.SLAMCH('Overflow') ) THEN
365+
* Case 1: All entries in CNORM are valid floating-point numbers
366+
TSCAL = HALF / ( SMLNUM*TMAX )
367+
CALL SSCAL( N, TSCAL, CNORM, 1 )
368+
ELSE
369+
* Case 2: At least one column norm of A cannot be
370+
* represented as a floating-point number. Find the
371+
* maximum offdiagonal absolute value
372+
* max( |Re(A(I,J))|, |Im(A(I,J)| ). If this entry is
373+
* not +/- Infinity, use this value as TSCAL.
374+
TMAX = ZERO
375+
IF( UPPER ) THEN
376+
*
377+
* A is upper triangular.
378+
*
379+
DO J = 2, N
380+
DO I = 1, J - 1
381+
TMAX = MAX( TMAX, ABS( REAL( A( I, J ) ) ),
382+
$ ABS( AIMAG(A ( I, J ) ) ) )
383+
END DO
384+
END DO
385+
ELSE
386+
*
387+
* A is lower triangular.
388+
*
389+
DO J = 1, N - 1
390+
DO I = J + 1, N
391+
TMAX = MAX( TMAX, ABS( REAL( A( I, J ) ) ),
392+
$ ABS( AIMAG(A ( I, J ) ) ) )
393+
END DO
394+
END DO
395+
END IF
396+
*
397+
IF( TMAX.LE.SLAMCH('Overflow') ) THEN
398+
TSCAL = ONE / ( SMLNUM*TMAX )
399+
DO J = 1, N
400+
IF( CNORM( J ).LE.SLAMCH('Overflow') ) THEN
401+
CNORM( J ) = CNORM( J )*TSCAL
402+
ELSE
403+
* Recompute the 1-norm of each column without
404+
* introducing Infinity in the summation.
405+
TSCAL = TWO * TSCAL
406+
CNORM( J ) = ZERO
407+
IF( UPPER ) THEN
408+
DO I = 1, J - 1
409+
CNORM( J ) = CNORM( J ) +
410+
$ TSCAL * CABS2( A( I, J ) )
411+
END DO
412+
ELSE
413+
DO I = J + 1, N
414+
CNORM( J ) = CNORM( J ) +
415+
$ TSCAL * CABS2( A( I, J ) )
416+
END DO
417+
END IF
418+
TSCAL = TSCAL * HALF
419+
END IF
420+
END DO
421+
ELSE
422+
* At least one entry of A is not a valid floating-point
423+
* entry. Rely on TRSV to propagate Inf and NaN.
424+
CALL CTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
425+
RETURN
426+
END IF
427+
END IF
365428
END IF
366429
*
367430
* Compute a bound on the computed solution vector to see if the

‎lapack-netlib/SRC/dlarscl2.f

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
*> \brief \b DLARSCL2 performs reciprocal diagonal scaling on a vector.
1+
*> \brief \b DLARSCL2 performs reciprocal diagonal scaling on a matrix.
22
*
33
* =========== DOCUMENTATION ===========
44
*
@@ -33,7 +33,7 @@
3333
*>
3434
*> \verbatim
3535
*>
36-
*> DLARSCL2 performs a reciprocal diagonal scaling on an vector:
36+
*> DLARSCL2 performs a reciprocal diagonal scaling on a matrix:
3737
*> x <-- inv(D) * x
3838
*> where the diagonal matrix D is stored as a vector.
3939
*>
@@ -65,14 +65,14 @@
6565
*> \param[in,out] X
6666
*> \verbatim
6767
*> X is DOUBLE PRECISION array, dimension (LDX,N)
68-
*> On entry, the vector X to be scaled by D.
69-
*> On exit, the scaled vector.
68+
*> On entry, the matrix X to be scaled by D.
69+
*> On exit, the scaled matrix.
7070
*> \endverbatim
7171
*>
7272
*> \param[in] LDX
7373
*> \verbatim
7474
*> LDX is INTEGER
75-
*> The leading dimension of the vector X. LDX >= M.
75+
*> The leading dimension of the matrix X. LDX >= M.
7676
*> \endverbatim
7777
*
7878
* Authors:

‎lapack-netlib/SRC/dlascl2.f

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
*> \brief \b DLASCL2 performs diagonal scaling on a vector.
1+
*> \brief \b DLASCL2 performs diagonal scaling on a matrix.
22
*
33
* =========== DOCUMENTATION ===========
44
*
@@ -33,7 +33,7 @@
3333
*>
3434
*> \verbatim
3535
*>
36-
*> DLASCL2 performs a diagonal scaling on a vector:
36+
*> DLASCL2 performs a diagonal scaling on a matrix:
3737
*> x <-- D * x
3838
*> where the diagonal matrix D is stored as a vector.
3939
*>
@@ -65,14 +65,14 @@
6565
*> \param[in,out] X
6666
*> \verbatim
6767
*> X is DOUBLE PRECISION array, dimension (LDX,N)
68-
*> On entry, the vector X to be scaled by D.
69-
*> On exit, the scaled vector.
68+
*> On entry, the matrix X to be scaled by D.
69+
*> On exit, the scaled matrix.
7070
*> \endverbatim
7171
*>
7272
*> \param[in] LDX
7373
*> \verbatim
7474
*> LDX is INTEGER
75-
*> The leading dimension of the vector X. LDX >= M.
75+
*> The leading dimension of the matrix X. LDX >= M.
7676
*> \endverbatim
7777
*
7878
* Authors:

‎lapack-netlib/SRC/dlatbs.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -310,14 +310,14 @@ SUBROUTINE DLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
310310
*
311311
* Quick return if possible
312312
*
313+
SCALE = ONE
313314
IF( N.EQ.0 )
314315
$ RETURN
315316
*
316317
* Determine machine dependent parameters to control overflow.
317318
*
318319
SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
319320
BIGNUM = ONE / SMLNUM
320-
SCALE = ONE
321321
*
322322
IF( LSAME( NORMIN, 'N' ) ) THEN
323323
*

‎lapack-netlib/SRC/dlatrs.f

Lines changed: 64 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -264,8 +264,8 @@ SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
264264
* .. External Functions ..
265265
LOGICAL LSAME
266266
INTEGER IDAMAX
267-
DOUBLE PRECISION DASUM, DDOT, DLAMCH
268-
EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH
267+
DOUBLE PRECISION DASUM, DDOT, DLAMCH, DLANGE
268+
EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH, DLANGE
269269
* ..
270270
* .. External Subroutines ..
271271
EXTERNAL DAXPY, DSCAL, DTRSV, XERBLA
@@ -304,14 +304,14 @@ SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
304304
*
305305
* Quick return if possible
306306
*
307+
SCALE = ONE
307308
IF( N.EQ.0 )
308309
$ RETURN
309310
*
310311
* Determine machine dependent parameters to control overflow.
311312
*
312313
SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
313314
BIGNUM = ONE / SMLNUM
314-
SCALE = ONE
315315
*
316316
IF( LSAME( NORMIN, 'N' ) ) THEN
317317
*
@@ -343,8 +343,67 @@ SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
343343
IF( TMAX.LE.BIGNUM ) THEN
344344
TSCAL = ONE
345345
ELSE
346-
TSCAL = ONE / ( SMLNUM*TMAX )
347-
CALL DSCAL( N, TSCAL, CNORM, 1 )
346+
*
347+
* Avoid NaN generation if entries in CNORM exceed the
348+
* overflow threshold
349+
*
350+
IF( TMAX.LE.DLAMCH('Overflow') ) THEN
351+
* Case 1: All entries in CNORM are valid floating-point numbers
352+
TSCAL = ONE / ( SMLNUM*TMAX )
353+
CALL DSCAL( N, TSCAL, CNORM, 1 )
354+
ELSE
355+
* Case 2: At least one column norm of A cannot be represented
356+
* as floating-point number. Find the offdiagonal entry A( I, J )
357+
* with the largest absolute value. If this entry is not +/- Infinity,
358+
* use this value as TSCAL.
359+
TMAX = ZERO
360+
IF( UPPER ) THEN
361+
*
362+
* A is upper triangular.
363+
*
364+
DO J = 2, N
365+
TMAX = MAX( DLANGE( 'M', J-1, 1, A( 1, J ), 1, SUMJ ),
366+
$ TMAX )
367+
END DO
368+
ELSE
369+
*
370+
* A is lower triangular.
371+
*
372+
DO J = 1, N - 1
373+
TMAX = MAX( DLANGE( 'M', N-J, 1, A( J+1, J ), 1,
374+
$ SUMJ ), TMAX )
375+
END DO
376+
END IF
377+
*
378+
IF( TMAX.LE.DLAMCH('Overflow') ) THEN
379+
TSCAL = ONE / ( SMLNUM*TMAX )
380+
DO J = 1, N
381+
IF( CNORM( J ).LE.DLAMCH('Overflow') ) THEN
382+
CNORM( J ) = CNORM( J )*TSCAL
383+
ELSE
384+
* Recompute the 1-norm without introducing Infinity
385+
* in the summation
386+
CNORM( J ) = ZERO
387+
IF( UPPER ) THEN
388+
DO I = 1, J - 1
389+
CNORM( J ) = CNORM( J ) +
390+
$ TSCAL * ABS( A( I, J ) )
391+
END DO
392+
ELSE
393+
DO I = J + 1, N
394+
CNORM( J ) = CNORM( J ) +
395+
$ TSCAL * ABS( A( I, J ) )
396+
END DO
397+
END IF
398+
END IF
399+
END DO
400+
ELSE
401+
* At least one entry of A is not a valid floating-point entry.
402+
* Rely on TRSV to propagate Inf and NaN.
403+
CALL DTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
404+
RETURN
405+
END IF
406+
END IF
348407
END IF
349408
*
350409
* Compute a bound on the computed solution vector to see if the

0 commit comments

Comments
 (0)