Merge pull request #5850 from martin-frbg/lapack1271

Update EXTERNAL declarations in various files (Reference-LAPACK PR 1271)
This commit is contained in:
Martin Kroeker
2026-06-24 10:36:37 +02:00
committed by GitHub
7 changed files with 55 additions and 39 deletions
+1 -1
View File
@@ -168,7 +168,7 @@
DOUBLE PRECISION TEMP, TEMP2, TOL3Z
* ..
* .. External Subroutines ..
EXTERNAL DLARF, DLARFG, DSWAP
EXTERNAL DLARF1F, DLARFG, DSWAP
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, SQRT
+8 -4
View File
@@ -40,7 +40,7 @@
*> \param[in] MB
*> \verbatim
*> MB is INTEGER
*> The block size to be used in the blocked QR. MIN(M,N) >= MB >= 1.
*> The block size to be used in the blocked LQ. MIN(M,N) >= MB >= 1.
*> \endverbatim
*>
*> \param[in,out] A
@@ -75,7 +75,10 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is REAL array, dimension (MB*N)
*> WORK is REAL array, dimension (MB*M).
*> Note: A smaller workspace of MB*(M-MB) may also be sufficient, but
*> that is yet to be proven. MB*M is a conservative estimate and the
*> recommended value to use.
*> \endverbatim
*>
*> \param[out] INFO
@@ -101,7 +104,7 @@
*> \verbatim
*>
*> The matrix V stores the elementary reflectors H(i) in the i-th row
*> above the diagonal. For example, if M=5 and N=3, the matrix V is
*> above the diagonal. For example, if M=3 and N=5, the matrix V is
*>
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
@@ -121,6 +124,7 @@
*>
* =====================================================================
SUBROUTINE SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
IMPLICIT NONE
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -140,7 +144,7 @@
INTEGER I, IB, IINFO, K
* ..
* .. External Subroutines ..
EXTERNAL SGEQRT2, SGEQRT3, SGELQT3, SLARFB, XERBLA
EXTERNAL SGELQT3, SLARFB, XERBLA
* ..
* .. Executable Statements ..
*
+28 -15
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SGGES + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgges.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgges.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -278,9 +276,11 @@
*> \ingroup gges
*
* =====================================================================
SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB,
SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B,
$ LDB,
$ SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR,
$ LDVSR, WORK, LWORK, BWORK, INFO )
IMPLICIT NONE
*
* -- LAPACK driver routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -297,8 +297,12 @@
$ VSR( LDVSR, * ), WORK( * )
* ..
* .. Function Arguments ..
LOGICAL SELCTG
EXTERNAL SELCTG
INTERFACE
LOGICAL FUNCTION SELCTG_PROC_TYPE(ALPHAR, ALPHAI, BETA)
REAL ALPHAR, ALPHAI, BETA
END FUNCTION SELCTG_PROC_TYPE
END INTERFACE
PROCEDURE(SELCTG_PROC_TYPE) :: SELCTG
* ..
*
* =====================================================================
@@ -321,14 +325,16 @@
REAL DIF( 2 )
* ..
* .. External Subroutines ..
EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY,
$ SLASCL, SLASET, SORGQR, SORMQR, STGSEN
EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ,
$ SLACPY,
$ SLASCL, SLASET, SORGQR, SORMQR, STGSEN, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV
REAL SLAMCH, SLANGE, SROUNDUP_LWORK
EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK
EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE,
$ SROUNDUP_LWORK
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, SQRT
@@ -369,7 +375,8 @@
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
INFO = -2
ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
ELSE IF( ( .NOT.WANTST ) .AND.
$ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
INFO = -3
ELSE IF( N.LT.0 ) THEN
INFO = -5
@@ -399,7 +406,8 @@
$ N*ILAENV( 1, 'SORMQR', ' ', N, 1, N, -1 ) )
IF( ILVSL ) THEN
MAXWRK = MAX( MAXWRK, MINWRK - N +
$ N*ILAENV( 1, 'SORGQR', ' ', N, 1, N, -1 ) )
$ N*ILAENV( 1, 'SORGQR', ' ', N, 1, N,
$ -1 ) )
END IF
ELSE
MINWRK = 1
@@ -544,15 +552,18 @@
$ IERR )
END IF
IF( ILBSCL )
$ CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
$ CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N,
$ IERR )
*
* Select eigenvalues
*
DO 10 I = 1, N
BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ),
$ BETA( I ) )
10 CONTINUE
*
CALL STGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHAR,
CALL STGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB,
$ ALPHAR,
$ ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL,
$ PVSR, DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1,
$ IERR )
@@ -614,8 +625,10 @@
*
IF( ILASCL ) THEN
CALL SLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR )
CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N,
$ IERR )
CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N,
$ IERR )
END IF
*
IF( ILBSCL ) THEN
+1 -1
View File
@@ -311,7 +311,7 @@
* .. External Subroutines ..
EXTERNAL SCOPY, SGEHRD, SGEMM, SLACPY,
$ SLAHQR,
$ SLANV2, SLARF1L, SLARFG, SLASET, SORMHR,
$ SLANV2, SLARF1F, SLARFG, SLASET, SORMHR,
$ STREXC
* ..
* .. Intrinsic Functions ..
+6 -5
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZHETRF_AA + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrf_aa.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrf_aa.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -130,7 +128,8 @@
*> \ingroup hetrf_aa
*
* =====================================================================
SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV,
$ WORK, LWORK, INFO )
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -164,7 +163,8 @@
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
EXTERNAL ZLAHEF_AA, ZGEMM, ZGEMV, ZCOPY, ZSCAL, ZSWAP, XERBLA
EXTERNAL ZLAHEF_AA, ZGEMM, ZCOPY, ZSCAL, ZSWAP,
$ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE, DCONJG, MAX
@@ -438,7 +438,8 @@
*
J3 = J2
DO MJ = NJ-1, 1, -1
CALL ZGEMM( 'No transpose', 'Conjugate transpose',
CALL ZGEMM( 'No transpose',
$ 'Conjugate transpose',
$ MJ, 1, JB+1,
$ -ONE, WORK( (J3-J1+1)+K1*N ), N,
$ A( J3, J1-K2 ), LDA,
+3 -5
View File
@@ -5,7 +5,6 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZLAHEF_AA + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlahef_aa.f">
*> [TGZ]</a>
@@ -13,7 +12,6 @@
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlahef_aa.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -136,7 +134,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEcomputational
*> \ingroup lahef_aa
*
* =====================================================================
SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
@@ -172,8 +170,8 @@
EXTERNAL LSAME, ILAENV, IZAMAX
* ..
* .. External Subroutines ..
EXTERNAL ZGEMM, ZGEMV, ZAXPY, ZLACGV, ZCOPY, ZSCAL, ZSWAP,
$ ZLASET, XERBLA
EXTERNAL ZGEMV, ZAXPY, ZLACGV, ZCOPY, ZSCAL,
$ ZSWAP, ZLASET, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE, DCONJG, MAX
+8 -8
View File
@@ -1,19 +1,17 @@
*> \brief \b ZDRSCL multiplies a vector by the reciprocal of a real scalar.
*> \brief \b ZRSCL multiplies a vector by the reciprocal of a complex scalar.
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZDRSCL + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zdrscl.f">
*> Download ZRSCL + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zrscl.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zdrscl.f">
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zrscl.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zdrscl.f">
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zrscl.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
@@ -81,6 +79,7 @@
*
* =====================================================================
SUBROUTINE ZRSCL( N, A, X, INCX )
IMPLICIT NONE
*
* -- LAPACK auxiliary routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -170,7 +169,8 @@
ELSE IF( (ABS( UR ).GT.SAFMAX).OR.(ABS( UI ).GT.SAFMAX) ) THEN
IF( (ABSR.GT.OV).OR.(ABSI.GT.OV) ) THEN
* This means that a and b are both Inf. No need for scaling.
CALL ZSCAL( N, DCMPLX( ONE / UR, -ONE / UI ), X, INCX )
CALL ZSCAL( N, DCMPLX( ONE / UR, -ONE / UI ), X,
$ INCX )
ELSE
CALL ZDSCAL( N, SAFMIN, X, INCX )
IF( (ABS( UR ).GT.OV).OR.(ABS( UI ).GT.OV) ) THEN