jianmu
/
lammps
forked from lijiext/lammps
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

linalg: update to netlib lapack-3.7.1

This commit is contained in:
Christoph Junghans 2018-05-18 15:17:13 -06:00
parent 858c211fdc
commit 2e7b919774
171 changed files with 5320 additions and 4660 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
cmake/CMakeLists.txt
View File

@ -203,7 +203,7 @@ if(PKG_MSCG OR PKG_USER-ATC OR PKG_USER-AWPMD OR PKG_USER-QUIP OR PKG_LATTE)
find_package(LAPACK)
if(NOT LAPACK_FOUND)
enable_language(Fortran)
file(GLOB LAPACK_SOURCES ${LAMMPS_LIB_SOURCE_DIR}/linalg/*.f)
file(GLOB LAPACK_SOURCES ${LAMMPS_LIB_SOURCE_DIR}/linalg/*.[fF])
add_library(linalg STATIC ${LAPACK_SOURCES})
set(LAPACK_LIBRARIES linalg)
endif()

26
lib/linalg/dasum.f
View File

@ -26,6 +26,26 @@
*> DASUM takes the sum of the absolute values.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in] DX
*> \verbatim
*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of DX
*> \endverbatim
*
* Authors:
* ========
*
@ -34,7 +54,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level1
*
@ -51,10 +71,10 @@
* =====================================================================
DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
*
* -- Reference BLAS level1 routine (version 3.4.0) --
* -- Reference BLAS level1 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INCX,N

43
lib/linalg/daxpy.f
View File

@ -28,6 +28,43 @@
*> uses unrolled loops for increments equal to one.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in] DA
*> \verbatim
*> DA is DOUBLE PRECISION
*> On entry, DA specifies the scalar alpha.
*> \endverbatim
*>
*> \param[in] DX
*> \verbatim
*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of DX
*> \endverbatim
*>
*> \param[in,out] DY
*> \verbatim
*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> storage spacing between elements of DY
*> \endverbatim
*
* Authors:
* ========
*
@ -36,7 +73,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level1
*
@ -52,10 +89,10 @@
* =====================================================================
SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
*
* -- Reference BLAS level1 routine (version 3.4.0) --
* -- Reference BLAS level1 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION DA

37
lib/linalg/dbdsqr.f
View File

@ -212,6 +212,17 @@
*> algorithm through its inner loop. The algorithms stops
*> (and so fails to converge) if the number of passes
*> through the inner loop exceeds MAXITR*N**2.
*>
*> \endverbatim
*
*> \par Note:
* ===========
*>
*> \verbatim
*> Bug report from Cezary Dendek.
*> On March 23rd 2017, the INTEGER variable MAXIT = MAXITR*N**2 is
*> removed since it can overflow pretty easily (for N larger or equal
*> than 18,919). We instead use MAXITDIVN = MAXITR*N.
*> \endverbatim
*
* Authors:
@ -222,7 +233,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
@ -230,10 +241,10 @@
SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
$ LDU, C, LDC, WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
@ -266,8 +277,8 @@
* ..
* .. Local Scalars ..
LOGICAL LOWER, ROTATE
INTEGER I, IDIR, ISUB, ITER, J, LL, LLL, M, MAXIT, NM1,
$ NM12, NM13, OLDLL, OLDM
INTEGER I, IDIR, ISUB, ITER, ITERDIVN, J, LL, LLL, M,
$ MAXITDIVN, NM1, NM12, NM13, OLDLL, OLDM
DOUBLE PRECISION ABSE, ABSS, COSL, COSR, CS, EPS, F, G, H, MU,
$ OLDCS, OLDSN, R, SHIFT, SIGMN, SIGMX, SINL,
$ SINR, SLL, SMAX, SMIN, SMINL, SMINOA,
@ -400,20 +411,21 @@
40 CONTINUE
50 CONTINUE
SMINOA = SMINOA / SQRT( DBLE( N ) )
THRESH = MAX( TOL*SMINOA, MAXITR*N*N*UNFL )
THRESH = MAX( TOL*SMINOA, MAXITR*(N*(N*UNFL)) )
ELSE
*
* Absolute accuracy desired
*
THRESH = MAX( ABS( TOL )*SMAX, MAXITR*N*N*UNFL )
THRESH = MAX( ABS( TOL )*SMAX, MAXITR*(N*(N*UNFL)) )
END IF
*
* Prepare for main iteration loop for the singular values
* (MAXIT is the maximum number of passes through the inner
* loop permitted before nonconvergence signalled.)
*
MAXIT = MAXITR*N*N
ITER = 0
MAXITDIVN = MAXITR*N
ITERDIVN = 0
ITER = -1
OLDLL = -1
OLDM = -1
*
@ -429,8 +441,13 @@
*
IF( M.LE.1 )
$ GO TO 160
IF( ITER.GT.MAXIT )
*
IF( ITER.GE.N ) THEN
ITER = ITER - N
ITERDIVN = ITERDIVN + 1
IF( ITERDIVN.GE.MAXITDIVN )
$ GO TO 200
END IF
*
* Find diagonal block of matrix to work on
*

16
lib/linalg/dcabs1.f
View File

@ -21,7 +21,15 @@
*>
*> \verbatim
*>
*> DCABS1 computes absolute value of a double complex number
*> DCABS1 computes |Re(.)| + |Im(.)| of a double complex number
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] Z
*> \verbatim
*> Z is COMPLEX*16
*> \endverbatim
*
* Authors:
@ -32,17 +40,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level1
*
* =====================================================================
DOUBLE PRECISION FUNCTION DCABS1(Z)
*
* -- Reference BLAS level1 routine (version 3.4.0) --
* -- Reference BLAS level1 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
COMPLEX*16 Z

39
lib/linalg/dcopy.f
View File

@ -24,7 +24,38 @@
*> \verbatim
*>
*> DCOPY copies a vector, x, to a vector, y.
*> uses unrolled loops for increments equal to one.
*> uses unrolled loops for increments equal to 1.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in] DX
*> \verbatim
*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of DX
*> \endverbatim
*>
*> \param[out] DY
*> \verbatim
*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> storage spacing between elements of DY
*> \endverbatim
*
* Authors:
@ -35,7 +66,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level1
*
@ -51,10 +82,10 @@
* =====================================================================
SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
*
* -- Reference BLAS level1 routine (version 3.4.0) --
* -- Reference BLAS level1 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N

37
lib/linalg/ddot.f
View File

@ -27,6 +27,37 @@
*> uses unrolled loops for increments equal to one.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in] DX
*> \verbatim
*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of DX
*> \endverbatim
*>
*> \param[in] DY
*> \verbatim
*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> storage spacing between elements of DY
*> \endverbatim
*
* Authors:
* ========
*
@ -35,7 +66,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level1
*
@ -51,10 +82,10 @@
* =====================================================================
DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
*
* -- Reference BLAS level1 routine (version 3.4.0) --
* -- Reference BLAS level1 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N

8
lib/linalg/dgebd2.f
View File

@ -100,7 +100,7 @@
*>
*> \param[out] TAUQ
*> \verbatim
*> TAUQ is DOUBLE PRECISION array dimension (min(M,N))
*> TAUQ is DOUBLE PRECISION array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors which
*> represent the orthogonal matrix Q. See Further Details.
*> \endverbatim
@ -132,7 +132,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2017
*
*> \ingroup doubleGEcomputational
*
@ -189,10 +189,10 @@
* =====================================================================
SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N

8
lib/linalg/dgebrd.f
View File

@ -101,7 +101,7 @@
*>
*> \param[out] TAUQ
*> \verbatim
*> TAUQ is DOUBLE PRECISION array dimension (min(M,N))
*> TAUQ is DOUBLE PRECISION array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors which
*> represent the orthogonal matrix Q. See Further Details.
*> \endverbatim
@ -147,7 +147,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date June 2017
*
*> \ingroup doubleGEcomputational
*
@ -205,10 +205,10 @@
SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
$ INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, M, N

6
lib/linalg/dgecon.f
View File

@ -116,7 +116,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleGEcomputational
*
@ -124,10 +124,10 @@
SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
$ INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER NORM

6
lib/linalg/dgelq2.f
View File

@ -96,7 +96,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleGEcomputational
*
@ -121,10 +121,10 @@
* =====================================================================
SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N

6
lib/linalg/dgelqf.f
View File

@ -110,7 +110,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleGEcomputational
*
@ -135,10 +135,10 @@
* =====================================================================
SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, M, N

16
lib/linalg/dgemm.f
View File

@ -97,7 +97,7 @@
*>
*> \param[in] A
*> \verbatim
*> A is DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is
*> k when TRANSA = 'N' or 'n', and is m otherwise.
*> Before entry with TRANSA = 'N' or 'n', the leading m by k
*> part of the array A must contain the matrix A, otherwise
@ -116,7 +116,7 @@
*>
*> \param[in] B
*> \verbatim
*> B is DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
*> B is DOUBLE PRECISION array, dimension ( LDB, kb ), where kb is
*> n when TRANSB = 'N' or 'n', and is k otherwise.
*> Before entry with TRANSB = 'N' or 'n', the leading k by n
*> part of the array B must contain the matrix B, otherwise
@ -142,7 +142,7 @@
*>
*> \param[in,out] C
*> \verbatim
*> C is DOUBLE PRECISION array of DIMENSION ( LDC, n ).
*> C is DOUBLE PRECISION array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
@ -166,7 +166,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level3
*
@ -187,10 +187,10 @@
* =====================================================================
SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
*
* -- Reference BLAS level3 routine (version 3.4.0) --
* -- Reference BLAS level3 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA,BETA
@ -311,12 +311,10 @@
60 CONTINUE
END IF
DO 80 L = 1,K
IF (B(L,J).NE.ZERO) THEN
TEMP = ALPHA*B(L,J)
DO 70 I = 1,M
C(I,J) = C(I,J) + TEMP*A(I,L)
70 CONTINUE
END IF
80 CONTINUE
90 CONTINUE
ELSE
@ -353,12 +351,10 @@
140 CONTINUE
END IF
DO 160 L = 1,K
IF (B(J,L).NE.ZERO) THEN
TEMP = ALPHA*B(J,L)
DO 150 I = 1,M
C(I,J) = C(I,J) + TEMP*A(I,L)
150 CONTINUE
END IF
160 CONTINUE
170 CONTINUE
ELSE

16
lib/linalg/dgemv.f
View File

@ -71,7 +71,7 @@
*>
*> \param[in] A
*> \verbatim
*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> \endverbatim
@ -86,7 +86,7 @@
*>
*> \param[in] X
*> \verbatim
*> X is DOUBLE PRECISION array of DIMENSION at least
*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
@ -110,7 +110,7 @@
*>
*> \param[in,out] Y
*> \verbatim
*> Y is DOUBLE PRECISION array of DIMENSION at least
*> Y is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
@ -134,7 +134,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level2
*
@ -156,10 +156,10 @@
* =====================================================================
SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
*
* -- Reference BLAS level2 routine (version 3.4.0) --
* -- Reference BLAS level2 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA,BETA
@ -278,24 +278,20 @@
JX = KX
IF (INCY.EQ.1) THEN
DO 60 J = 1,N
IF (X(JX).NE.ZERO) THEN
TEMP = ALPHA*X(JX)
DO 50 I = 1,M
Y(I) = Y(I) + TEMP*A(I,J)
50 CONTINUE
END IF
JX = JX + INCX
60 CONTINUE
ELSE
DO 80 J = 1,N
IF (X(JX).NE.ZERO) THEN
TEMP = ALPHA*X(JX)
IY = KY
DO 70 I = 1,M
Y(IY) = Y(IY) + TEMP*A(I,J)
IY = IY + INCY
70 CONTINUE
END IF
JX = JX + INCX
80 CONTINUE
END IF

6
lib/linalg/dgeqr2.f
View File

@ -96,7 +96,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleGEcomputational
*
@ -121,10 +121,10 @@
* =====================================================================
SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N

6
lib/linalg/dgeqrf.f
View File

@ -111,7 +111,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleGEcomputational
*
@ -136,10 +136,10 @@
* =====================================================================
SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, M, N

12
lib/linalg/dger.f
View File

@ -57,7 +57,7 @@
*>
*> \param[in] X
*> \verbatim
*> X is DOUBLE PRECISION array of dimension at least
*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the m
*> element vector x.
@ -72,7 +72,7 @@
*>
*> \param[in] Y
*> \verbatim
*> Y is DOUBLE PRECISION array of dimension at least
*> Y is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
@ -87,7 +87,7 @@
*>
*> \param[in,out] A
*> \verbatim
*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients. On exit, A is
*> overwritten by the updated matrix.
@ -109,7 +109,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level2
*
@ -130,10 +130,10 @@
* =====================================================================
SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
*
* -- Reference BLAS level2 routine (version 3.4.0) --
* -- Reference BLAS level2 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA

6
lib/linalg/dgesv.f
View File

@ -115,17 +115,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleGEsolve
*
* =====================================================================
SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
*
* -- LAPACK driver routine (version 3.4.0) --
* -- LAPACK driver routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, N, NRHS

67
lib/linalg/dgesvd.f
View File

@ -211,7 +211,7 @@
SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU,
$ VT, LDVT, WORK, LWORK, INFO )
*
* -- LAPACK driver routine (version 3.4.1) --
* -- LAPACK driver routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
@ -314,24 +314,24 @@
BDSPAC = 5*N
* Compute space needed for DGEQRF
CALL DGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
LWORK_DGEQRF=DUM(1)
LWORK_DGEQRF = INT( DUM(1) )
* Compute space needed for DORGQR
CALL DORGQR( M, N, N, A, LDA, DUM(1), DUM(1), -1, IERR )
LWORK_DORGQR_N=DUM(1)
LWORK_DORGQR_N = INT( DUM(1) )
CALL DORGQR( M, M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
LWORK_DORGQR_M=DUM(1)
LWORK_DORGQR_M = INT( DUM(1) )
* Compute space needed for DGEBRD
CALL DGEBRD( N, N, A, LDA, S, DUM(1), DUM(1),
$ DUM(1), DUM(1), -1, IERR )
LWORK_DGEBRD=DUM(1)
LWORK_DGEBRD = INT( DUM(1) )
* Compute space needed for DORGBR P
CALL DORGBR( 'P', N, N, N, A, LDA, DUM(1),
$ DUM(1), -1, IERR )
LWORK_DORGBR_P=DUM(1)
LWORK_DORGBR_P = INT( DUM(1) )
* Compute space needed for DORGBR Q
CALL DORGBR( 'Q', N, N, N, A, LDA, DUM(1),
$ DUM(1), -1, IERR )
LWORK_DORGBR_Q=DUM(1)
LWORK_DORGBR_Q = INT( DUM(1) )
*
IF( M.GE.MNTHR ) THEN
IF( WNTUN ) THEN
@ -447,18 +447,18 @@
*
CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
$ DUM(1), DUM(1), -1, IERR )
LWORK_DGEBRD=DUM(1)
LWORK_DGEBRD = INT( DUM(1) )
MAXWRK = 3*N + LWORK_DGEBRD
IF( WNTUS .OR. WNTUO ) THEN
CALL DORGBR( 'Q', M, N, N, A, LDA, DUM(1),
$ DUM(1), -1, IERR )
LWORK_DORGBR_Q=DUM(1)
LWORK_DORGBR_Q = INT( DUM(1) )
MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR_Q )
END IF
IF( WNTUA ) THEN
CALL DORGBR( 'Q', M, M, N, A, LDA, DUM(1),
$ DUM(1), -1, IERR )
LWORK_DORGBR_Q=DUM(1)
LWORK_DORGBR_Q = INT( DUM(1) )
MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR_Q )
END IF
IF( .NOT.WNTVN ) THEN
@ -475,24 +475,24 @@
BDSPAC = 5*M
* Compute space needed for DGELQF
CALL DGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
LWORK_DGELQF=DUM(1)
LWORK_DGELQF = INT( DUM(1) )
* Compute space needed for DORGLQ
CALL DORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR )
LWORK_DORGLQ_N=DUM(1)
LWORK_DORGLQ_N = INT( DUM(1) )
CALL DORGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR )
LWORK_DORGLQ_M=DUM(1)
LWORK_DORGLQ_M = INT( DUM(1) )
* Compute space needed for DGEBRD
CALL DGEBRD( M, M, A, LDA, S, DUM(1), DUM(1),
$ DUM(1), DUM(1), -1, IERR )
LWORK_DGEBRD=DUM(1)
LWORK_DGEBRD = INT( DUM(1) )
* Compute space needed for DORGBR P
CALL DORGBR( 'P', M, M, M, A, N, DUM(1),
$ DUM(1), -1, IERR )
LWORK_DORGBR_P=DUM(1)
LWORK_DORGBR_P = INT( DUM(1) )
* Compute space needed for DORGBR Q
CALL DORGBR( 'Q', M, M, M, A, N, DUM(1),
$ DUM(1), -1, IERR )
LWORK_DORGBR_Q=DUM(1)
LWORK_DORGBR_Q = INT( DUM(1) )
IF( N.GE.MNTHR ) THEN
IF( WNTVN ) THEN
*
@ -607,19 +607,19 @@
*
CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
$ DUM(1), DUM(1), -1, IERR )
LWORK_DGEBRD=DUM(1)
LWORK_DGEBRD = INT( DUM(1) )
MAXWRK = 3*M + LWORK_DGEBRD
IF( WNTVS .OR. WNTVO ) THEN
* Compute space needed for DORGBR P
CALL DORGBR( 'P', M, N, M, A, N, DUM(1),
$ DUM(1), -1, IERR )
LWORK_DORGBR_P=DUM(1)
LWORK_DORGBR_P = INT( DUM(1) )
MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR_P )
END IF
IF( WNTVA ) THEN
CALL DORGBR( 'P', N, N, M, A, N, DUM(1),
$ DUM(1), -1, IERR )
LWORK_DORGBR_P=DUM(1)
LWORK_DORGBR_P = INT( DUM(1) )
MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR_P )
END IF
IF( .NOT.WNTUN ) THEN
@ -692,7 +692,10 @@
*
* Zero out below R
*
CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
IF( N .GT. 1 ) THEN
CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
$ LDA )
END IF
IE = 1
ITAUQ = IE + N
ITAUP = ITAUQ + N
@ -1121,8 +1124,10 @@
*
* Zero out below R in A
*
CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
$ LDA )
IF( N .GT. 1 ) THEN
CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
$ A( 2, 1 ), LDA )
END IF
*
* Bidiagonalize R in A
* (Workspace: need 4*N, prefer 3*N + 2*N*NB)
@ -1284,8 +1289,10 @@
*
* Zero out below R in A
*
CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
$ LDA )
IF( N .GT. 1 ) THEN
CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
$ A( 2, 1 ), LDA )
END IF
*
* Bidiagonalize R in A
* (Workspace: need 4*N, prefer 3*N + 2*N*NB)
@ -1587,8 +1594,10 @@
*
* Zero out below R in A
*
CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
$ LDA )
IF( N .GT. 1 ) THEN
CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
$ A( 2, 1 ), LDA )
END IF
*
* Bidiagonalize R in A
* (Workspace: need 4*N, prefer 3*N + 2*N*NB)
@ -1755,8 +1764,10 @@
*
* Zero out below R in A
*
CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
$ LDA )
IF( N .GT. 1 ) THEN
CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
$ A( 2, 1 ), LDA )
END IF
*
* Bidiagonalize R in A
* (Workspace: need 4*N, prefer 3*N + 2*N*NB)

6
lib/linalg/dgetf2.f
View File

@ -101,17 +101,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleGEcomputational
*
* =====================================================================
SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N

12
lib/linalg/dgetrf.f
View File

@ -101,17 +101,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleGEcomputational
*
* =====================================================================
SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
@ -131,7 +131,7 @@
INTEGER I, IINFO, J, JB, NB
* ..
* .. External Subroutines ..
EXTERNAL DGEMM, DGETF2, DLASWP, DTRSM, XERBLA
EXTERNAL DGEMM, DGETRF2, DLASWP, DTRSM, XERBLA
* ..
* .. External Functions ..
INTEGER ILAENV
@ -169,7 +169,7 @@
*
* Use unblocked code.
*
CALL DGETF2( M, N, A, LDA, IPIV, INFO )
CALL DGETRF2( M, N, A, LDA, IPIV, INFO )
ELSE
*
* Use blocked code.
@ -180,7 +180,7 @@
* Factor diagonal and subdiagonal blocks and test for exact
* singularity.
*
CALL DGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
CALL DGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
*
* Adjust INFO and the pivot indices.
*

272
lib/linalg/dgetrf2.f Normal file
View File

@ -0,0 +1,272 @@
*> \brief \b DGETRF2
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* RECURSIVE SUBROUTINE DGETRF2( M, N, A, LDA, IPIV, INFO )
*
* .. Scalar Arguments ..
* INTEGER INFO, LDA, M, N
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
* DOUBLE PRECISION A( LDA, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DGETRF2 computes an LU factorization of a general M-by-N matrix A
*> using partial pivoting with row interchanges.
*>
*> The factorization has the form
*> A = P * L * U
*> where P is a permutation matrix, L is lower triangular with unit
*> diagonal elements (lower trapezoidal if m > n), and U is upper
*> triangular (upper trapezoidal if m < n).
*>
*> This is the recursive version of the algorithm. It divides
*> the matrix into four submatrices:
*>
*> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2
*> A = [ -----|----- ] with n1 = min(m,n)/2
*> [ A21 | A22 ] n2 = n-n1
*>
*> [ A11 ]
*> The subroutine calls itself to factor [ --- ],
*> [ A12 ]
*> [ A12 ]
*> do the swaps on [ --- ], solve A12, update A22,
*> [ A22 ]
*>
*> then calls itself to factor A22 and do the swaps on A21.
*>
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> The number of rows of the matrix A. M >= 0.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of columns of the matrix A. N >= 0.
*> \endverbatim
*>
*> \param[in,out] A
*> \verbatim
*> A is DOUBLE PRECISION array, dimension (LDA,N)
*> On entry, the M-by-N matrix to be factored.
*> On exit, the factors L and U from the factorization
*> A = P*L*U; the unit diagonal elements of L are not stored.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[out] IPIV
*> \verbatim
*> IPIV is INTEGER array, dimension (min(M,N))
*> The pivot indices; for 1 <= i <= min(M,N), row i of the
*> matrix was interchanged with row IPIV(i).
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
*> < 0: if INFO = -i, the i-th argument had an illegal value
*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
*> has been completed, but the factor U is exactly
*> singular, and division by zero will occur if it is used
*> to solve a system of equations.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date June 2016
*
*> \ingroup doubleGEcomputational
*
* =====================================================================
RECURSIVE SUBROUTINE DGETRF2( M, N, A, LDA, IPIV, INFO )
*
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
DOUBLE PRECISION A( LDA, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ONE, ZERO
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
DOUBLE PRECISION SFMIN, TEMP
INTEGER I, IINFO, N1, N2
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMCH
INTEGER IDAMAX
EXTERNAL DLAMCH, IDAMAX
* ..
* .. External Subroutines ..
EXTERNAL DGEMM, DSCAL, DLASWP, DTRSM, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* ..
* .. Executable Statements ..
*
* Test the input parameters
*
INFO = 0
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGETRF2', -INFO )
RETURN
END IF
*
* Quick return if possible
*
IF( M.EQ.0 .OR. N.EQ.0 )
$ RETURN
IF ( M.EQ.1 ) THEN
*
* Use unblocked code for one row case
* Just need to handle IPIV and INFO
*
IPIV( 1 ) = 1
IF ( A(1,1).EQ.ZERO )
$ INFO = 1
*
ELSE IF( N.EQ.1 ) THEN
*
* Use unblocked code for one column case
*
*
* Compute machine safe minimum
*
SFMIN = DLAMCH('S')
*
* Find pivot and test for singularity
*
I = IDAMAX( M, A( 1, 1 ), 1 )
IPIV( 1 ) = I
IF( A( I, 1 ).NE.ZERO ) THEN
*
* Apply the interchange
*
IF( I.NE.1 ) THEN
TEMP = A( 1, 1 )
A( 1, 1 ) = A( I, 1 )
A( I, 1 ) = TEMP
END IF
*
* Compute elements 2:M of the column
*
IF( ABS(A( 1, 1 )) .GE. SFMIN ) THEN
CALL DSCAL( M-1, ONE / A( 1, 1 ), A( 2, 1 ), 1 )
ELSE
DO 10 I = 1, M-1
A( 1+I, 1 ) = A( 1+I, 1 ) / A( 1, 1 )
10 CONTINUE
END IF
*
ELSE
INFO = 1
END IF
*
ELSE
*
* Use recursive code
*
N1 = MIN( M, N ) / 2
N2 = N-N1
*
* [ A11 ]
* Factor [ --- ]
* [ A21 ]
*
CALL DGETRF2( M, N1, A, LDA, IPIV, IINFO )
IF ( INFO.EQ.0 .AND. IINFO.GT.0 )
$ INFO = IINFO
*
* [ A12 ]
* Apply interchanges to [ --- ]
* [ A22 ]
*
CALL DLASWP( N2, A( 1, N1+1 ), LDA, 1, N1, IPIV, 1 )
*
* Solve A12
*
CALL DTRSM( 'L', 'L', 'N', 'U', N1, N2, ONE, A, LDA,
$ A( 1, N1+1 ), LDA )
*
* Update A22
*
CALL DGEMM( 'N', 'N', M-N1, N2, N1, -ONE, A( N1+1, 1 ), LDA,
$ A( 1, N1+1 ), LDA, ONE, A( N1+1, N1+1 ), LDA )
*
* Factor A22
*
CALL DGETRF2( M-N1, N2, A( N1+1, N1+1 ), LDA, IPIV( N1+1 ),
$ IINFO )
*
* Adjust INFO and the pivot indices
*
IF ( INFO.EQ.0 .AND. IINFO.GT.0 )
$ INFO = IINFO + N1
DO 20 I = N1+1, MIN( M, N )
IPIV( I ) = IPIV( I ) + N1
20 CONTINUE
*
* Apply interchanges to A21
*
CALL DLASWP( N1, A( 1, 1 ), LDA, N1+1, MIN( M, N), IPIV, 1 )
*
END IF
RETURN
*
* End of DGETRF2
*
END

6
lib/linalg/dgetri.f
View File

@ -107,17 +107,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleGEcomputational
*
* =====================================================================
SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, N

6
lib/linalg/dgetrs.f
View File

@ -114,17 +114,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleGEcomputational
*
* =====================================================================
SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER TRANS

12
lib/linalg/disnan.f
View File

@ -21,7 +21,7 @@
* LOGICAL FUNCTION DISNAN( DIN )
*
* .. Scalar Arguments ..
* DOUBLE PRECISION DIN
* DOUBLE PRECISION, INTENT(IN) :: DIN
* ..
*
*
@ -52,20 +52,20 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2017
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
LOGICAL FUNCTION DISNAN( DIN )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION DIN
DOUBLE PRECISION, INTENT(IN) :: DIN
* ..
*
* =====================================================================

8
lib/linalg/dlabad.f
View File

@ -67,17 +67,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE DLABAD( SMALL, LARGE )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION LARGE, SMALL

8
lib/linalg/dlabrd.f
View File

@ -110,7 +110,7 @@
*>
*> \param[out] TAUQ
*> \verbatim
*> TAUQ is DOUBLE PRECISION array dimension (NB)
*> TAUQ is DOUBLE PRECISION array, dimension (NB)
*> The scalar factors of the elementary reflectors which
*> represent the orthogonal matrix Q. See Further Details.
*> \endverbatim
@ -156,7 +156,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2017
*
*> \ingroup doubleOTHERauxiliary
*
@ -210,10 +210,10 @@
SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
$ LDY )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, LDX, LDY, M, N, NB

6
lib/linalg/dlacn2.f
View File

@ -101,7 +101,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERauxiliary
*
@ -136,10 +136,10 @@
* =====================================================================
SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER KASE, N

8
lib/linalg/dlacpy.f
View File

@ -96,17 +96,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER UPLO

164
lib/linalg/dladiv.f
View File

@ -36,8 +36,9 @@
*> p + i*q = ---------
*> c + i*d
*>
*> The algorithm is due to Robert L. Smith and can be found
*> in D. Knuth, The art of Computer Programming, Vol.2, p.195
*> The algorithm is due to Michael Baudin and Robert L. Smith
*> and can be found in the paper
*> "A Robust Complex Division in Scilab"
*> \endverbatim
*
* Arguments:
@ -83,17 +84,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date January 2013
*
*> \ingroup auxOTHERauxiliary
*> \ingroup doubleOTHERauxiliary
*
* =====================================================================
SUBROUTINE DLADIV( A, B, C, D, P, Q )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* January 2013
*
* .. Scalar Arguments ..
DOUBLE PRECISION A, B, C, D, P, Q
@ -101,28 +102,155 @@
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION BS
PARAMETER ( BS = 2.0D0 )
DOUBLE PRECISION HALF
PARAMETER ( HALF = 0.5D0 )
DOUBLE PRECISION TWO
PARAMETER ( TWO = 2.0D0 )
*
* .. Local Scalars ..
DOUBLE PRECISION E, F
DOUBLE PRECISION AA, BB, CC, DD, AB, CD, S, OV, UN, BE, EPS
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMCH
EXTERNAL DLAMCH
* ..
* .. External Subroutines ..
EXTERNAL DLADIV1
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS
INTRINSIC ABS, MAX
* ..
* .. Executable Statements ..
*
IF( ABS( D ).LT.ABS( C ) ) THEN
E = D / C
F = C + D*E
P = ( A+B*E ) / F
Q = ( B-A*E ) / F
ELSE
E = C / D
F = D + C*E
P = ( B+A*E ) / F
Q = ( -A+B*E ) / F
AA = A
BB = B
CC = C
DD = D
AB = MAX( ABS(A), ABS(B) )
CD = MAX( ABS(C), ABS(D) )
S = 1.0D0
OV = DLAMCH( 'Overflow threshold' )
UN = DLAMCH( 'Safe minimum' )
EPS = DLAMCH( 'Epsilon' )
BE = BS / (EPS*EPS)
IF( AB >= HALF*OV ) THEN
AA = HALF * AA
BB = HALF * BB
S = TWO * S
END IF
IF( CD >= HALF*OV ) THEN
CC = HALF * CC
DD = HALF * DD
S = HALF * S
END IF
IF( AB <= UN*BS/EPS ) THEN
AA = AA * BE
BB = BB * BE
S = S / BE
END IF
IF( CD <= UN*BS/EPS ) THEN
CC = CC * BE
DD = DD * BE
S = S * BE
END IF
IF( ABS( D ).LE.ABS( C ) ) THEN
CALL DLADIV1(AA, BB, CC, DD, P, Q)
ELSE
CALL DLADIV1(BB, AA, DD, CC, P, Q)
Q = -Q
END IF
P = P * S
Q = Q * S
*
RETURN
*
* End of DLADIV
*
END
*> \ingroup doubleOTHERauxiliary
SUBROUTINE DLADIV1( A, B, C, D, P, Q )
*
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* January 2013
*
* .. Scalar Arguments ..
DOUBLE PRECISION A, B, C, D, P, Q
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ONE
PARAMETER ( ONE = 1.0D0 )
*
* .. Local Scalars ..
DOUBLE PRECISION R, T
* ..
* .. External Functions ..
DOUBLE PRECISION DLADIV2
EXTERNAL DLADIV2
* ..
* .. Executable Statements ..
*
R = D / C
T = ONE / (C + D * R)
P = DLADIV2(A, B, C, D, R, T)
A = -A
Q = DLADIV2(B, A, C, D, R, T)
*
RETURN
*
* End of DLADIV1
*
END
*> \ingroup doubleOTHERauxiliary
DOUBLE PRECISION FUNCTION DLADIV2( A, B, C, D, R, T )
*
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* January 2013
*
* .. Scalar Arguments ..
DOUBLE PRECISION A, B, C, D, R, T
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D0 )
*
* .. Local Scalars ..
DOUBLE PRECISION BR
* ..
* .. Executable Statements ..
*
IF( R.NE.ZERO ) THEN
BR = B * R
IF( BR.NE.ZERO ) THEN
DLADIV2 = (A + BR) * T
ELSE
DLADIV2 = A * T + (B * T) * R
END IF
ELSE
DLADIV2 = (A + D * (B / C)) * T
END IF
*
RETURN
*
* End of DLADIV12
*
END

8
lib/linalg/dlae2.f
View File

@ -78,9 +78,9 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
*> \par Further Details:
* =====================
@ -102,10 +102,10 @@
* =====================================================================
SUBROUTINE DLAE2( A, B, C, RT1, RT2 )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION A, B, C, RT1, RT2

6
lib/linalg/dlaed0.f
View File

@ -158,7 +158,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
@ -172,10 +172,10 @@
SUBROUTINE DLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS,
$ WORK, IWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER ICOMPQ, INFO, LDQ, LDQS, N, QSIZ

8
lib/linalg/dlaed1.f
View File

@ -54,7 +54,7 @@
*>
*> The first stage consists of deflating the size of the problem
*> when there are multiple eigenvalues or if there is a zero in
*> the Z vector. For each such occurence the dimension of the
*> the Z vector. For each such occurrence the dimension of the
*> secular equation problem is reduced by one. This stage is
*> performed by the routine DLAED2.
*>
@ -148,7 +148,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
@ -163,10 +163,10 @@
SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK,
$ INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2016
*
* .. Scalar Arguments ..
INTEGER CUTPNT, INFO, LDQ, N

6
lib/linalg/dlaed2.f
View File

@ -197,7 +197,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
@ -212,10 +212,10 @@
SUBROUTINE DLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMDA, W,
$ Q2, INDX, INDXC, INDXP, COLTYP, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDQ, N, N1

8
lib/linalg/dlaed3.f
View File

@ -116,7 +116,7 @@
*>
*> \param[in] Q2
*> \verbatim
*> Q2 is DOUBLE PRECISION array, dimension (LDQ2, N)
*> Q2 is DOUBLE PRECISION array, dimension (LDQ2*N)
*> The first K columns of this matrix contain the non-deflated
*> eigenvectors for the split problem.
*> \endverbatim
@ -170,7 +170,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
@ -185,10 +185,10 @@
SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX,
$ CTOT, W, S, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDQ, N, N1

6
lib/linalg/dlaed4.f
View File

@ -132,7 +132,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
@ -145,10 +145,10 @@
* =====================================================================
SUBROUTINE DLAED4( N, I, D, Z, DELTA, RHO, DLAM, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER I, INFO, N

6
lib/linalg/dlaed5.f
View File

@ -95,7 +95,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
@ -108,10 +108,10 @@
* =====================================================================
SUBROUTINE DLAED5( I, D, Z, DELTA, RHO, DLAM )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER I

9
lib/linalg/dlaed6.f
View File

@ -115,7 +115,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
@ -140,10 +140,10 @@
* =====================================================================
SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
LOGICAL ORGATI
@ -387,7 +387,8 @@
F = FINIT + TAU*FC
ERRETM = EIGHT*( ABS( FINIT )+ABS( TAU )*ERRETM ) +
$ ABS( TAU )*DF
IF( ABS( F ).LE.EPS*ERRETM )
IF( ( ABS( F ).LE.FOUR*EPS*ERRETM ) .OR.
$ ( (UBD-LBD).LE.FOUR*EPS*ABS(TAU) ) )
$ GO TO 60
IF( F .LE. ZERO )THEN
LBD = TAU

10
lib/linalg/dlaed7.f
View File

@ -59,7 +59,7 @@
*>
*> The first stage consists of deflating the size of the problem
*> when there are multiple eigenvalues or if there is a zero in
*> the Z vector. For each such occurence the dimension of the
*> the Z vector. For each such occurrence the dimension of the
*> secular equation problem is reduced by one. This stage is
*> performed by the routine DLAED8.
*>
@ -244,7 +244,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
@ -260,10 +260,10 @@
$ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK,
$ INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2016
*
* .. Scalar Arguments ..
INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N,
@ -304,7 +304,7 @@
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( ICOMPQ.EQ.1 .AND. QSIZ.LT.N ) THEN
INFO = -4
INFO = -3
ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
INFO = -9
ELSE IF( MIN( 1, N ).GT.CUTPNT .OR. N.LT.CUTPNT ) THEN

6
lib/linalg/dlaed8.f
View File

@ -228,7 +228,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
@ -243,10 +243,10 @@
$ CUTPNT, Z, DLAMDA, Q2, LDQ2, W, PERM, GIVPTR,
$ GIVCOL, GIVNUM, INDXP, INDX, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER CUTPNT, GIVPTR, ICOMPQ, INFO, K, LDQ, LDQ2, N,

6
lib/linalg/dlaed9.f
View File

@ -142,7 +142,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
@ -156,10 +156,10 @@
SUBROUTINE DLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W,
$ S, LDS, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, K, KSTART, KSTOP, LDQ, LDS, N

6
lib/linalg/dlaeda.f
View File

@ -152,7 +152,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
@ -166,10 +166,10 @@
SUBROUTINE DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR,
$ GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER CURLVL, CURPBM, INFO, N, TLVLS

8
lib/linalg/dlaev2.f
View File

@ -94,9 +94,9 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
*> \par Further Details:
* =====================
@ -120,10 +120,10 @@
* =====================================================================
SUBROUTINE DLAEV2( A, B, C, RT1, RT2, CS1, SN1 )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION A, B, C, CS1, RT1, RT2, SN1

12
lib/linalg/dlaisnan.f
View File

@ -21,7 +21,7 @@
* LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 )
*
* .. Scalar Arguments ..
* DOUBLE PRECISION DIN1, DIN2
* DOUBLE PRECISION, INTENT(IN) :: DIN1, DIN2
* ..
*
*
@ -67,20 +67,20 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2017
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION DIN1, DIN2
DOUBLE PRECISION, INTENT(IN) :: DIN1, DIN2
* ..
*
* =====================================================================

899
lib/linalg/dlamch.f
View File

@ -1,47 +1,77 @@
*> \brief \b DLAMCH
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DLAMCH determines double precision machine parameters.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] CMACH
*> \verbatim
*> Specifies the value to be returned by DLAMCH:
*> = 'E' or 'e', DLAMCH := eps
*> = 'S' or 's , DLAMCH := sfmin
*> = 'B' or 'b', DLAMCH := base
*> = 'P' or 'p', DLAMCH := eps*base
*> = 'N' or 'n', DLAMCH := t
*> = 'R' or 'r', DLAMCH := rnd
*> = 'M' or 'm', DLAMCH := emin
*> = 'U' or 'u', DLAMCH := rmin
*> = 'L' or 'l', DLAMCH := emax
*> = 'O' or 'o', DLAMCH := rmax
*> where
*> eps = relative machine precision
*> sfmin = safe minimum, such that 1/sfmin does not overflow
*> base = base of the machine
*> prec = eps*base
*> t = number of (base) digits in the mantissa
*> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
*> emin = minimum exponent before (gradual) underflow
*> rmin = underflow threshold - base**(emin-1)
*> emax = largest exponent before overflow
*> rmax = overflow threshold - (base**emax)*(1-eps)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
*
* -- LAPACK auxiliary routine (version 3.2) --
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2006
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016
*
* .. Scalar Arguments ..
CHARACTER CMACH
* ..
*
* Purpose
* =======
*
* DLAMCH determines double precision machine parameters.
*
* Arguments
* =========
*
* CMACH (input) CHARACTER*1
* Specifies the value to be returned by DLAMCH:
* = 'E' or 'e', DLAMCH := eps
* = 'S' or 's , DLAMCH := sfmin
* = 'B' or 'b', DLAMCH := base
* = 'P' or 'p', DLAMCH := eps*base
* = 'N' or 'n', DLAMCH := t
* = 'R' or 'r', DLAMCH := rnd
* = 'M' or 'm', DLAMCH := emin
* = 'U' or 'u', DLAMCH := rmin
* = 'L' or 'l', DLAMCH := emax
* = 'O' or 'o', DLAMCH := rmax
*
* where
*
* eps = relative machine precision
* sfmin = safe minimum, such that 1/sfmin does not overflow
* base = base of the machine
* prec = eps*base
* t = number of (base) digits in the mantissa
* rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
* emin = minimum exponent before (gradual) underflow
* rmin = underflow threshold - base**(emin-1)
* emax = largest exponent before overflow
* rmax = overflow threshold - (base**emax)*(1-eps)
*
* =====================================================================
*
* .. Parameters ..
@ -49,43 +79,34 @@
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
LOGICAL FIRST, LRND
INTEGER BETA, IMAX, IMIN, IT
DOUBLE PRECISION BASE, EMAX, EMIN, EPS, PREC, RMACH, RMAX, RMIN,
$ RND, SFMIN, SMALL, T
DOUBLE PRECISION RND, EPS, SFMIN, SMALL, RMACH
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL DLAMC2
* ..
* .. Save statement ..
SAVE FIRST, EPS, SFMIN, BASE, T, RND, EMIN, RMIN,
$ EMAX, RMAX, PREC
* ..
* .. Data statements ..
DATA FIRST / .TRUE. /
* .. Intrinsic Functions ..
INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
$ MINEXPONENT, RADIX, TINY
* ..
* .. Executable Statements ..
*
IF( FIRST ) THEN
CALL DLAMC2( BETA, IT, LRND, EPS, IMIN, RMIN, IMAX, RMAX )
BASE = BETA
T = IT
IF( LRND ) THEN
*
* Assume rounding, not chopping. Always.
*
RND = ONE
EPS = ( BASE**( 1-IT ) ) / 2
*
IF( ONE.EQ.RND ) THEN
EPS = EPSILON(ZERO) * 0.5
ELSE
RND = ZERO
EPS = BASE**( 1-IT )
EPS = EPSILON(ZERO)
END IF
PREC = EPS*BASE
EMIN = IMIN
EMAX = IMAX
SFMIN = RMIN
SMALL = ONE / RMAX
*
IF( LSAME( CMACH, 'E' ) ) THEN
RMACH = EPS
ELSE IF( LSAME( CMACH, 'S' ) ) THEN
SFMIN = TINY(ZERO)
SMALL = ONE / HUGE(ZERO)
IF( SMALL.GE.SFMIN ) THEN
*
* Use SMALL plus a bit, to avoid the possibility of rounding
@ -93,508 +114,66 @@
*
SFMIN = SMALL*( ONE+EPS )
END IF
END IF
*
IF( LSAME( CMACH, 'E' ) ) THEN
RMACH = EPS
ELSE IF( LSAME( CMACH, 'S' ) ) THEN
RMACH = SFMIN
ELSE IF( LSAME( CMACH, 'B' ) ) THEN
RMACH = BASE
RMACH = RADIX(ZERO)
ELSE IF( LSAME( CMACH, 'P' ) ) THEN
RMACH = PREC
RMACH = EPS * RADIX(ZERO)
ELSE IF( LSAME( CMACH, 'N' ) ) THEN
RMACH = T
RMACH = DIGITS(ZERO)
ELSE IF( LSAME( CMACH, 'R' ) ) THEN
RMACH = RND
ELSE IF( LSAME( CMACH, 'M' ) ) THEN
RMACH = EMIN
RMACH = MINEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'U' ) ) THEN
RMACH = RMIN
RMACH = tiny(zero)
ELSE IF( LSAME( CMACH, 'L' ) ) THEN
RMACH = EMAX
RMACH = MAXEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'O' ) ) THEN
RMACH = RMAX
RMACH = HUGE(ZERO)
ELSE
RMACH = ZERO
END IF
*
DLAMCH = RMACH
FIRST = .FALSE.
RETURN
*
* End of DLAMCH
*
END
*
************************************************************************
*
SUBROUTINE DLAMC1( BETA, T, RND, IEEE1 )
*
* -- LAPACK auxiliary routine (version 3.2) --
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2006
*
* .. Scalar Arguments ..
LOGICAL IEEE1, RND
INTEGER BETA, T
* ..
*
* Purpose
* =======
*
* DLAMC1 determines the machine parameters given by BETA, T, RND, and
* IEEE1.
*
* Arguments
* =========
*
* BETA (output) INTEGER
* The base of the machine.
*
* T (output) INTEGER
* The number of ( BETA ) digits in the mantissa.
*
* RND (output) LOGICAL
* Specifies whether proper rounding ( RND = .TRUE. ) or
* chopping ( RND = .FALSE. ) occurs in addition. This may not
* be a reliable guide to the way in which the machine performs
* its arithmetic.
*
* IEEE1 (output) LOGICAL
* Specifies whether rounding appears to be done in the IEEE
* 'round to nearest' style.
*
* Further Details
* ===============
*
* The routine is based on the routine ENVRON by Malcolm and
* incorporates suggestions by Gentleman and Marovich. See
*
* Malcolm M. A. (1972) Algorithms to reveal properties of
* floating-point arithmetic. Comms. of the ACM, 15, 949-951.
*
* Gentleman W. M. and Marovich S. B. (1974) More on algorithms
* that reveal properties of floating point arithmetic units.
* Comms. of the ACM, 17, 276-277.
*
* =====================================================================
*
* .. Local Scalars ..
LOGICAL FIRST, LIEEE1, LRND
INTEGER LBETA, LT
DOUBLE PRECISION A, B, C, F, ONE, QTR, SAVEC, T1, T2
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMC3
EXTERNAL DLAMC3
* ..
* .. Save statement ..
SAVE FIRST, LIEEE1, LBETA, LRND, LT
* ..
* .. Data statements ..
DATA FIRST / .TRUE. /
* ..
* .. Executable Statements ..
*
IF( FIRST ) THEN
ONE = 1
*
* LBETA, LIEEE1, LT and LRND are the local values of BETA,
* IEEE1, T and RND.
*
* Throughout this routine we use the function DLAMC3 to ensure
* that relevant values are stored and not held in registers, or
* are not affected by optimizers.
*
* Compute a = 2.0**m with the smallest positive integer m such
* that
*
* fl( a + 1.0 ) = a.
*
A = 1
C = 1
*
*+ WHILE( C.EQ.ONE )LOOP
10 CONTINUE
IF( C.EQ.ONE ) THEN
A = 2*A
C = DLAMC3( A, ONE )
C = DLAMC3( C, -A )
GO TO 10
END IF
*+ END WHILE
*
* Now compute b = 2.0**m with the smallest positive integer m
* such that
*
* fl( a + b ) .gt. a.
*
B = 1
C = DLAMC3( A, B )
*
*+ WHILE( C.EQ.A )LOOP
20 CONTINUE
IF( C.EQ.A ) THEN
B = 2*B
C = DLAMC3( A, B )
GO TO 20
END IF
*+ END WHILE
*
* Now compute the base. a and c are neighbouring floating point
* numbers in the interval ( beta**t, beta**( t + 1 ) ) and so
* their difference is beta. Adding 0.25 to c is to ensure that it
* is truncated to beta and not ( beta - 1 ).
*
QTR = ONE / 4
SAVEC = C
C = DLAMC3( C, -A )
LBETA = C + QTR
*
* Now determine whether rounding or chopping occurs, by adding a
* bit less than beta/2 and a bit more than beta/2 to a.
*
B = LBETA
F = DLAMC3( B / 2, -B / 100 )
C = DLAMC3( F, A )
IF( C.EQ.A ) THEN
LRND = .TRUE.
ELSE
LRND = .FALSE.
END IF
F = DLAMC3( B / 2, B / 100 )
C = DLAMC3( F, A )
IF( ( LRND ) .AND. ( C.EQ.A ) )
$ LRND = .FALSE.
*
* Try and decide whether rounding is done in the IEEE 'round to
* nearest' style. B/2 is half a unit in the last place of the two
* numbers A and SAVEC. Furthermore, A is even, i.e. has last bit
* zero, and SAVEC is odd. Thus adding B/2 to A should not change
* A, but adding B/2 to SAVEC should change SAVEC.
*
T1 = DLAMC3( B / 2, A )
T2 = DLAMC3( B / 2, SAVEC )
LIEEE1 = ( T1.EQ.A ) .AND. ( T2.GT.SAVEC ) .AND. LRND
*
* Now find the mantissa, t. It should be the integer part of
* log to the base beta of a, however it is safer to determine t
* by powering. So we find t as the smallest positive integer for
* which
*
* fl( beta**t + 1.0 ) = 1.0.
*
LT = 0
A = 1
C = 1
*
*+ WHILE( C.EQ.ONE )LOOP
30 CONTINUE
IF( C.EQ.ONE ) THEN
LT = LT + 1
A = A*LBETA
C = DLAMC3( A, ONE )
C = DLAMC3( C, -A )
GO TO 30
END IF
*+ END WHILE
*
END IF
*
BETA = LBETA
T = LT
RND = LRND
IEEE1 = LIEEE1
FIRST = .FALSE.
RETURN
*
* End of DLAMC1
*
END
*
************************************************************************
*
SUBROUTINE DLAMC2( BETA, T, RND, EPS, EMIN, RMIN, EMAX, RMAX )
*
* -- LAPACK auxiliary routine (version 3.2) --
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2006
*
* .. Scalar Arguments ..
LOGICAL RND
INTEGER BETA, EMAX, EMIN, T
DOUBLE PRECISION EPS, RMAX, RMIN
* ..
*
* Purpose
* =======
*
* DLAMC2 determines the machine parameters specified in its argument
* list.
*
* Arguments
* =========
*
* BETA (output) INTEGER
* The base of the machine.
*
* T (output) INTEGER
* The number of ( BETA ) digits in the mantissa.
*
* RND (output) LOGICAL
* Specifies whether proper rounding ( RND = .TRUE. ) or
* chopping ( RND = .FALSE. ) occurs in addition. This may not
* be a reliable guide to the way in which the machine performs
* its arithmetic.
*
* EPS (output) DOUBLE PRECISION
* The smallest positive number such that
*
* fl( 1.0 - EPS ) .LT. 1.0,
*
* where fl denotes the computed value.
*
* EMIN (output) INTEGER
* The minimum exponent before (gradual) underflow occurs.
*
* RMIN (output) DOUBLE PRECISION
* The smallest normalized number for the machine, given by
* BASE**( EMIN - 1 ), where BASE is the floating point value
* of BETA.
*
* EMAX (output) INTEGER
* The maximum exponent before overflow occurs.
*
* RMAX (output) DOUBLE PRECISION
* The largest positive number for the machine, given by
* BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
* value of BETA.
*
* Further Details
* ===============
*
* The computation of EPS is based on a routine PARANOIA by
* W. Kahan of the University of California at Berkeley.
*
* =====================================================================
*
* .. Local Scalars ..
LOGICAL FIRST, IEEE, IWARN, LIEEE1, LRND
INTEGER GNMIN, GPMIN, I, LBETA, LEMAX, LEMIN, LT,
$ NGNMIN, NGPMIN
DOUBLE PRECISION A, B, C, HALF, LEPS, LRMAX, LRMIN, ONE, RBASE,
$ SIXTH, SMALL, THIRD, TWO, ZERO
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMC3
EXTERNAL DLAMC3
* ..
* .. External Subroutines ..
EXTERNAL DLAMC1, DLAMC4, DLAMC5
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN
* ..
* .. Save statement ..
SAVE FIRST, IWARN, LBETA, LEMAX, LEMIN, LEPS, LRMAX,
$ LRMIN, LT
* ..
* .. Data statements ..
DATA FIRST / .TRUE. / , IWARN / .FALSE. /
* ..
* .. Executable Statements ..
*
IF( FIRST ) THEN
ZERO = 0
ONE = 1
TWO = 2
*
* LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values of
* BETA, T, RND, EPS, EMIN and RMIN.
*
* Throughout this routine we use the function DLAMC3 to ensure
* that relevant values are stored and not held in registers, or
* are not affected by optimizers.
*
* DLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1.
*
CALL DLAMC1( LBETA, LT, LRND, LIEEE1 )
*
* Start to find EPS.
*
B = LBETA
A = B**( -LT )
LEPS = A
*
* Try some tricks to see whether or not this is the correct EPS.
*
B = TWO / 3
HALF = ONE / 2
SIXTH = DLAMC3( B, -HALF )
THIRD = DLAMC3( SIXTH, SIXTH )
B = DLAMC3( THIRD, -HALF )
B = DLAMC3( B, SIXTH )
B = ABS( B )
IF( B.LT.LEPS )
$ B = LEPS
*
LEPS = 1
*
*+ WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP
10 CONTINUE
IF( ( LEPS.GT.B ) .AND. ( B.GT.ZERO ) ) THEN
LEPS = B
C = DLAMC3( HALF*LEPS, ( TWO**5 )*( LEPS**2 ) )
C = DLAMC3( HALF, -C )
B = DLAMC3( HALF, C )
C = DLAMC3( HALF, -B )
B = DLAMC3( HALF, C )
GO TO 10
END IF
*+ END WHILE
*
IF( A.LT.LEPS )
$ LEPS = A
*
* Computation of EPS complete.
*
* Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3)).
* Keep dividing A by BETA until (gradual) underflow occurs. This
* is detected when we cannot recover the previous A.
*
RBASE = ONE / LBETA
SMALL = ONE
DO 20 I = 1, 3
SMALL = DLAMC3( SMALL*RBASE, ZERO )
20 CONTINUE
A = DLAMC3( ONE, SMALL )
CALL DLAMC4( NGPMIN, ONE, LBETA )
CALL DLAMC4( NGNMIN, -ONE, LBETA )
CALL DLAMC4( GPMIN, A, LBETA )
CALL DLAMC4( GNMIN, -A, LBETA )
IEEE = .FALSE.
*
IF( ( NGPMIN.EQ.NGNMIN ) .AND. ( GPMIN.EQ.GNMIN ) ) THEN
IF( NGPMIN.EQ.GPMIN ) THEN
LEMIN = NGPMIN
* ( Non twos-complement machines, no gradual underflow;
* e.g., VAX )
ELSE IF( ( GPMIN-NGPMIN ).EQ.3 ) THEN
LEMIN = NGPMIN - 1 + LT
IEEE = .TRUE.
* ( Non twos-complement machines, with gradual underflow;
* e.g., IEEE standard followers )
ELSE
LEMIN = MIN( NGPMIN, GPMIN )
* ( A guess; no known machine )
IWARN = .TRUE.
END IF
*
ELSE IF( ( NGPMIN.EQ.GPMIN ) .AND. ( NGNMIN.EQ.GNMIN ) ) THEN
IF( ABS( NGPMIN-NGNMIN ).EQ.1 ) THEN
LEMIN = MAX( NGPMIN, NGNMIN )
* ( Twos-complement machines, no gradual underflow;
* e.g., CYBER 205 )
ELSE
LEMIN = MIN( NGPMIN, NGNMIN )
* ( A guess; no known machine )
IWARN = .TRUE.
END IF
*
ELSE IF( ( ABS( NGPMIN-NGNMIN ).EQ.1 ) .AND.
$ ( GPMIN.EQ.GNMIN ) ) THEN
IF( ( GPMIN-MIN( NGPMIN, NGNMIN ) ).EQ.3 ) THEN
LEMIN = MAX( NGPMIN, NGNMIN ) - 1 + LT
* ( Twos-complement machines with gradual underflow;
* no known machine )
ELSE
LEMIN = MIN( NGPMIN, NGNMIN )
* ( A guess; no known machine )
IWARN = .TRUE.
END IF
*
ELSE
LEMIN = MIN( NGPMIN, NGNMIN, GPMIN, GNMIN )
* ( A guess; no known machine )
IWARN = .TRUE.
END IF
FIRST = .FALSE.
***
* Comment out this if block if EMIN is ok
IF( IWARN ) THEN
FIRST = .TRUE.
WRITE( 6, FMT = 9999 )LEMIN
END IF
***
*
* Assume IEEE arithmetic if we found denormalised numbers above,
* or if arithmetic seems to round in the IEEE style, determined
* in routine DLAMC1. A true IEEE machine should have both things
* true; however, faulty machines may have one or the other.
*
IEEE = IEEE .OR. LIEEE1
*
* Compute RMIN by successive division by BETA. We could compute
* RMIN as BASE**( EMIN - 1 ), but some machines underflow during
* this computation.
*
LRMIN = 1
DO 30 I = 1, 1 - LEMIN
LRMIN = DLAMC3( LRMIN*RBASE, ZERO )
30 CONTINUE
*
* Finally, call DLAMC5 to compute EMAX and RMAX.
*
CALL DLAMC5( LBETA, LT, LEMIN, IEEE, LEMAX, LRMAX )
END IF
*
BETA = LBETA
T = LT
RND = LRND
EPS = LEPS
EMIN = LEMIN
RMIN = LRMIN
EMAX = LEMAX
RMAX = LRMAX
*
RETURN
*
9999 FORMAT( / / ' WARNING. The value EMIN may be incorrect:-',
$ ' EMIN = ', I8, /
$ ' If, after inspection, the value EMIN looks',
$ ' acceptable please comment out ',
$ / ' the IF block as marked within the code of routine',
$ ' DLAMC2,', / ' otherwise supply EMIN explicitly.', / )
*
* End of DLAMC2
*
END
*
************************************************************************
*
*> \brief \b DLAMC3
*> \details
*> \b Purpose:
*> \verbatim
*> DLAMC3 is intended to force A and B to be stored prior to doing
*> the addition of A and B , for use in situations where optimizers
*> might hold one of these in a register.
*> \endverbatim
*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
*> \date December 2016
*> \ingroup auxOTHERauxiliary
*>
*> \param[in] A
*> \verbatim
*> A is a DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] B
*> \verbatim
*> B is a DOUBLE PRECISION
*> The values A and B.
*> \endverbatim
*>
DOUBLE PRECISION FUNCTION DLAMC3( A, B )
*
* -- LAPACK auxiliary routine (version 3.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2006
* November 2010
*
* .. Scalar Arguments ..
DOUBLE PRECISION A, B
* ..
*
* Purpose
* =======
*
* DLAMC3 is intended to force A and B to be stored prior to doing
* the addition of A and B , for use in situations where optimizers
* might hold one of these in a register.
*
* Arguments
* =========
*
* A (input) DOUBLE PRECISION
* B (input) DOUBLE PRECISION
* The values A and B.
*
* =====================================================================
*
* .. Executable Statements ..
@ -608,245 +187,3 @@
END
*
************************************************************************
*
SUBROUTINE DLAMC4( EMIN, START, BASE )
*
* -- LAPACK auxiliary routine (version 3.2) --
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2006
*
* .. Scalar Arguments ..
INTEGER BASE, EMIN
DOUBLE PRECISION START
* ..
*
* Purpose
* =======
*
* DLAMC4 is a service routine for DLAMC2.
*
* Arguments
* =========
*
* EMIN (output) INTEGER
* The minimum exponent before (gradual) underflow, computed by
* setting A = START and dividing by BASE until the previous A
* can not be recovered.
*
* START (input) DOUBLE PRECISION
* The starting point for determining EMIN.
*
* BASE (input) INTEGER
* The base of the machine.
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I
DOUBLE PRECISION A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMC3
EXTERNAL DLAMC3
* ..
* .. Executable Statements ..
*
A = START
ONE = 1
RBASE = ONE / BASE
ZERO = 0
EMIN = 1
B1 = DLAMC3( A*RBASE, ZERO )
C1 = A
C2 = A
D1 = A
D2 = A
*+ WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
* $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP
10 CONTINUE
IF( ( C1.EQ.A ) .AND. ( C2.EQ.A ) .AND. ( D1.EQ.A ) .AND.
$ ( D2.EQ.A ) ) THEN
EMIN = EMIN - 1
A = B1
B1 = DLAMC3( A / BASE, ZERO )
C1 = DLAMC3( B1*BASE, ZERO )
D1 = ZERO
DO 20 I = 1, BASE
D1 = D1 + B1
20 CONTINUE
B2 = DLAMC3( A*RBASE, ZERO )
C2 = DLAMC3( B2 / RBASE, ZERO )
D2 = ZERO
DO 30 I = 1, BASE
D2 = D2 + B2
30 CONTINUE
GO TO 10
END IF
*+ END WHILE
*
RETURN
*
* End of DLAMC4
*
END
*
************************************************************************
*
SUBROUTINE DLAMC5( BETA, P, EMIN, IEEE, EMAX, RMAX )
*
* -- LAPACK auxiliary routine (version 3.2) --
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2006
*
* .. Scalar Arguments ..
LOGICAL IEEE
INTEGER BETA, EMAX, EMIN, P
DOUBLE PRECISION RMAX
* ..
*
* Purpose
* =======
*
* DLAMC5 attempts to compute RMAX, the largest machine floating-point
* number, without overflow. It assumes that EMAX + abs(EMIN) sum
* approximately to a power of 2. It will fail on machines where this
* assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
* EMAX = 28718). It will also fail if the value supplied for EMIN is
* too large (i.e. too close to zero), probably with overflow.
*
* Arguments
* =========
*
* BETA (input) INTEGER
* The base of floating-point arithmetic.
*
* P (input) INTEGER
* The number of base BETA digits in the mantissa of a
* floating-point value.
*
* EMIN (input) INTEGER
* The minimum exponent before (gradual) underflow.
*
* IEEE (input) LOGICAL
* A logical flag specifying whether or not the arithmetic
* system is thought to comply with the IEEE standard.
*
* EMAX (output) INTEGER
* The largest exponent before overflow
*
* RMAX (output) DOUBLE PRECISION
* The largest machine floating-point number.
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
INTEGER EXBITS, EXPSUM, I, LEXP, NBITS, TRY, UEXP
DOUBLE PRECISION OLDY, RECBAS, Y, Z
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMC3
EXTERNAL DLAMC3
* ..
* .. Intrinsic Functions ..
INTRINSIC MOD
* ..
* .. Executable Statements ..
*
* First compute LEXP and UEXP, two powers of 2 that bound
* abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
* approximately to the bound that is closest to abs(EMIN).
* (EMAX is the exponent of the required number RMAX).
*
LEXP = 1
EXBITS = 1
10 CONTINUE
TRY = LEXP*2
IF( TRY.LE.( -EMIN ) ) THEN
LEXP = TRY
EXBITS = EXBITS + 1
GO TO 10
END IF
IF( LEXP.EQ.-EMIN ) THEN
UEXP = LEXP
ELSE
UEXP = TRY
EXBITS = EXBITS + 1
END IF
*
* Now -LEXP is less than or equal to EMIN, and -UEXP is greater
* than or equal to EMIN. EXBITS is the number of bits needed to
* store the exponent.
*
IF( ( UEXP+EMIN ).GT.( -LEXP-EMIN ) ) THEN
EXPSUM = 2*LEXP
ELSE
EXPSUM = 2*UEXP
END IF
*
* EXPSUM is the exponent range, approximately equal to
* EMAX - EMIN + 1 .
*
EMAX = EXPSUM + EMIN - 1
NBITS = 1 + EXBITS + P
*
* NBITS is the total number of bits needed to store a
* floating-point number.
*
IF( ( MOD( NBITS, 2 ).EQ.1 ) .AND. ( BETA.EQ.2 ) ) THEN
*
* Either there are an odd number of bits used to store a
* floating-point number, which is unlikely, or some bits are
* not used in the representation of numbers, which is possible,
* (e.g. Cray machines) or the mantissa has an implicit bit,
* (e.g. IEEE machines, Dec Vax machines), which is perhaps the
* most likely. We have to assume the last alternative.
* If this is true, then we need to reduce EMAX by one because
* there must be some way of representing zero in an implicit-bit
* system. On machines like Cray, we are reducing EMAX by one
* unnecessarily.
*
EMAX = EMAX - 1
END IF
*
IF( IEEE ) THEN
*
* Assume we are on an IEEE machine which reserves one exponent
* for infinity and NaN.
*
EMAX = EMAX - 1
END IF
*
* Now create RMAX, the largest machine number, which should
* be equal to (1.0 - BETA**(-P)) * BETA**EMAX .
*
* First compute 1.0 - BETA**(-P), being careful that the
* result is less than 1.0 .
*
RECBAS = ONE / BETA
Z = BETA - ONE
Y = ZERO
DO 20 I = 1, P
Z = Z*RECBAS
IF( Y.LT.ONE )
$ OLDY = Y
Y = DLAMC3( Y, Z )
20 CONTINUE
IF( Y.GE.ONE )
$ Y = OLDY
*
* Now multiply by BETA**EMAX to get RMAX.
*
DO 30 I = 1, EMAX
Y = DLAMC3( Y*BETA, ZERO )
30 CONTINUE
*
RMAX = Y
RETURN
*
* End of DLAMC5
*
END

8
lib/linalg/dlamrg.f
View File

@ -50,7 +50,7 @@
*> \param[in] N2
*> \verbatim
*> N2 is INTEGER
*> These arguements contain the respective lengths of the two
*> These arguments contain the respective lengths of the two
*> sorted lists to be merged.
*> \endverbatim
*>
@ -92,17 +92,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
* =====================================================================
SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2016
*
* .. Scalar Arguments ..
INTEGER DTRD1, DTRD2, N1, N2

6
lib/linalg/dlange.f
View File

@ -107,17 +107,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleGEauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, 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, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER NORM

8
lib/linalg/dlanst.f
View File

@ -93,17 +93,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER NORM

6
lib/linalg/dlansy.f
View File

@ -115,17 +115,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleSYauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, 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, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER NORM, UPLO

20
lib/linalg/dlapy2.f
View File

@ -56,17 +56,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2017
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION X, Y
@ -82,12 +82,23 @@
* ..
* .. Local Scalars ..
DOUBLE PRECISION W, XABS, YABS, Z
LOGICAL X_IS_NAN, Y_IS_NAN
* ..
* .. External Functions ..
LOGICAL DISNAN
EXTERNAL DISNAN
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, SQRT
* ..
* .. Executable Statements ..
*
X_IS_NAN = DISNAN( X )
Y_IS_NAN = DISNAN( Y )
IF ( X_IS_NAN ) DLAPY2 = X
IF ( Y_IS_NAN ) DLAPY2 = Y
*
IF ( .NOT.( X_IS_NAN.OR.Y_IS_NAN ) ) THEN
XABS = ABS( X )
YABS = ABS( Y )
W = MAX( XABS, YABS )
@ -97,6 +108,7 @@
ELSE
DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
END IF
END IF
RETURN
*
* End of DLAPY2

8
lib/linalg/dlapy3.f
View File

@ -61,17 +61,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION X, Y, Z

6
lib/linalg/dlarf.f
View File

@ -117,17 +117,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERauxiliary
*
* =====================================================================
SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, 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, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER SIDE

264
lib/linalg/dlarfb.f
View File

@ -159,7 +159,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2013
*
*> \ingroup doubleOTHERauxiliary
*
@ -195,10 +195,10 @@
SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
$ T, LDT, C, LDC, WORK, LDWORK )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2013
*
* .. Scalar Arguments ..
CHARACTER DIRECT, SIDE, STOREV, TRANS
@ -217,12 +217,11 @@
* ..
* .. Local Scalars ..
CHARACTER TRANST
INTEGER I, J, LASTV, LASTC, lastv2
INTEGER I, J
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ILADLR, ILADLC
EXTERNAL LSAME, ILADLR, ILADLC
EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL DCOPY, DGEMM, DTRMM
@ -252,58 +251,53 @@
*
* Form H * C or H**T * C where C = ( C1 )
* ( C2 )
*
LASTV = MAX( K, ILADLR( M, K, V, LDV ) )
LASTC = ILADLC( LASTV, N, C, LDC )
*
* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
*
* W := C1**T
*
DO 10 J = 1, K
CALL DCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
10 CONTINUE
*
* W := W * V1
*
CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
$ LASTC, K, ONE, V, LDV, WORK, LDWORK )
IF( LASTV.GT.K ) THEN
CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
$ K, ONE, V, LDV, WORK, LDWORK )
IF( M.GT.K ) THEN
*
* W := W + C2**T * V2
*
CALL DGEMM( 'Transpose', 'No transpose',
$ LASTC, K, LASTV-K,
CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K,
$ ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
$ ONE, WORK, LDWORK )
END IF
*
* W := W * T**T or W * T
*
CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
$ LASTC, K, ONE, T, LDT, WORK, LDWORK )
CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
$ ONE, T, LDT, WORK, LDWORK )
*
* C := C - V * W**T
*
IF( LASTV.GT.K ) THEN
IF( M.GT.K ) THEN
*
* C2 := C2 - V2 * W**T
*
CALL DGEMM( 'No transpose', 'Transpose',
$ LASTV-K, LASTC, K,
CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K,
$ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
$ C( K+1, 1 ), LDC )
END IF
*
* W := W * V1**T
*
CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
$ LASTC, K, ONE, V, LDV, WORK, LDWORK )
CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K,
$ ONE, V, LDV, WORK, LDWORK )
*
* C1 := C1 - W**T
*
DO 30 J = 1, K
DO 20 I = 1, LASTC
DO 20 I = 1, N
C( J, I ) = C( J, I ) - WORK( I, J )
20 CONTINUE
30 CONTINUE
@ -311,58 +305,53 @@
ELSE IF( LSAME( SIDE, 'R' ) ) THEN
*
* Form C * H or C * H**T where C = ( C1 C2 )
*
LASTV = MAX( K, ILADLR( N, K, V, LDV ) )
LASTC = ILADLR( M, LASTV, C, LDC )
*
* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
*
* W := C1
*
DO 40 J = 1, K
CALL DCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
40 CONTINUE
*
* W := W * V1
*
CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
$ LASTC, K, ONE, V, LDV, WORK, LDWORK )
IF( LASTV.GT.K ) THEN
CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
$ K, ONE, V, LDV, WORK, LDWORK )
IF( N.GT.K ) THEN
*
* W := W + C2 * V2
*
CALL DGEMM( 'No transpose', 'No transpose',
$ LASTC, K, LASTV-K,
CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K,
$ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
$ ONE, WORK, LDWORK )
END IF
*
* W := W * T or W * T**T
*
CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
$ LASTC, K, ONE, T, LDT, WORK, LDWORK )
CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
$ ONE, T, LDT, WORK, LDWORK )
*
* C := C - W * V**T
*
IF( LASTV.GT.K ) THEN
IF( N.GT.K ) THEN
*
* C2 := C2 - W * V2**T
*
CALL DGEMM( 'No transpose', 'Transpose',
$ LASTC, LASTV-K, K,
CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K,
$ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
$ C( 1, K+1 ), LDC )
END IF
*
* W := W * V1**T
*
CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
$ LASTC, K, ONE, V, LDV, WORK, LDWORK )
CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K,
$ ONE, V, LDV, WORK, LDWORK )
*
* C1 := C1 - W
*
DO 60 J = 1, K
DO 50 I = 1, LASTC
DO 50 I = 1, M
C( I, J ) = C( I, J ) - WORK( I, J )
50 CONTINUE
60 CONTINUE
@ -378,36 +367,31 @@
*
* Form H * C or H**T * C where C = ( C1 )
* ( C2 )
*
LASTC = ILADLC( M, N, C, LDC )
*
* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
*
* W := C2**T
*
DO 70 J = 1, K
CALL DCOPY( LASTC, C( M-K+J, 1 ), LDC,
$ WORK( 1, J ), 1 )
CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
70 CONTINUE
*
* W := W * V2
*
CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
$ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
$ WORK, LDWORK )
CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
$ K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
IF( M.GT.K ) THEN
*
* W := W + C1**T * V1
*
CALL DGEMM( 'Transpose', 'No transpose',
$ LASTC, K, M-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K,
$ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
END IF
*
* W := W * T**T or W * T
*
CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
$ LASTC, K, ONE, T, LDT, WORK, LDWORK )
CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
$ ONE, T, LDT, WORK, LDWORK )
*
* C := C - V * W**T
*
@ -415,21 +399,19 @@
*
* C1 := C1 - V1 * W**T
*
CALL DGEMM( 'No transpose', 'Transpose',
$ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
$ ONE, C, LDC )
CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K,
$ -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
END IF
*
* W := W * V2**T
*
CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
$ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
$ WORK, LDWORK )
CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K,
$ ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
*
* C2 := C2 - W**T
*
DO 90 J = 1, K
DO 80 I = 1, LASTC
DO 80 I = 1, N
C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J )
80 CONTINUE
90 CONTINUE
@ -437,35 +419,31 @@
ELSE IF( LSAME( SIDE, 'R' ) ) THEN
*
* Form C * H or C * H**T where C = ( C1 C2 )
*
LASTC = ILADLR( M, N, C, LDC )
*
* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
*
* W := C2
*
DO 100 J = 1, K
CALL DCOPY( LASTC, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
100 CONTINUE
*
* W := W * V2
*
CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
$ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
$ WORK, LDWORK )
CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
$ K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
IF( N.GT.K ) THEN
*
* W := W + C1 * V1
*
CALL DGEMM( 'No transpose', 'No transpose',
$ LASTC, K, N-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K,
$ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
END IF
*
* W := W * T or W * T**T
*
CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
$ LASTC, K, ONE, T, LDT, WORK, LDWORK )
CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
$ ONE, T, LDT, WORK, LDWORK )
*
* C := C - W * V**T
*
@ -473,21 +451,19 @@
*
* C1 := C1 - W * V1**T
*
CALL DGEMM( 'No transpose', 'Transpose',
$ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
$ ONE, C, LDC )
CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K,
$ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
END IF
*
* W := W * V2**T
*
CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
$ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
$ WORK, LDWORK )
CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K,
$ ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
*
* C2 := C2 - W
*
DO 120 J = 1, K
DO 110 I = 1, LASTC
DO 110 I = 1, M
C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
110 CONTINUE
120 CONTINUE
@ -505,58 +481,53 @@
*
* Form H * C or H**T * C where C = ( C1 )
* ( C2 )
*
LASTV = MAX( K, ILADLC( K, M, V, LDV ) )
LASTC = ILADLC( LASTV, N, C, LDC )
*
* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
*
* W := C1**T
*
DO 130 J = 1, K
CALL DCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
130 CONTINUE
*
* W := W * V1**T
*
CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
$ LASTC, K, ONE, V, LDV, WORK, LDWORK )
IF( LASTV.GT.K ) THEN
CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K,
$ ONE, V, LDV, WORK, LDWORK )
IF( M.GT.K ) THEN
*
* W := W + C2**T * V2**T
*
CALL DGEMM( 'Transpose', 'Transpose',
$ LASTC, K, LASTV-K,
$ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
$ ONE, WORK, LDWORK )
CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE,
$ C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE,
$ WORK, LDWORK )
END IF
*
* W := W * T**T or W * T
*
CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
$ LASTC, K, ONE, T, LDT, WORK, LDWORK )
CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
$ ONE, T, LDT, WORK, LDWORK )
*
* C := C - V**T * W**T
*
IF( LASTV.GT.K ) THEN
IF( M.GT.K ) THEN
*
* C2 := C2 - V2**T * W**T
*
CALL DGEMM( 'Transpose', 'Transpose',
$ LASTV-K, LASTC, K,
$ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
$ ONE, C( K+1, 1 ), LDC )
CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE,
$ V( 1, K+1 ), LDV, WORK, LDWORK, ONE,
$ C( K+1, 1 ), LDC )
END IF
*
* W := W * V1
*
CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
$ LASTC, K, ONE, V, LDV, WORK, LDWORK )
CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
$ K, ONE, V, LDV, WORK, LDWORK )
*
* C1 := C1 - W**T
*
DO 150 J = 1, K
DO 140 I = 1, LASTC
DO 140 I = 1, N
C( J, I ) = C( J, I ) - WORK( I, J )
140 CONTINUE
150 CONTINUE
@ -564,58 +535,53 @@
ELSE IF( LSAME( SIDE, 'R' ) ) THEN
*
* Form C * H or C * H**T where C = ( C1 C2 )
*
LASTV = MAX( K, ILADLC( K, N, V, LDV ) )
LASTC = ILADLR( M, LASTV, C, LDC )
*
* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
*
* W := C1
*
DO 160 J = 1, K
CALL DCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
160 CONTINUE
*
* W := W * V1**T
*
CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
$ LASTC, K, ONE, V, LDV, WORK, LDWORK )
IF( LASTV.GT.K ) THEN
CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K,
$ ONE, V, LDV, WORK, LDWORK )
IF( N.GT.K ) THEN
*
* W := W + C2 * V2**T
*
CALL DGEMM( 'No transpose', 'Transpose',
$ LASTC, K, LASTV-K,
CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K,
$ ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
$ ONE, WORK, LDWORK )
END IF
*
* W := W * T or W * T**T
*
CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
$ LASTC, K, ONE, T, LDT, WORK, LDWORK )
CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
$ ONE, T, LDT, WORK, LDWORK )
*
* C := C - W * V
*
IF( LASTV.GT.K ) THEN
IF( N.GT.K ) THEN
*
* C2 := C2 - W * V2
*
CALL DGEMM( 'No transpose', 'No transpose',
$ LASTC, LASTV-K, K,
$ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
$ ONE, C( 1, K+1 ), LDC )
CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K,
$ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE,
$ C( 1, K+1 ), LDC )
END IF
*
* W := W * V1
*
CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
$ LASTC, K, ONE, V, LDV, WORK, LDWORK )
CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
$ K, ONE, V, LDV, WORK, LDWORK )
*
* C1 := C1 - W
*
DO 180 J = 1, K
DO 170 I = 1, LASTC
DO 170 I = 1, M
C( I, J ) = C( I, J ) - WORK( I, J )
170 CONTINUE
180 CONTINUE
@ -631,36 +597,31 @@
*
* Form H * C or H**T * C where C = ( C1 )
* ( C2 )
*
LASTC = ILADLC( M, N, C, LDC )
*
* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
*
* W := C2**T
*
DO 190 J = 1, K
CALL DCOPY( LASTC, C( M-K+J, 1 ), LDC,
$ WORK( 1, J ), 1 )
CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
190 CONTINUE
*
* W := W * V2**T
*
CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
$ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
$ WORK, LDWORK )
CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K,
$ ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
IF( M.GT.K ) THEN
*
* W := W + C1**T * V1**T
*
CALL DGEMM( 'Transpose', 'Transpose',
$ LASTC, K, M-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE,
$ C, LDC, V, LDV, ONE, WORK, LDWORK )
END IF
*
* W := W * T**T or W * T
*
CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
$ LASTC, K, ONE, T, LDT, WORK, LDWORK )
CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
$ ONE, T, LDT, WORK, LDWORK )
*
* C := C - V**T * W**T
*
@ -668,58 +629,51 @@
*
* C1 := C1 - V1**T * W**T
*
CALL DGEMM( 'Transpose', 'Transpose',
$ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
$ ONE, C, LDC )
CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE,
$ V, LDV, WORK, LDWORK, ONE, C, LDC )
END IF
*
* W := W * V2
*
CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
$ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
$ WORK, LDWORK )
CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
$ K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
*
* C2 := C2 - W**T
*
DO 210 J = 1, K
DO 200 I = 1, LASTC
DO 200 I = 1, N
C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J )
200 CONTINUE
210 CONTINUE
*
ELSE IF( LSAME( SIDE, 'R' ) ) THEN
*
* Form C * H or C * H**T where C = ( C1 C2 )
*
LASTC = ILADLR( M, N, C, LDC )
* Form C * H or C * H' where C = ( C1 C2 )
*
* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
*
* W := C2
*
DO 220 J = 1, K
CALL DCOPY( LASTC, C( 1, N-K+J ), 1,
$ WORK( 1, J ), 1 )
CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
220 CONTINUE
*
* W := W * V2**T
*
CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
$ LASTC, K, ONE, V( 1, N-K+1 ), LDV,
$ WORK, LDWORK )
CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K,
$ ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
IF( N.GT.K ) THEN
*
* W := W + C1 * V1**T
*
CALL DGEMM( 'No transpose', 'Transpose',
$ LASTC, K, N-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K,
$ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
END IF
*
* W := W * T or W * T**T
*
CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
$ LASTC, K, ONE, T, LDT, WORK, LDWORK )
CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
$ ONE, T, LDT, WORK, LDWORK )
*
* C := C - W * V
*
@ -727,21 +681,19 @@
*
* C1 := C1 - W * V1
*
CALL DGEMM( 'No transpose', 'No transpose',
$ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
$ ONE, C, LDC )
CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K,
$ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
END IF
*
* W := W * V2
*
CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
$ LASTC, K, ONE, V( 1, N-K+1 ), LDV,
$ WORK, LDWORK )
CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
$ K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
*
* C1 := C1 - W
*
DO 240 J = 1, K
DO 230 I = 1, LASTC
DO 230 I = 1, M
C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
230 CONTINUE
240 CONTINUE

6
lib/linalg/dlarfg.f
View File

@ -99,17 +99,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERauxiliary
*
* =====================================================================
SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INCX, N

6
lib/linalg/dlarft.f
View File

@ -130,7 +130,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERauxiliary
*
@ -163,10 +163,10 @@
* =====================================================================
SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER DIRECT, STOREV

8
lib/linalg/dlartg.f
View File

@ -90,17 +90,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE DLARTG( F, G, CS, SN, R )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION CS, F, G, R, SN

8
lib/linalg/dlas2.f
View File

@ -78,9 +78,9 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
*> \par Further Details:
* =====================
@ -107,10 +107,10 @@
* =====================================================================
SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION F, G, H, SSMAX, SSMIN

14
lib/linalg/dlascl.f
View File

@ -114,7 +114,11 @@
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> The leading dimension of the array A.
*> If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M);
*> TYPE = 'B', LDA >= KL+1;
*> TYPE = 'Q', LDA >= KU+1;
*> TYPE = 'Z', LDA >= 2*KL+KU+1.
*> \endverbatim
*>
*> \param[out] INFO
@ -132,17 +136,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2016
*
* .. Scalar Arguments ..
CHARACTER TYPE

10
lib/linalg/dlaset.f
View File

@ -77,7 +77,7 @@
*> The constant to which the diagonal elements are to be set.
*> \endverbatim
*>
*> \param[in,out] A
*> \param[out] A
*> \verbatim
*> A is DOUBLE PRECISION array, dimension (LDA,N)
*> On exit, the leading m-by-n submatrix of A is set as follows:
@ -103,17 +103,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER UPLO

8
lib/linalg/dlasq1.f
View File

@ -101,17 +101,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
* =====================================================================
SUBROUTINE DLASQ1( N, D, E, WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, N
@ -144,7 +144,7 @@
*
INFO = 0
IF( N.LT.0 ) THEN
INFO = -2
INFO = -1
CALL XERBLA( 'DLASQ1', -INFO )
RETURN
ELSE IF( N.EQ.0 ) THEN

6
lib/linalg/dlasq2.f
View File

@ -95,7 +95,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
@ -112,10 +112,10 @@
* =====================================================================
SUBROUTINE DLASQ2( N, Z, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, N

22
lib/linalg/dlasq3.f
View File

@ -58,9 +58,9 @@
*> Last index.
*> \endverbatim
*>
*> \param[in] Z
*> \param[in,out] Z
*> \verbatim
*> Z is DOUBLE PRECISION array, dimension ( 4*N )
*> Z is DOUBLE PRECISION array, dimension ( 4*N0 )
*> Z holds the qd array.
*> \endverbatim
*>
@ -97,22 +97,22 @@
*> Maximum value of q.
*> \endverbatim
*>
*> \param[out] NFAIL
*> \param[in,out] NFAIL
*> \verbatim
*> NFAIL is INTEGER
*> Number of times shift was too big.
*> Increment NFAIL by 1 each time the shift was too big.
*> \endverbatim
*>
*> \param[out] ITER
*> \param[in,out] ITER
*> \verbatim
*> ITER is INTEGER
*> Number of iterations.
*> Increment ITER by 1 for each iteration.
*> \endverbatim
*>
*> \param[out] NDIV
*> \param[in,out] NDIV
*> \verbatim
*> NDIV is INTEGER
*> Number of divisions.
*> Increment NDIV by 1 for each division.
*> \endverbatim
*>
*> \param[in] IEEE
@ -173,7 +173,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
@ -182,10 +182,10 @@
$ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
$ DN2, G, TAU )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2016
*
* .. Scalar Arguments ..
LOGICAL IEEE

11
lib/linalg/dlasq4.f
View File

@ -56,7 +56,7 @@
*>
*> \param[in] Z
*> \verbatim
*> Z is DOUBLE PRECISION array, dimension ( 4*N )
*> Z is DOUBLE PRECISION array, dimension ( 4*N0 )
*> Z holds the qd array.
*> \endverbatim
*>
@ -122,7 +122,7 @@
*>
*> \param[in,out] G
*> \verbatim
*> G is REAL
*> G is DOUBLE PRECISION
*> G is passed as an argument in order to save its value between
*> calls to DLASQ4.
*> \endverbatim
@ -135,7 +135,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
@ -151,10 +151,10 @@
SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
$ DN1, DN2, TAU, TTYPE, G )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2016
*
* .. Scalar Arguments ..
INTEGER I0, N0, N0IN, PP, TTYPE
@ -240,7 +240,6 @@
NP = NN - 9
ELSE
NP = NN - 2*PP
B2 = Z( NP-2 )
GAM = DN1
IF( Z( NP-4 ) .GT. Z( NP-2 ) )
$ RETURN

8
lib/linalg/dlasq5.f
View File

@ -121,7 +121,7 @@
*> IEEE is LOGICAL
*> Flag for IEEE or non IEEE arithmetic.
*> \endverbatim
*
*>
*> \param[in] EPS
*> \verbatim
*> EPS is DOUBLE PRECISION
@ -136,7 +136,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
@ -144,10 +144,10 @@
SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2,
$ DN, DNM1, DNM2, IEEE, EPS )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2017
*
* .. Scalar Arguments ..
LOGICAL IEEE

6
lib/linalg/dlasq6.f
View File

@ -111,7 +111,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
@ -119,10 +119,10 @@
SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
$ DNM1, DNM2 )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER I0, N0, PP

8
lib/linalg/dlasr.f
View File

@ -192,17 +192,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER DIRECT, PIVOT, SIDE

8
lib/linalg/dlasrt.f
View File

@ -81,17 +81,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
* =====================================================================
SUBROUTINE DLASRT( ID, N, D, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2016
*
* .. Scalar Arguments ..
CHARACTER ID
@ -123,7 +123,7 @@
* ..
* .. Executable Statements ..
*
* Test the input paramters.
* Test the input parameters.
*
INFO = 0
DIR = -1

8
lib/linalg/dlassq.f
View File

@ -96,17 +96,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INCX, N

8
lib/linalg/dlasv2.f
View File

@ -107,9 +107,9 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*> \ingroup OTHERauxiliary
*
*> \par Further Details:
* =====================
@ -138,10 +138,10 @@
* =====================================================================
SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN

24
lib/linalg/dlaswp.f
View File

@ -71,22 +71,23 @@
*> \param[in] K2
*> \verbatim
*> K2 is INTEGER
*> The last element of IPIV for which a row interchange will
*> be done.
*> (K2-K1+1) is the number of elements of IPIV for which a row
*> interchange will be done.
*> \endverbatim
*>
*> \param[in] IPIV
*> \verbatim
*> IPIV is INTEGER array, dimension (K2*abs(INCX))
*> IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
*> The vector of pivot indices. Only the elements in positions
*> K1 through K2 of IPIV are accessed.
*> IPIV(K) = L implies rows K and L are to be interchanged.
*> K1 through K1+(K2-K1)*abs(INCX) of IPIV are accessed.
*> IPIV(K1+(K-K1)*abs(INCX)) = L implies rows K and L are to be
*> interchanged.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> The increment between successive values of IPIV. If IPIV
*> The increment between successive values of IPIV. If INCX
*> is negative, the pivots are applied in reverse order.
*> \endverbatim
*
@ -98,7 +99,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date June 2017
*
*> \ingroup doubleOTHERauxiliary
*
@ -114,10 +115,10 @@
* =====================================================================
SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* June 2017
*
* .. Scalar Arguments ..
INTEGER INCX, K1, K2, LDA, N
@ -135,7 +136,8 @@
* ..
* .. Executable Statements ..
*
* Interchange row I with row IPIV(I) for each of rows K1 through K2.
* Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
* K1 through K2.
*
IF( INCX.GT.0 ) THEN
IX0 = K1
@ -143,7 +145,7 @@
I2 = K2
INC = 1
ELSE IF( INCX.LT.0 ) THEN
IX0 = 1 + ( 1-K2 )*INCX
IX0 = K1 + ( K1-K2 )*INCX
I1 = K2
I2 = K1
INC = -1

6
lib/linalg/dlatrd.f
View File

@ -139,7 +139,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERauxiliary
*
@ -198,10 +198,10 @@
* =====================================================================
SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER UPLO

6
lib/linalg/dlatrs.f
View File

@ -158,7 +158,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERauxiliary
*
@ -238,10 +238,10 @@
SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
$ CNORM, INFO )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER DIAG, NORMIN, TRANS, UPLO

26
lib/linalg/dnrm2.f
View File

@ -29,6 +29,26 @@
*> DNRM2 := sqrt( x'*x )
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in] X
*> \verbatim
*> X is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of DX
*> \endverbatim
*
* Authors:
* ========
*
@ -37,7 +57,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level1
*
@ -54,10 +74,10 @@
* =====================================================================
DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
*
* -- Reference BLAS level1 routine (version 3.4.0) --
* -- Reference BLAS level1 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INCX,N

6
lib/linalg/dorg2l.f
View File

@ -107,17 +107,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
* =====================================================================
SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDA, M, N

6
lib/linalg/dorg2r.f
View File

@ -107,17 +107,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
* =====================================================================
SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDA, M, N

5
lib/linalg/dorgbr.f
View File

@ -157,7 +157,7 @@
* =====================================================================
SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.1) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
@ -182,8 +182,7 @@
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV
EXTERNAL LSAME, ILAENV
EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL DORGLQ, DORGQR, XERBLA

6
lib/linalg/dorgl2.f
View File

@ -106,17 +106,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
* =====================================================================
SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDA, M, N

6
lib/linalg/dorglq.f
View File

@ -120,17 +120,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
* =====================================================================
SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDA, LWORK, M, N

6
lib/linalg/dorgql.f
View File

@ -121,17 +121,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
* =====================================================================
SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDA, LWORK, M, N

6
lib/linalg/dorgqr.f
View File

@ -121,17 +121,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
* =====================================================================
SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDA, LWORK, M, N

6
lib/linalg/dorgtr.f
View File

@ -116,17 +116,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
* =====================================================================
SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER UPLO

6
lib/linalg/dorm2l.f
View File

@ -151,7 +151,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
@ -159,10 +159,10 @@
SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
$ WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS

6
lib/linalg/dorm2r.f
View File

@ -151,7 +151,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
@ -159,10 +159,10 @@
SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
$ WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS

6
lib/linalg/dormbr.f
View File

@ -187,7 +187,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
@ -195,10 +195,10 @@
SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
$ LDC, WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS, VECT

6
lib/linalg/dorml2.f
View File

@ -151,7 +151,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
@ -159,10 +159,10 @@
SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
$ WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS

39
lib/linalg/dormlq.f
View File

@ -136,9 +136,7 @@
*> The dimension of the array WORK.
*> If SIDE = 'L', LWORK >= max(1,N);
*> if SIDE = 'R', LWORK >= max(1,M).
*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
*> blocksize.
*> For good performance, LWORK should generally be larger.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@ -161,7 +159,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
@ -169,10 +167,10 @@
SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
$ WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
@ -185,18 +183,16 @@
* =====================================================================
*
* .. Parameters ..
INTEGER NBMAX, LDT
PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
INTEGER NBMAX, LDT, TSIZE
PARAMETER ( NBMAX = 64, LDT = NBMAX+1,
$ TSIZE = LDT*NBMAX )
* ..
* .. Local Scalars ..
LOGICAL LEFT, LQUERY, NOTRAN
CHARACTER TRANST
INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
INTEGER I, I1, I2, I3, IB, IC, IINFO, IWT, JC, LDWORK,
$ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
* ..
* .. Local Arrays ..
DOUBLE PRECISION T( LDT, NBMAX )
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV
@ -246,12 +242,11 @@
*
IF( INFO.EQ.0 ) THEN
*
* Determine the block size. NB may be at most NBMAX, where NBMAX
* is used to define the local array T.
* Compute the workspace requirements
*
NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, K,
$ -1 ) )
LWKOPT = MAX( 1, NW )*NB
LWKOPT = MAX( 1, NW )*NB + TSIZE
WORK( 1 ) = LWKOPT
END IF
*
@ -272,14 +267,11 @@
NBMIN = 2
LDWORK = NW
IF( NB.GT.1 .AND. NB.LT.K ) THEN
IWS = NW*NB
IF( LWORK.LT.IWS ) THEN
NB = LWORK / LDWORK
IF( LWORK.LT.NW*NB+TSIZE ) THEN
NB = (LWORK-TSIZE) / LDWORK
NBMIN = MAX( 2, ILAENV( 2, 'DORMLQ', SIDE // TRANS, M, N, K,
$ -1 ) )
END IF
ELSE
IWS = NW
END IF
*
IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
@ -292,6 +284,7 @@
*
* Use blocked code
*
IWT = 1 + NW*NB
IF( ( LEFT .AND. NOTRAN ) .OR.
$ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
I1 = 1
@ -324,7 +317,7 @@
* H = H(i) H(i+1) . . . H(i+ib-1)
*
CALL DLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ),
$ LDA, TAU( I ), T, LDT )
$ LDA, TAU( I ), WORK( IWT ), LDT )
IF( LEFT ) THEN
*
* H or H**T is applied to C(i:m,1:n)
@ -342,8 +335,8 @@
* Apply H or H**T
*
CALL DLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB,
$ A( I, I ), LDA, T, LDT, C( IC, JC ), LDC, WORK,
$ LDWORK )
$ A( I, I ), LDA, WORK( IWT ), LDT,
$ C( IC, JC ), LDC, WORK, LDWORK )
10 CONTINUE
END IF
WORK( 1 ) = LWKOPT

49
lib/linalg/dormql.f
View File

@ -136,9 +136,7 @@
*> The dimension of the array WORK.
*> If SIDE = 'L', LWORK >= max(1,N);
*> if SIDE = 'R', LWORK >= max(1,M).
*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
*> blocksize.
*> For good performance, LWORK should generally be larger.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@ -161,7 +159,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
@ -169,10 +167,10 @@
SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
$ WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
@ -185,17 +183,15 @@
* =====================================================================
*
* .. Parameters ..
INTEGER NBMAX, LDT
PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
INTEGER NBMAX, LDT, TSIZE
PARAMETER ( NBMAX = 64, LDT = NBMAX+1,
$ TSIZE = LDT*NBMAX )
* ..
* .. Local Scalars ..
LOGICAL LEFT, LQUERY, NOTRAN
INTEGER I, I1, I2, I3, IB, IINFO, IWS, LDWORK, LWKOPT,
INTEGER I, I1, I2, I3, IB, IINFO, IWT, LDWORK, LWKOPT,
$ MI, NB, NBMIN, NI, NQ, NW
* ..
* .. Local Arrays ..
DOUBLE PRECISION T( LDT, NBMAX )
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV
@ -239,25 +235,22 @@
INFO = -7
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -10
ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN
INFO = -12
END IF
*
IF( INFO.EQ.0 ) THEN
*
* Compute the workspace requirements
*
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
LWKOPT = 1
ELSE
*
* Determine the block size. NB may be at most NBMAX, where
* NBMAX is used to define the local array T.
*
NB = MIN( NBMAX, ILAENV( 1, 'DORMQL', SIDE // TRANS, M, N,
$ K, -1 ) )
LWKOPT = NW*NB
LWKOPT = NW*NB + TSIZE
END IF
WORK( 1 ) = LWKOPT
*
IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN
INFO = -12
END IF
END IF
*
IF( INFO.NE.0 ) THEN
@ -276,14 +269,11 @@
NBMIN = 2
LDWORK = NW
IF( NB.GT.1 .AND. NB.LT.K ) THEN
IWS = NW*NB
IF( LWORK.LT.IWS ) THEN
NB = LWORK / LDWORK
IF( LWORK.LT.NW*NB+TSIZE ) THEN
NB = (LWORK-TSIZE) / LDWORK
NBMIN = MAX( 2, ILAENV( 2, 'DORMQL', SIDE // TRANS, M, N, K,
$ -1 ) )
END IF
ELSE
IWS = NW
END IF
*
IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
@ -296,6 +286,7 @@
*
* Use blocked code
*
IWT = 1 + NW*NB
IF( ( LEFT .AND. NOTRAN ) .OR.
$ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
I1 = 1
@ -320,7 +311,7 @@
* H = H(i+ib-1) . . . H(i+1) H(i)
*
CALL DLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB,
$ A( 1, I ), LDA, TAU( I ), T, LDT )
$ A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT )
IF( LEFT ) THEN
*
* H or H**T is applied to C(1:m-k+i+ib-1,1:n)
@ -336,8 +327,8 @@
* Apply H or H**T
*
CALL DLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI,
$ IB, A( 1, I ), LDA, T, LDT, C, LDC, WORK,
$ LDWORK )
$ IB, A( 1, I ), LDA, WORK( IWT ), LDT, C, LDC,
$ WORK, LDWORK )
10 CONTINUE
END IF
WORK( 1 ) = LWKOPT

39
lib/linalg/dormqr.f
View File

@ -136,9 +136,7 @@
*> The dimension of the array WORK.
*> If SIDE = 'L', LWORK >= max(1,N);
*> if SIDE = 'R', LWORK >= max(1,M).
*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
*> blocksize.
*> For good performance, LWORK should generally be larger.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@ -161,7 +159,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
@ -169,10 +167,10 @@
SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
$ WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
@ -185,17 +183,15 @@
* =====================================================================
*
* .. Parameters ..
INTEGER NBMAX, LDT
PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
INTEGER NBMAX, LDT, TSIZE
PARAMETER ( NBMAX = 64, LDT = NBMAX+1,
$ TSIZE = LDT*NBMAX )
* ..
* .. Local Scalars ..
LOGICAL LEFT, LQUERY, NOTRAN
INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
INTEGER I, I1, I2, I3, IB, IC, IINFO, IWT, JC, LDWORK,
$ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
* ..
* .. Local Arrays ..
DOUBLE PRECISION T( LDT, NBMAX )
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV
@ -245,12 +241,11 @@
*
IF( INFO.EQ.0 ) THEN
*
* Determine the block size. NB may be at most NBMAX, where NBMAX
* is used to define the local array T.
* Compute the workspace requirements
*
NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K,
$ -1 ) )
LWKOPT = MAX( 1, NW )*NB
LWKOPT = MAX( 1, NW )*NB + TSIZE
WORK( 1 ) = LWKOPT
END IF
*
@ -271,14 +266,11 @@
NBMIN = 2
LDWORK = NW
IF( NB.GT.1 .AND. NB.LT.K ) THEN
IWS = NW*NB
IF( LWORK.LT.IWS ) THEN
NB = LWORK / LDWORK
IF( LWORK.LT.NW*NB+TSIZE ) THEN
NB = (LWORK-TSIZE) / LDWORK
NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS, M, N, K,
$ -1 ) )
END IF
ELSE
IWS = NW
END IF
*
IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
@ -291,6 +283,7 @@
*
* Use blocked code
*
IWT = 1 + NW*NB
IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
$ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
I1 = 1
@ -317,7 +310,7 @@
* H = H(i) H(i+1) . . . H(i+ib-1)
*
CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ),
$ LDA, TAU( I ), T, LDT )
$ LDA, TAU( I ), WORK( IWT ), LDT )
IF( LEFT ) THEN
*
* H or H**T is applied to C(i:m,1:n)
@ -335,8 +328,8 @@
* Apply H or H**T
*
CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI,
$ IB, A( I, I ), LDA, T, LDT, C( IC, JC ), LDC,
$ WORK, LDWORK )
$ IB, A( I, I ), LDA, WORK( IWT ), LDT,
$ C( IC, JC ), LDC, WORK, LDWORK )
10 CONTINUE
END IF
WORK( 1 ) = LWKOPT

6
lib/linalg/dormtr.f
View File

@ -163,7 +163,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleOTHERcomputational
*
@ -171,10 +171,10 @@
SUBROUTINE DORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC,
$ WORK, LWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS, UPLO

6
lib/linalg/dpotf2.f
View File

@ -102,17 +102,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doublePOcomputational
*
* =====================================================================
SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER UPLO

14
lib/linalg/dpotrf.f
View File

@ -100,17 +100,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doublePOcomputational
*
* =====================================================================
SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER UPLO
@ -136,7 +136,7 @@
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
EXTERNAL DGEMM, DPOTF2, DSYRK, DTRSM, XERBLA
EXTERNAL DGEMM, DPOTRF2, DSYRK, DTRSM, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
@ -171,7 +171,7 @@
*
* Use unblocked code.
*
CALL DPOTF2( UPLO, N, A, LDA, INFO )
CALL DPOTRF2( UPLO, N, A, LDA, INFO )
ELSE
*
* Use blocked code.
@ -188,7 +188,7 @@
JB = MIN( NB, N-J+1 )
CALL DSYRK( 'Upper', 'Transpose', JB, J-1, -ONE,
$ A( 1, J ), LDA, ONE, A( J, J ), LDA )
CALL DPOTF2( 'Upper', JB, A( J, J ), LDA, INFO )
CALL DPOTRF2( 'Upper', JB, A( J, J ), LDA, INFO )
IF( INFO.NE.0 )
$ GO TO 30
IF( J+JB.LE.N ) THEN
@ -216,7 +216,7 @@
JB = MIN( NB, N-J+1 )
CALL DSYRK( 'Lower', 'No transpose', JB, J-1, -ONE,
$ A( J, 1 ), LDA, ONE, A( J, J ), LDA )
CALL DPOTF2( 'Lower', JB, A( J, J ), LDA, INFO )
CALL DPOTRF2( 'Lower', JB, A( J, J ), LDA, INFO )
IF( INFO.NE.0 )
$ GO TO 30
IF( J+JB.LE.N ) THEN

47
lib/linalg/drot.f
View File

@ -27,6 +27,47 @@
*> DROT applies a plane rotation.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in,out] DX
*> \verbatim
*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of DX
*> \endverbatim
*>
*> \param[in,out] DY
*> \verbatim
*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> storage spacing between elements of DY
*> \endverbatim
*>
*> \param[in] C
*> \verbatim
*> C is DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] S
*> \verbatim
*> S is DOUBLE PRECISION
*> \endverbatim
*
* Authors:
* ========
*
@ -35,7 +76,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level1
*
@ -51,10 +92,10 @@
* =====================================================================
SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S)
*
* -- Reference BLAS level1 routine (version 3.4.0) --
* -- Reference BLAS level1 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION C,S

6
lib/linalg/drscl.f
View File

@ -77,17 +77,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleOTHERauxiliary
*
* =====================================================================
SUBROUTINE DRSCL( N, SA, SX, INCX )
*
* -- LAPACK auxiliary routine (version 3.4.2) --
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
INTEGER INCX, N

34
lib/linalg/dscal.f
View File

@ -25,7 +25,33 @@
*> \verbatim
*>
*> DSCAL scales a vector by a constant.
*> uses unrolled loops for increment equal to one.
*> uses unrolled loops for increment equal to 1.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in] DA
*> \verbatim
*> DA is DOUBLE PRECISION
*> On entry, DA specifies the scalar alpha.
*> \endverbatim
*>
*> \param[in,out] DX
*> \verbatim
*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of DX
*> \endverbatim
*
* Authors:
@ -36,7 +62,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level1
*
@ -53,10 +79,10 @@
* =====================================================================
SUBROUTINE DSCAL(N,DA,DX,INCX)
*
* -- Reference BLAS level1 routine (version 3.4.0) --
* -- Reference BLAS level1 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
DOUBLE PRECISION DA

17
lib/linalg/dstedc.f
View File

@ -1,4 +1,4 @@
*> \brief \b DSTEBZ
*> \brief \b DSTEDC
*
* =========== DOCUMENTATION ===========
*
@ -105,8 +105,7 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is DOUBLE PRECISION array,
*> dimension (LWORK)
*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
@ -174,7 +173,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
@ -189,10 +188,10 @@
SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
$ LIWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* June 2017
*
* .. Scalar Arguments ..
CHARACTER COMPZ
@ -443,11 +442,6 @@
*
* endwhile
*
* If the problem split any number of times, then the eigenvalues
* will not be properly ordered. Here we permute the eigenvalues
* (and the associated eigenvectors) into ascending order.
*
IF( M.NE.N ) THEN
IF( ICOMPZ.EQ.0 ) THEN
*
* Use Quick Sort
@ -476,7 +470,6 @@
40 CONTINUE
END IF
END IF
END IF
*
50 CONTINUE
WORK( 1 ) = LWMIN

6
lib/linalg/dsteqr.f
View File

@ -124,17 +124,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
* =====================================================================
SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER COMPZ

6
lib/linalg/dsterf.f
View File

@ -79,17 +79,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup auxOTHERcomputational
*
* =====================================================================
SUBROUTINE DSTERF( N, D, E, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INFO, N

41
lib/linalg/dswap.f
View File

@ -23,8 +23,39 @@
*>
*> \verbatim
*>
*> interchanges two vectors.
*> uses unrolled loops for increments equal one.
*> DSWAP interchanges two vectors.
*> uses unrolled loops for increments equal to 1.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in,out] DX
*> \verbatim
*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of DX
*> \endverbatim
*>
*> \param[in,out] DY
*> \verbatim
*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> storage spacing between elements of DY
*> \endverbatim
*
* Authors:
@ -35,7 +66,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup double_blas_level1
*
@ -51,10 +82,10 @@
* =====================================================================
SUBROUTINE DSWAP(N,DX,INCX,DY,INCY)
*
* -- Reference BLAS level1 routine (version 3.4.0) --
* -- Reference BLAS level1 routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N

6
lib/linalg/dsyev.f
View File

@ -125,17 +125,17 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date December 2016
*
*> \ingroup doubleSYeigen
*
* =====================================================================
SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
*
* -- LAPACK driver routine (version 3.4.0) --
* -- LAPACK driver routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* December 2016
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO

6
lib/linalg/dsyevd.f
View File

@ -167,7 +167,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*> \date December 2016
*
*> \ingroup doubleSYeigen
*
@ -185,10 +185,10 @@
SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
$ LIWORK, INFO )
*
* -- LAPACK driver routine (version 3.4.2) --
* -- LAPACK driver routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
* December 2016
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO

Some files were not shown because too many files have changed in this diff Show More