From ed73c21a2104dfbfe02719422e924ab8f22c5633 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 19 Jul 2022 13:25:05 -0400 Subject: [PATCH 1/8] Set path to python interpreter when running in a virtual environment --- cmake/CMakeLists.txt | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/cmake/CMakeLists.txt b/cmake/CMakeLists.txt index 669bff1533..cf8e54b995 100644 --- a/cmake/CMakeLists.txt +++ b/cmake/CMakeLists.txt @@ -154,6 +154,19 @@ endif() ######################################################################## # User input options # ######################################################################## +# set path to python interpreter and thus enforcing python version if +# when in a virtual environment and PYTHON_EXECUTABLE is not set on command line +if(DEFINED ENV{VIRTUAL_ENV} AND NOT PYTHON_EXECUTABLE) + if(CMAKE_HOST_SYSTEM_NAME STREQUAL "Windows") + set(PYTHON_EXECUTABLE "$ENV{VIRTUAL_ENV}/Scripts/python.exe") + else() + set(PYTHON_EXECUTABLE "$ENV{VIRTUAL_ENV}/bin/python") + endif() + set(Python_EXECUTABLE "${PYTHON_EXECUTABLE}") + message(STATUS "Running in virtual environment: $ENV{VIRTUAL_ENV}\n" + " Setting Python interpreter to: ${PYTHON_EXECUTABLE}") +endif() + set(LAMMPS_MACHINE "" CACHE STRING "Suffix to append to lmp binary (WON'T enable any features automatically") mark_as_advanced(LAMMPS_MACHINE) if(LAMMPS_MACHINE) From b6550886577dedce2b6cde74526f3b81655dbd57 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 19 Jul 2022 13:26:50 -0400 Subject: [PATCH 2/8] adjust search for python interpreter so it is consistent with manual --- cmake/CMakeLists.txt | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/cmake/CMakeLists.txt b/cmake/CMakeLists.txt index cf8e54b995..a9b46671d8 100644 --- a/cmake/CMakeLists.txt +++ b/cmake/CMakeLists.txt @@ -795,9 +795,13 @@ if(BUILD_SHARED_LIBS) set(Python_ADDITIONAL_VERSIONS 3.12 3.11 3.10 3.9 3.8 3.7 3.6) find_package(PythonInterp) # Deprecated since version 3.12 if(PYTHONINTERP_FOUND) - set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) endif() else() + # backward compatibility + if(PYTHON_EXECUTABLE) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + endif() find_package(Python COMPONENTS Interpreter) endif() if(BUILD_IS_MULTI_CONFIG) @@ -830,11 +834,17 @@ endif() ############################################################################### if(BUILD_SHARED_LIBS OR PKG_PYTHON) if(CMAKE_VERSION VERSION_LESS 3.12) + # adjust so we find Python 3 versions before Python 2 on old systems with old CMake + set(Python_ADDITIONAL_VERSIONS 3.12 3.11 3.10 3.9 3.8 3.7 3.6) find_package(PythonInterp) # Deprecated since version 3.12 if(PYTHONINTERP_FOUND) - set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) endif() else() + # backward compatibility + if(PYTHON_EXECUTABLE) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + endif() find_package(Python COMPONENTS Interpreter) endif() if(Python_EXECUTABLE) From 5eec9da8fe4386c4ae027dc4e9340e105ebb5391 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 19 Jul 2022 13:28:43 -0400 Subject: [PATCH 3/8] make search for python libraries consistent with search for python interpreter - apply same semantics of selecting the interpreter than the main cmake script - make certain that we search for the interpreter first - when searching for the library find the version matching the interpreter - error out when library version and interpreter version does not match --- cmake/Modules/Packages/MDI.cmake | 13 +++++++++++++ cmake/Modules/Packages/PYTHON.cmake | 20 ++++++++++++++++++++ 2 files changed, 33 insertions(+) diff --git a/cmake/Modules/Packages/MDI.cmake b/cmake/Modules/Packages/MDI.cmake index 1a14d5273a..d873c8f6d1 100644 --- a/cmake/Modules/Packages/MDI.cmake +++ b/cmake/Modules/Packages/MDI.cmake @@ -26,8 +26,21 @@ if(DOWNLOAD_MDI) # detect if we have python development support and thus can enable python plugins set(MDI_USE_PYTHON_PLUGINS OFF) if(CMAKE_VERSION VERSION_LESS 3.12) + if(NOT PYTHON_VERSION_STRING) + set(Python_ADDITIONAL_VERSIONS 3.12 3.11 3.10 3.9 3.8 3.7 3.6) + # search for interpreter first, so we have a consistent library + find_package(PythonInterp) # Deprecated since version 3.12 + if(PYTHONINTERP_FOUND) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + endif() + endif() + # search for the library matching the selected interpreter + set(Python_ADDITIONAL_VERSIONS ${PYTHON_VERSION_MAJOR}.${PYTHON_VERSION_MINOR}) find_package(PythonLibs QUIET) # Deprecated since version 3.12 if(PYTHONLIBS_FOUND) + if(NOT (PYTHON_VERSION_STRING STREQUAL PYTHONLIBS_VERSION_STRING)) + message(FATAL_ERROR "Python Library version ${PYTHONLIBS_VERSION_STRING} does not match Interpreter version ${PYTHON_VERSION_STRING}") + endif() set(MDI_USE_PYTHON_PLUGINS ON) endif() else() diff --git a/cmake/Modules/Packages/PYTHON.cmake b/cmake/Modules/Packages/PYTHON.cmake index c94db88073..4a2925fe31 100644 --- a/cmake/Modules/Packages/PYTHON.cmake +++ b/cmake/Modules/Packages/PYTHON.cmake @@ -1,8 +1,28 @@ if(CMAKE_VERSION VERSION_LESS 3.12) + if(NOT PYTHON_VERSION_STRING) + set(Python_ADDITIONAL_VERSIONS 3.12 3.11 3.10 3.9 3.8 3.7 3.6) + # search for interpreter first, so we have a consistent library + find_package(PythonInterp) # Deprecated since version 3.12 + if(PYTHONINTERP_FOUND) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + endif() + endif() + # search for the library matching the selected interpreter + set(Python_ADDITIONAL_VERSIONS ${PYTHON_VERSION_MAJOR}.${PYTHON_VERSION_MINOR}) find_package(PythonLibs REQUIRED) # Deprecated since version 3.12 + if(NOT (PYTHON_VERSION_STRING STREQUAL PYTHONLIBS_VERSION_STRING)) + message(FATAL_ERROR "Python Library version ${PYTHONLIBS_VERSION_STRING} does not match Interpreter version ${PYTHON_VERSION_STRING}") + endif() target_include_directories(lammps PRIVATE ${PYTHON_INCLUDE_DIRS}) target_link_libraries(lammps PRIVATE ${PYTHON_LIBRARIES}) else() + if(NOT Python_INTERPRETER) + # backward compatibility + if(PYTHON_EXECUTABLE) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + endif() + find_package(Python COMPONENTS Interpreter) + endif() find_package(Python REQUIRED COMPONENTS Interpreter Development) target_link_libraries(lammps PRIVATE Python::Python) endif() From 3c99a6b5c41af1f35ff790198f49b68b828d09f2 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Wed, 20 Jul 2022 17:01:44 -0400 Subject: [PATCH 4/8] Correctly handle the dependency of pair style (and fix) srp/react on the MC package --- cmake/CMakeLists.txt | 2 +- cmake/Modules/Packages/MISC.cmake | 13 ++++++++ src/Depend.sh | 4 +++ src/MISC/Install.sh | 55 +++++++++++++++++++++++++++++++ 4 files changed, 73 insertions(+), 1 deletion(-) create mode 100644 cmake/Modules/Packages/MISC.cmake create mode 100644 src/MISC/Install.sh diff --git a/cmake/CMakeLists.txt b/cmake/CMakeLists.txt index a9b46671d8..ac7f88f939 100644 --- a/cmake/CMakeLists.txt +++ b/cmake/CMakeLists.txt @@ -648,7 +648,7 @@ endif() # packages which selectively include variants based on enabled styles # e.g. accelerator packages ###################################################################### -foreach(PKG_WITH_INCL CORESHELL DPD-SMOOTH PHONON QEQ OPENMP KOKKOS OPT INTEL GPU) +foreach(PKG_WITH_INCL CORESHELL DPD-SMOOTH MISC PHONON QEQ OPENMP KOKKOS OPT INTEL GPU) if(PKG_${PKG_WITH_INCL}) include(Packages/${PKG_WITH_INCL}) endif() diff --git a/cmake/Modules/Packages/MISC.cmake b/cmake/Modules/Packages/MISC.cmake new file mode 100644 index 0000000000..38207835a0 --- /dev/null +++ b/cmake/Modules/Packages/MISC.cmake @@ -0,0 +1,13 @@ +# pair style and fix srp/react depend on the fixes bond/break and bond/create from the MC package +if(NOT PKG_MC) + get_property(LAMMPS_FIX_HEADERS GLOBAL PROPERTY FIX) + list(REMOVE_ITEM LAMMPS_FIX_HEADERS ${LAMMPS_SOURCE_DIR}/MISC/fix_srp_react.h) + set_property(GLOBAL PROPERTY FIX "${LAMMPS_FIX_HEADERS}") + get_property(LAMMPS_PAIR_HEADERS GLOBAL PROPERTY PAIR) + list(REMOVE_ITEM LAMMPS_PAIR_HEADERS ${LAMMPS_SOURCE_DIR}/MISC/pair_srp_react.h) + set_property(GLOBAL PROPERTY PAIR "${LAMMPS_PAIR_HEADERS}") + get_target_property(LAMMPS_SOURCES lammps SOURCES) + list(REMOVE_ITEM LAMMPS_SOURCES ${LAMMPS_SOURCE_DIR}/MISC/fix_srp_react.cpp) + list(REMOVE_ITEM LAMMPS_SOURCES ${LAMMPS_SOURCE_DIR}/MISC/pair_srp_react.cpp) + set_property(TARGET lammps PROPERTY SOURCES "${LAMMPS_SOURCES}") +endif() diff --git a/src/Depend.sh b/src/Depend.sh index 5dd903f0bc..90dfdbba7a 100755 --- a/src/Depend.sh +++ b/src/Depend.sh @@ -128,6 +128,10 @@ if (test $1 = "MANYBODY") then depend OPENMP fi +if (test $1 = "MC") then + depend MISC +fi + if (test $1 = "MEAM") then depend KOKKOS fi diff --git a/src/MISC/Install.sh b/src/MISC/Install.sh new file mode 100644 index 0000000000..b6ba8a13fe --- /dev/null +++ b/src/MISC/Install.sh @@ -0,0 +1,55 @@ +# Install/Uninstall package files in LAMMPS +# mode = 0/1/2 for uninstall/install/update + +mode=$1 + +# enforce using portable C locale +LC_ALL=C +export LC_ALL + +# arg1 = file, arg2 = file it depends on + +action () { + if (test $mode = 0) then + rm -f ../$1 + elif (! cmp -s $1 ../$1) then + if (test -z "$2" || test -e ../$2) then + cp $1 .. + if (test $mode = 2) then + echo " updating src/$1" + fi + fi + elif (test -n "$2") then + if (test ! -e ../$2) then + rm -f ../$1 + fi + fi +} + +# package files without dependencies +action bond_special.cpp +action bond_special.h +action compute_viscosity_cos.cpp +action compute_viscosity_cos.h +action fix_accelerate_cos.cpp +action fix_accelerate_cos.h +action fix_imd.cpp +action fix_imd.h +action fix_ipi.cpp +action fix_ipi.h +action fix_srp.cpp +action fix_srp.h +action pair_agni.cpp +action pair_agni.h +action pair_list.cpp +action pair_list.h +action pair_srp.cpp +action pair_srp.h +action pair_tracker.cpp +action pair_tracker.h + +# package files with dependencies +action pair_srp_react.cpp fix_bond_break.h +action pair_srp_react.h fix_bond_break.h +action fix_srp_react.cpp fix_bond_break.h +action fix_srp_react.h fix_bond_break.h From bf65b4720f26d5b2dc90d1076a3ff7379784774d Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Thu, 21 Jul 2022 05:20:11 -0400 Subject: [PATCH 5/8] add more BLAS/LAPACK functions to support LATTE package --- lib/linalg/zdrot.f | 153 ++++++++++++++ lib/linalg/zheevd.f | 395 ++++++++++++++++++++++++++++++++++++ lib/linalg/zlacpy.f | 156 ++++++++++++++ lib/linalg/zlacrm.f | 182 +++++++++++++++++ lib/linalg/zlaed0.f | 368 +++++++++++++++++++++++++++++++++ lib/linalg/zlaed7.f | 382 +++++++++++++++++++++++++++++++++++ lib/linalg/zlaed8.f | 483 ++++++++++++++++++++++++++++++++++++++++++++ lib/linalg/zstedc.f | 483 ++++++++++++++++++++++++++++++++++++++++++++ lib/linalg/zunm2l.f | 278 +++++++++++++++++++++++++ lib/linalg/zunm2r.f | 283 ++++++++++++++++++++++++++ lib/linalg/zunmql.f | 336 ++++++++++++++++++++++++++++++ lib/linalg/zunmqr.f | 337 +++++++++++++++++++++++++++++++ lib/linalg/zunmtr.f | 307 ++++++++++++++++++++++++++++ 13 files changed, 4143 insertions(+) create mode 100644 lib/linalg/zdrot.f create mode 100644 lib/linalg/zheevd.f create mode 100644 lib/linalg/zlacpy.f create mode 100644 lib/linalg/zlacrm.f create mode 100644 lib/linalg/zlaed0.f create mode 100644 lib/linalg/zlaed7.f create mode 100644 lib/linalg/zlaed8.f create mode 100644 lib/linalg/zstedc.f create mode 100644 lib/linalg/zunm2l.f create mode 100644 lib/linalg/zunm2r.f create mode 100644 lib/linalg/zunmql.f create mode 100644 lib/linalg/zunmqr.f create mode 100644 lib/linalg/zunmtr.f diff --git a/lib/linalg/zdrot.f b/lib/linalg/zdrot.f new file mode 100644 index 0000000000..3145561d67 --- /dev/null +++ b/lib/linalg/zdrot.f @@ -0,0 +1,153 @@ +*> \brief \b ZDROT +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE ZDROT( N, ZX, INCX, ZY, INCY, C, S ) +* +* .. Scalar Arguments .. +* INTEGER INCX, INCY, N +* DOUBLE PRECISION C, S +* .. +* .. Array Arguments .. +* COMPLEX*16 ZX( * ), ZY( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> Applies a plane rotation, where the cos and sin (c and s) are real +*> and the vectors cx and cy are complex. +*> jack dongarra, linpack, 3/11/78. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the order of the vectors cx and cy. +*> N must be at least zero. +*> \endverbatim +*> +*> \param[in,out] ZX +*> \verbatim +*> ZX is COMPLEX*16 array, dimension at least +*> ( 1 + ( N - 1 )*abs( INCX ) ). +*> Before entry, the incremented array ZX must contain the n +*> element vector cx. On exit, ZX is overwritten by the updated +*> vector cx. +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> On entry, INCX specifies the increment for the elements of +*> ZX. INCX must not be zero. +*> \endverbatim +*> +*> \param[in,out] ZY +*> \verbatim +*> ZY is COMPLEX*16 array, dimension at least +*> ( 1 + ( N - 1 )*abs( INCY ) ). +*> Before entry, the incremented array ZY must contain the n +*> element vector cy. On exit, ZY is overwritten by the updated +*> vector cy. +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> On entry, INCY specifies the increment for the elements of +*> ZY. INCY must not be zero. +*> \endverbatim +*> +*> \param[in] C +*> \verbatim +*> C is DOUBLE PRECISION +*> On entry, C specifies the cosine, cos. +*> \endverbatim +*> +*> \param[in] S +*> \verbatim +*> S is DOUBLE PRECISION +*> On entry, S specifies the sine, sin. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16_blas_level1 +* +* ===================================================================== + SUBROUTINE ZDROT( N, ZX, INCX, ZY, INCY, C, S ) +* +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + INTEGER INCX, INCY, N + DOUBLE PRECISION C, S +* .. +* .. Array Arguments .. + COMPLEX*16 ZX( * ), ZY( * ) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I, IX, IY + COMPLEX*16 CTEMP +* .. +* .. Executable Statements .. +* + IF( N.LE.0 ) + $ RETURN + IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN +* +* code for both increments equal to 1 +* + DO I = 1, N + CTEMP = C*ZX( I ) + S*ZY( I ) + ZY( I ) = C*ZY( I ) - S*ZX( I ) + ZX( I ) = CTEMP + END DO + ELSE +* +* code for unequal increments or equal increments not equal +* to 1 +* + IX = 1 + IY = 1 + IF( INCX.LT.0 ) + $ IX = ( -N+1 )*INCX + 1 + IF( INCY.LT.0 ) + $ IY = ( -N+1 )*INCY + 1 + DO I = 1, N + CTEMP = C*ZX( IX ) + S*ZY( IY ) + ZY( IY ) = C*ZY( IY ) - S*ZX( IX ) + ZX( IX ) = CTEMP + IX = IX + INCX + IY = IY + INCY + END DO + END IF + RETURN +* +* End of ZDROT +* + END diff --git a/lib/linalg/zheevd.f b/lib/linalg/zheevd.f new file mode 100644 index 0000000000..7f58c7f726 --- /dev/null +++ b/lib/linalg/zheevd.f @@ -0,0 +1,395 @@ +*> \brief ZHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZHEEVD + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, +* LRWORK, IWORK, LIWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER JOBZ, UPLO +* INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N +* .. +* .. Array Arguments .. +* INTEGER IWORK( * ) +* DOUBLE PRECISION RWORK( * ), W( * ) +* COMPLEX*16 A( LDA, * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZHEEVD computes all eigenvalues and, optionally, eigenvectors of a +*> complex Hermitian matrix A. If eigenvectors are desired, it uses a +*> divide and conquer algorithm. +*> +*> The divide and conquer algorithm makes very mild assumptions about +*> floating point arithmetic. It will work on machines with a guard +*> digit in add/subtract, or on those binary machines without guard +*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or +*> Cray-2. It could conceivably fail on hexadecimal or decimal machines +*> without guard digits, but we know of none. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] JOBZ +*> \verbatim +*> JOBZ is CHARACTER*1 +*> = 'N': Compute eigenvalues only; +*> = 'V': Compute eigenvalues and eigenvectors. +*> \endverbatim +*> +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> = 'U': Upper triangle of A is stored; +*> = 'L': Lower triangle of A is stored. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA, N) +*> On entry, the Hermitian matrix A. If UPLO = 'U', the +*> leading N-by-N upper triangular part of A contains the +*> upper triangular part of the matrix A. If UPLO = 'L', +*> the leading N-by-N lower triangular part of A contains +*> the lower triangular part of the matrix A. +*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the +*> orthonormal eigenvectors of the matrix A. +*> If JOBZ = 'N', then on exit the lower triangle (if UPLO='L') +*> or the upper triangle (if UPLO='U') of A, including the +*> diagonal, is destroyed. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,N). +*> \endverbatim +*> +*> \param[out] W +*> \verbatim +*> W is DOUBLE PRECISION array, dimension (N) +*> If INFO = 0, the eigenvalues in ascending order. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The length of the array WORK. +*> If N <= 1, LWORK must be at least 1. +*> If JOBZ = 'N' and N > 1, LWORK must be at least N + 1. +*> If JOBZ = 'V' and N > 1, LWORK must be at least 2*N + N**2. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal sizes of the WORK, RWORK and +*> IWORK arrays, returns these values as the first entries of +*> the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, +*> dimension (LRWORK) +*> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK. +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER +*> The dimension of the array RWORK. +*> If N <= 1, LRWORK must be at least 1. +*> If JOBZ = 'N' and N > 1, LRWORK must be at least N. +*> If JOBZ = 'V' and N > 1, LRWORK must be at least +*> 1 + 5*N + 2*N**2. +*> +*> If LRWORK = -1, then a workspace query is assumed; the +*> routine only calculates the optimal sizes of the WORK, RWORK +*> and IWORK arrays, returns these values as the first entries +*> of the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, dimension (MAX(1,LIWORK)) +*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. +*> \endverbatim +*> +*> \param[in] LIWORK +*> \verbatim +*> LIWORK is INTEGER +*> The dimension of the array IWORK. +*> If N <= 1, LIWORK must be at least 1. +*> If JOBZ = 'N' and N > 1, LIWORK must be at least 1. +*> If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N. +*> +*> If LIWORK = -1, then a workspace query is assumed; the +*> routine only calculates the optimal sizes of the WORK, RWORK +*> and IWORK arrays, returns these values as the first entries +*> of the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \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 and JOBZ = 'N', then the algorithm failed +*> to converge; i off-diagonal elements of an intermediate +*> tridiagonal form did not converge to zero; +*> if INFO = i and JOBZ = 'V', then the algorithm failed +*> to compute an eigenvalue while working on the submatrix +*> lying in rows and columns INFO/(N+1) through +*> mod(INFO,N+1). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16HEeigen +* +*> \par Further Details: +* ===================== +*> +*> Modified description of INFO. Sven, 16 Feb 05. +* +*> \par Contributors: +* ================== +*> +*> Jeff Rutter, Computer Science Division, University of California +*> at Berkeley, USA +*> +* ===================================================================== + SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, + $ LRWORK, IWORK, LIWORK, INFO ) +* +* -- LAPACK driver routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER JOBZ, UPLO + INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N +* .. +* .. Array Arguments .. + INTEGER IWORK( * ) + DOUBLE PRECISION RWORK( * ), W( * ) + COMPLEX*16 A( LDA, * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) + COMPLEX*16 CONE + PARAMETER ( CONE = ( 1.0D0, 0.0D0 ) ) +* .. +* .. Local Scalars .. + LOGICAL LOWER, LQUERY, WANTZ + INTEGER IINFO, IMAX, INDE, INDRWK, INDTAU, INDWK2, + $ INDWRK, ISCALE, LIOPT, LIWMIN, LLRWK, LLWORK, + $ LLWRK2, LOPT, LROPT, LRWMIN, LWMIN + DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, + $ SMLNUM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV + DOUBLE PRECISION DLAMCH, ZLANHE + EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE +* .. +* .. External Subroutines .. + EXTERNAL DSCAL, DSTERF, XERBLA, ZHETRD, ZLACPY, ZLASCL, + $ ZSTEDC, ZUNMTR +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, SQRT +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + WANTZ = LSAME( JOBZ, 'V' ) + LOWER = LSAME( UPLO, 'L' ) + LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 .OR. LIWORK.EQ.-1 ) +* + INFO = 0 + IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN + INFO = -1 + ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -5 + END IF +* + IF( INFO.EQ.0 ) THEN + IF( N.LE.1 ) THEN + LWMIN = 1 + LRWMIN = 1 + LIWMIN = 1 + LOPT = LWMIN + LROPT = LRWMIN + LIOPT = LIWMIN + ELSE + IF( WANTZ ) THEN + LWMIN = 2*N + N*N + LRWMIN = 1 + 5*N + 2*N**2 + LIWMIN = 3 + 5*N + ELSE + LWMIN = N + 1 + LRWMIN = N + LIWMIN = 1 + END IF + LOPT = MAX( LWMIN, N + + $ N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) ) + LROPT = LRWMIN + LIOPT = LIWMIN + END IF + WORK( 1 ) = LOPT + RWORK( 1 ) = LROPT + IWORK( 1 ) = LIOPT +* + IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN + INFO = -8 + ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN + INFO = -10 + ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN + INFO = -12 + END IF + END IF +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZHEEVD', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* + IF( N.EQ.1 ) THEN + W( 1 ) = DBLE( A( 1, 1 ) ) + IF( WANTZ ) + $ A( 1, 1 ) = CONE + RETURN + END IF +* +* Get machine constants. +* + SAFMIN = DLAMCH( 'Safe minimum' ) + EPS = DLAMCH( 'Precision' ) + SMLNUM = SAFMIN / EPS + BIGNUM = ONE / SMLNUM + RMIN = SQRT( SMLNUM ) + RMAX = SQRT( BIGNUM ) +* +* Scale matrix to allowable range, if necessary. +* + ANRM = ZLANHE( 'M', UPLO, N, A, LDA, RWORK ) + ISCALE = 0 + IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN + ISCALE = 1 + SIGMA = RMIN / ANRM + ELSE IF( ANRM.GT.RMAX ) THEN + ISCALE = 1 + SIGMA = RMAX / ANRM + END IF + IF( ISCALE.EQ.1 ) + $ CALL ZLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO ) +* +* Call ZHETRD to reduce Hermitian matrix to tridiagonal form. +* + INDE = 1 + INDTAU = 1 + INDWRK = INDTAU + N + INDRWK = INDE + N + INDWK2 = INDWRK + N*N + LLWORK = LWORK - INDWRK + 1 + LLWRK2 = LWORK - INDWK2 + 1 + LLRWK = LRWORK - INDRWK + 1 + CALL ZHETRD( UPLO, N, A, LDA, W, RWORK( INDE ), WORK( INDTAU ), + $ WORK( INDWRK ), LLWORK, IINFO ) +* +* For eigenvalues only, call DSTERF. For eigenvectors, first call +* ZSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the +* tridiagonal matrix, then call ZUNMTR to multiply it to the +* Householder transformations represented as Householder vectors in +* A. +* + IF( .NOT.WANTZ ) THEN + CALL DSTERF( N, W, RWORK( INDE ), INFO ) + ELSE + CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK( INDWRK ), N, + $ WORK( INDWK2 ), LLWRK2, RWORK( INDRWK ), LLRWK, + $ IWORK, LIWORK, INFO ) + CALL ZUNMTR( 'L', UPLO, 'N', N, N, A, LDA, WORK( INDTAU ), + $ WORK( INDWRK ), N, WORK( INDWK2 ), LLWRK2, IINFO ) + CALL ZLACPY( 'A', N, N, WORK( INDWRK ), N, A, LDA ) + END IF +* +* If matrix was scaled, then rescale eigenvalues appropriately. +* + IF( ISCALE.EQ.1 ) THEN + IF( INFO.EQ.0 ) THEN + IMAX = N + ELSE + IMAX = INFO - 1 + END IF + CALL DSCAL( IMAX, ONE / SIGMA, W, 1 ) + END IF +* + WORK( 1 ) = LOPT + RWORK( 1 ) = LROPT + IWORK( 1 ) = LIOPT +* + RETURN +* +* End of ZHEEVD +* + END diff --git a/lib/linalg/zlacpy.f b/lib/linalg/zlacpy.f new file mode 100644 index 0000000000..06017509e0 --- /dev/null +++ b/lib/linalg/zlacpy.f @@ -0,0 +1,156 @@ +*> \brief \b ZLACPY copies all or part of one two-dimensional array to another. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLACPY + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB ) +* +* .. Scalar Arguments .. +* CHARACTER UPLO +* INTEGER LDA, LDB, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), B( LDB, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLACPY copies all or part of a two-dimensional matrix A to another +*> matrix B. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> Specifies the part of the matrix A to be copied to B. +*> = 'U': Upper triangular part +*> = 'L': Lower triangular part +*> Otherwise: All of the matrix A +*> \endverbatim +*> +*> \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] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,N) +*> The m by n matrix A. If UPLO = 'U', only the upper trapezium +*> is accessed; if UPLO = 'L', only the lower trapezium is +*> accessed. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] B +*> \verbatim +*> B is COMPLEX*16 array, dimension (LDB,N) +*> On exit, B = A in the locations specified by UPLO. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> The leading dimension of the array B. LDB >= max(1,M). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERauxiliary +* +* ===================================================================== + SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER UPLO + INTEGER LDA, LDB, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), B( LDB, * ) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I, J +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. Intrinsic Functions .. + INTRINSIC MIN +* .. +* .. Executable Statements .. +* + IF( LSAME( UPLO, 'U' ) ) THEN + DO 20 J = 1, N + DO 10 I = 1, MIN( J, M ) + B( I, J ) = A( I, J ) + 10 CONTINUE + 20 CONTINUE +* + ELSE IF( LSAME( UPLO, 'L' ) ) THEN + DO 40 J = 1, N + DO 30 I = J, M + B( I, J ) = A( I, J ) + 30 CONTINUE + 40 CONTINUE +* + ELSE + DO 60 J = 1, N + DO 50 I = 1, M + B( I, J ) = A( I, J ) + 50 CONTINUE + 60 CONTINUE + END IF +* + RETURN +* +* End of ZLACPY +* + END diff --git a/lib/linalg/zlacrm.f b/lib/linalg/zlacrm.f new file mode 100644 index 0000000000..ce8b9b02c5 --- /dev/null +++ b/lib/linalg/zlacrm.f @@ -0,0 +1,182 @@ +*> \brief \b ZLACRM multiplies a complex matrix by a square real matrix. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLACRM + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLACRM( M, N, A, LDA, B, LDB, C, LDC, RWORK ) +* +* .. Scalar Arguments .. +* INTEGER LDA, LDB, LDC, M, N +* .. +* .. Array Arguments .. +* DOUBLE PRECISION B( LDB, * ), RWORK( * ) +* COMPLEX*16 A( LDA, * ), C( LDC, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLACRM performs a very simple matrix-matrix multiplication: +*> C := A * B, +*> where A is M by N and complex; B is N by N and real; +*> C is M by N and complex. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A and of the matrix C. +*> M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns and rows of the matrix B and +*> the number of columns of the matrix C. +*> N >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA, N) +*> On entry, A contains the M by N matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >=max(1,M). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is DOUBLE PRECISION array, dimension (LDB, N) +*> On entry, B contains the N by N matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> The leading dimension of the array B. LDB >=max(1,N). +*> \endverbatim +*> +*> \param[out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC, N) +*> On exit, C contains the M by N matrix C. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >=max(1,N). +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, dimension (2*M*N) +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERauxiliary +* +* ===================================================================== + SUBROUTINE ZLACRM( M, N, A, LDA, B, LDB, C, LDC, RWORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + INTEGER LDA, LDB, LDC, M, N +* .. +* .. Array Arguments .. + DOUBLE PRECISION B( LDB, * ), RWORK( * ) + COMPLEX*16 A( LDA, * ), C( LDC, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 ) +* .. +* .. Local Scalars .. + INTEGER I, J, L +* .. +* .. Intrinsic Functions .. + INTRINSIC DBLE, DCMPLX, DIMAG +* .. +* .. External Subroutines .. + EXTERNAL DGEMM +* .. +* .. Executable Statements .. +* +* Quick return if possible. +* + IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) ) + $ RETURN +* + DO 20 J = 1, N + DO 10 I = 1, M + RWORK( ( J-1 )*M+I ) = DBLE( A( I, J ) ) + 10 CONTINUE + 20 CONTINUE +* + L = M*N + 1 + CALL DGEMM( 'N', 'N', M, N, N, ONE, RWORK, M, B, LDB, ZERO, + $ RWORK( L ), M ) + DO 40 J = 1, N + DO 30 I = 1, M + C( I, J ) = RWORK( L+( J-1 )*M+I-1 ) + 30 CONTINUE + 40 CONTINUE +* + DO 60 J = 1, N + DO 50 I = 1, M + RWORK( ( J-1 )*M+I ) = DIMAG( A( I, J ) ) + 50 CONTINUE + 60 CONTINUE + CALL DGEMM( 'N', 'N', M, N, N, ONE, RWORK, M, B, LDB, ZERO, + $ RWORK( L ), M ) + DO 80 J = 1, N + DO 70 I = 1, M + C( I, J ) = DCMPLX( DBLE( C( I, J ) ), + $ RWORK( L+( J-1 )*M+I-1 ) ) + 70 CONTINUE + 80 CONTINUE +* + RETURN +* +* End of ZLACRM +* + END diff --git a/lib/linalg/zlaed0.f b/lib/linalg/zlaed0.f new file mode 100644 index 0000000000..c4deac037a --- /dev/null +++ b/lib/linalg/zlaed0.f @@ -0,0 +1,368 @@ +*> \brief \b ZLAED0 used by ZSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLAED0 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLAED0( QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, RWORK, +* IWORK, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDQ, LDQS, N, QSIZ +* .. +* .. Array Arguments .. +* INTEGER IWORK( * ) +* DOUBLE PRECISION D( * ), E( * ), RWORK( * ) +* COMPLEX*16 Q( LDQ, * ), QSTORE( LDQS, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> Using the divide and conquer method, ZLAED0 computes all eigenvalues +*> of a symmetric tridiagonal matrix which is one diagonal block of +*> those from reducing a dense or band Hermitian matrix and +*> corresponding eigenvectors of the dense or band matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] QSIZ +*> \verbatim +*> QSIZ is INTEGER +*> The dimension of the unitary matrix used to reduce +*> the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The dimension of the symmetric tridiagonal matrix. N >= 0. +*> \endverbatim +*> +*> \param[in,out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension (N) +*> On entry, the diagonal elements of the tridiagonal matrix. +*> On exit, the eigenvalues in ascending order. +*> \endverbatim +*> +*> \param[in,out] E +*> \verbatim +*> E is DOUBLE PRECISION array, dimension (N-1) +*> On entry, the off-diagonal elements of the tridiagonal matrix. +*> On exit, E has been destroyed. +*> \endverbatim +*> +*> \param[in,out] Q +*> \verbatim +*> Q is COMPLEX*16 array, dimension (LDQ,N) +*> On entry, Q must contain an QSIZ x N matrix whose columns +*> unitarily orthonormal. It is a part of the unitary matrix +*> that reduces the full dense Hermitian matrix to a +*> (reducible) symmetric tridiagonal matrix. +*> \endverbatim +*> +*> \param[in] LDQ +*> \verbatim +*> LDQ is INTEGER +*> The leading dimension of the array Q. LDQ >= max(1,N). +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, +*> the dimension of IWORK must be at least +*> 6 + 6*N + 5*N*lg N +*> ( lg( N ) = smallest integer k +*> such that 2^k >= N ) +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, +*> dimension (1 + 3*N + 2*N*lg N + 3*N**2) +*> ( lg( N ) = smallest integer k +*> such that 2^k >= N ) +*> \endverbatim +*> +*> \param[out] QSTORE +*> \verbatim +*> QSTORE is COMPLEX*16 array, dimension (LDQS, N) +*> Used to store parts of +*> the eigenvector matrix when the updating matrix multiplies +*> take place. +*> \endverbatim +*> +*> \param[in] LDQS +*> \verbatim +*> LDQS is INTEGER +*> The leading dimension of the array QSTORE. +*> LDQS >= max(1,N). +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> > 0: The algorithm failed to compute an eigenvalue while +*> working on the submatrix lying in rows and columns +*> INFO/(N+1) through mod(INFO,N+1). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZLAED0( QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, RWORK, + $ IWORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + INTEGER INFO, LDQ, LDQS, N, QSIZ +* .. +* .. Array Arguments .. + INTEGER IWORK( * ) + DOUBLE PRECISION D( * ), E( * ), RWORK( * ) + COMPLEX*16 Q( LDQ, * ), QSTORE( LDQS, * ) +* .. +* +* ===================================================================== +* +* Warning: N could be as big as QSIZ! +* +* .. Parameters .. + DOUBLE PRECISION TWO + PARAMETER ( TWO = 2.D+0 ) +* .. +* .. Local Scalars .. + INTEGER CURLVL, CURPRB, CURR, I, IGIVCL, IGIVNM, + $ IGIVPT, INDXQ, IPERM, IPRMPT, IQ, IQPTR, IWREM, + $ J, K, LGN, LL, MATSIZ, MSD2, SMLSIZ, SMM1, + $ SPM1, SPM2, SUBMAT, SUBPBS, TLVLS + DOUBLE PRECISION TEMP +* .. +* .. External Subroutines .. + EXTERNAL DCOPY, DSTEQR, XERBLA, ZCOPY, ZLACRM, ZLAED7 +* .. +* .. External Functions .. + INTEGER ILAENV + EXTERNAL ILAENV +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, INT, LOG, MAX +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 +* +* IF( ICOMPQ .LT. 0 .OR. ICOMPQ .GT. 2 ) THEN +* INFO = -1 +* ELSE IF( ( ICOMPQ .EQ. 1 ) .AND. ( QSIZ .LT. MAX( 0, N ) ) ) +* $ THEN + IF( QSIZ.LT.MAX( 0, N ) ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDQS.LT.MAX( 1, N ) ) THEN + INFO = -8 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZLAED0', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* + SMLSIZ = ILAENV( 9, 'ZLAED0', ' ', 0, 0, 0, 0 ) +* +* Determine the size and placement of the submatrices, and save in +* the leading elements of IWORK. +* + IWORK( 1 ) = N + SUBPBS = 1 + TLVLS = 0 + 10 CONTINUE + IF( IWORK( SUBPBS ).GT.SMLSIZ ) THEN + DO 20 J = SUBPBS, 1, -1 + IWORK( 2*J ) = ( IWORK( J )+1 ) / 2 + IWORK( 2*J-1 ) = IWORK( J ) / 2 + 20 CONTINUE + TLVLS = TLVLS + 1 + SUBPBS = 2*SUBPBS + GO TO 10 + END IF + DO 30 J = 2, SUBPBS + IWORK( J ) = IWORK( J ) + IWORK( J-1 ) + 30 CONTINUE +* +* Divide the matrix into SUBPBS submatrices of size at most SMLSIZ+1 +* using rank-1 modifications (cuts). +* + SPM1 = SUBPBS - 1 + DO 40 I = 1, SPM1 + SUBMAT = IWORK( I ) + 1 + SMM1 = SUBMAT - 1 + D( SMM1 ) = D( SMM1 ) - ABS( E( SMM1 ) ) + D( SUBMAT ) = D( SUBMAT ) - ABS( E( SMM1 ) ) + 40 CONTINUE +* + INDXQ = 4*N + 3 +* +* Set up workspaces for eigenvalues only/accumulate new vectors +* routine +* + TEMP = LOG( DBLE( N ) ) / LOG( TWO ) + LGN = INT( TEMP ) + IF( 2**LGN.LT.N ) + $ LGN = LGN + 1 + IF( 2**LGN.LT.N ) + $ LGN = LGN + 1 + IPRMPT = INDXQ + N + 1 + IPERM = IPRMPT + N*LGN + IQPTR = IPERM + N*LGN + IGIVPT = IQPTR + N + 2 + IGIVCL = IGIVPT + N*LGN +* + IGIVNM = 1 + IQ = IGIVNM + 2*N*LGN + IWREM = IQ + N**2 + 1 +* Initialize pointers + DO 50 I = 0, SUBPBS + IWORK( IPRMPT+I ) = 1 + IWORK( IGIVPT+I ) = 1 + 50 CONTINUE + IWORK( IQPTR ) = 1 +* +* Solve each submatrix eigenproblem at the bottom of the divide and +* conquer tree. +* + CURR = 0 + DO 70 I = 0, SPM1 + IF( I.EQ.0 ) THEN + SUBMAT = 1 + MATSIZ = IWORK( 1 ) + ELSE + SUBMAT = IWORK( I ) + 1 + MATSIZ = IWORK( I+1 ) - IWORK( I ) + END IF + LL = IQ - 1 + IWORK( IQPTR+CURR ) + CALL DSTEQR( 'I', MATSIZ, D( SUBMAT ), E( SUBMAT ), + $ RWORK( LL ), MATSIZ, RWORK, INFO ) + CALL ZLACRM( QSIZ, MATSIZ, Q( 1, SUBMAT ), LDQ, RWORK( LL ), + $ MATSIZ, QSTORE( 1, SUBMAT ), LDQS, + $ RWORK( IWREM ) ) + IWORK( IQPTR+CURR+1 ) = IWORK( IQPTR+CURR ) + MATSIZ**2 + CURR = CURR + 1 + IF( INFO.GT.0 ) THEN + INFO = SUBMAT*( N+1 ) + SUBMAT + MATSIZ - 1 + RETURN + END IF + K = 1 + DO 60 J = SUBMAT, IWORK( I+1 ) + IWORK( INDXQ+J ) = K + K = K + 1 + 60 CONTINUE + 70 CONTINUE +* +* Successively merge eigensystems of adjacent submatrices +* into eigensystem for the corresponding larger matrix. +* +* while ( SUBPBS > 1 ) +* + CURLVL = 1 + 80 CONTINUE + IF( SUBPBS.GT.1 ) THEN + SPM2 = SUBPBS - 2 + DO 90 I = 0, SPM2, 2 + IF( I.EQ.0 ) THEN + SUBMAT = 1 + MATSIZ = IWORK( 2 ) + MSD2 = IWORK( 1 ) + CURPRB = 0 + ELSE + SUBMAT = IWORK( I ) + 1 + MATSIZ = IWORK( I+2 ) - IWORK( I ) + MSD2 = MATSIZ / 2 + CURPRB = CURPRB + 1 + END IF +* +* Merge lower order eigensystems (of size MSD2 and MATSIZ - MSD2) +* into an eigensystem of size MATSIZ. ZLAED7 handles the case +* when the eigenvectors of a full or band Hermitian matrix (which +* was reduced to tridiagonal form) are desired. +* +* I am free to use Q as a valuable working space until Loop 150. +* + CALL ZLAED7( MATSIZ, MSD2, QSIZ, TLVLS, CURLVL, CURPRB, + $ D( SUBMAT ), QSTORE( 1, SUBMAT ), LDQS, + $ E( SUBMAT+MSD2-1 ), IWORK( INDXQ+SUBMAT ), + $ RWORK( IQ ), IWORK( IQPTR ), IWORK( IPRMPT ), + $ IWORK( IPERM ), IWORK( IGIVPT ), + $ IWORK( IGIVCL ), RWORK( IGIVNM ), + $ Q( 1, SUBMAT ), RWORK( IWREM ), + $ IWORK( SUBPBS+1 ), INFO ) + IF( INFO.GT.0 ) THEN + INFO = SUBMAT*( N+1 ) + SUBMAT + MATSIZ - 1 + RETURN + END IF + IWORK( I / 2+1 ) = IWORK( I+2 ) + 90 CONTINUE + SUBPBS = SUBPBS / 2 + CURLVL = CURLVL + 1 + GO TO 80 + END IF +* +* end while +* +* Re-merge the eigenvalues/vectors which were deflated at the final +* merge step. +* + DO 100 I = 1, N + J = IWORK( INDXQ+I ) + RWORK( I ) = D( J ) + CALL ZCOPY( QSIZ, QSTORE( 1, J ), 1, Q( 1, I ), 1 ) + 100 CONTINUE + CALL DCOPY( N, RWORK, 1, D, 1 ) +* + RETURN +* +* End of ZLAED0 +* + END diff --git a/lib/linalg/zlaed7.f b/lib/linalg/zlaed7.f new file mode 100644 index 0000000000..83f32d8b81 --- /dev/null +++ b/lib/linalg/zlaed7.f @@ -0,0 +1,382 @@ +*> \brief \b ZLAED7 used by ZSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLAED7 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, +* LDQ, RHO, INDXQ, QSTORE, QPTR, PRMPTR, PERM, +* GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, +* INFO ) +* +* .. Scalar Arguments .. +* INTEGER CURLVL, CURPBM, CUTPNT, INFO, LDQ, N, QSIZ, +* $ TLVLS +* DOUBLE PRECISION RHO +* .. +* .. Array Arguments .. +* INTEGER GIVCOL( 2, * ), GIVPTR( * ), INDXQ( * ), +* $ IWORK( * ), PERM( * ), PRMPTR( * ), QPTR( * ) +* DOUBLE PRECISION D( * ), GIVNUM( 2, * ), QSTORE( * ), RWORK( * ) +* COMPLEX*16 Q( LDQ, * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLAED7 computes the updated eigensystem of a diagonal +*> matrix after modification by a rank-one symmetric matrix. This +*> routine is used only for the eigenproblem which requires all +*> eigenvalues and optionally eigenvectors of a dense or banded +*> Hermitian matrix that has been reduced to tridiagonal form. +*> +*> T = Q(in) ( D(in) + RHO * Z*Z**H ) Q**H(in) = Q(out) * D(out) * Q**H(out) +*> +*> where Z = Q**Hu, u is a vector of length N with ones in the +*> CUTPNT and CUTPNT + 1 th elements and zeros elsewhere. +*> +*> The eigenvectors of the original matrix are stored in Q, and the +*> eigenvalues are in D. The algorithm consists of three stages: +*> +*> 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 occurrence the dimension of the +*> secular equation problem is reduced by one. This stage is +*> performed by the routine DLAED2. +*> +*> The second stage consists of calculating the updated +*> eigenvalues. This is done by finding the roots of the secular +*> equation via the routine DLAED4 (as called by SLAED3). +*> This routine also calculates the eigenvectors of the current +*> problem. +*> +*> The final stage consists of computing the updated eigenvectors +*> directly using the updated eigenvalues. The eigenvectors for +*> the current problem are multiplied with the eigenvectors from +*> the overall problem. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The dimension of the symmetric tridiagonal matrix. N >= 0. +*> \endverbatim +*> +*> \param[in] CUTPNT +*> \verbatim +*> CUTPNT is INTEGER +*> Contains the location of the last eigenvalue in the leading +*> sub-matrix. min(1,N) <= CUTPNT <= N. +*> \endverbatim +*> +*> \param[in] QSIZ +*> \verbatim +*> QSIZ is INTEGER +*> The dimension of the unitary matrix used to reduce +*> the full matrix to tridiagonal form. QSIZ >= N. +*> \endverbatim +*> +*> \param[in] TLVLS +*> \verbatim +*> TLVLS is INTEGER +*> The total number of merging levels in the overall divide and +*> conquer tree. +*> \endverbatim +*> +*> \param[in] CURLVL +*> \verbatim +*> CURLVL is INTEGER +*> The current level in the overall merge routine, +*> 0 <= curlvl <= tlvls. +*> \endverbatim +*> +*> \param[in] CURPBM +*> \verbatim +*> CURPBM is INTEGER +*> The current problem in the current level in the overall +*> merge routine (counting from upper left to lower right). +*> \endverbatim +*> +*> \param[in,out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension (N) +*> On entry, the eigenvalues of the rank-1-perturbed matrix. +*> On exit, the eigenvalues of the repaired matrix. +*> \endverbatim +*> +*> \param[in,out] Q +*> \verbatim +*> Q is COMPLEX*16 array, dimension (LDQ,N) +*> On entry, the eigenvectors of the rank-1-perturbed matrix. +*> On exit, the eigenvectors of the repaired tridiagonal matrix. +*> \endverbatim +*> +*> \param[in] LDQ +*> \verbatim +*> LDQ is INTEGER +*> The leading dimension of the array Q. LDQ >= max(1,N). +*> \endverbatim +*> +*> \param[in] RHO +*> \verbatim +*> RHO is DOUBLE PRECISION +*> Contains the subdiagonal element used to create the rank-1 +*> modification. +*> \endverbatim +*> +*> \param[out] INDXQ +*> \verbatim +*> INDXQ is INTEGER array, dimension (N) +*> This contains the permutation which will reintegrate the +*> subproblem just solved back into sorted order, +*> ie. D( INDXQ( I = 1, N ) ) will be in ascending order. +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, dimension (4*N) +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, +*> dimension (3*N+2*QSIZ*N) +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (QSIZ*N) +*> \endverbatim +*> +*> \param[in,out] QSTORE +*> \verbatim +*> QSTORE is DOUBLE PRECISION array, dimension (N**2+1) +*> Stores eigenvectors of submatrices encountered during +*> divide and conquer, packed together. QPTR points to +*> beginning of the submatrices. +*> \endverbatim +*> +*> \param[in,out] QPTR +*> \verbatim +*> QPTR is INTEGER array, dimension (N+2) +*> List of indices pointing to beginning of submatrices stored +*> in QSTORE. The submatrices are numbered starting at the +*> bottom left of the divide and conquer tree, from left to +*> right and bottom to top. +*> \endverbatim +*> +*> \param[in] PRMPTR +*> \verbatim +*> PRMPTR is INTEGER array, dimension (N lg N) +*> Contains a list of pointers which indicate where in PERM a +*> level's permutation is stored. PRMPTR(i+1) - PRMPTR(i) +*> indicates the size of the permutation and also the size of +*> the full, non-deflated problem. +*> \endverbatim +*> +*> \param[in] PERM +*> \verbatim +*> PERM is INTEGER array, dimension (N lg N) +*> Contains the permutations (from deflation and sorting) to be +*> applied to each eigenblock. +*> \endverbatim +*> +*> \param[in] GIVPTR +*> \verbatim +*> GIVPTR is INTEGER array, dimension (N lg N) +*> Contains a list of pointers which indicate where in GIVCOL a +*> level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i) +*> indicates the number of Givens rotations. +*> \endverbatim +*> +*> \param[in] GIVCOL +*> \verbatim +*> GIVCOL is INTEGER array, dimension (2, N lg N) +*> Each pair of numbers indicates a pair of columns to take place +*> in a Givens rotation. +*> \endverbatim +*> +*> \param[in] GIVNUM +*> \verbatim +*> GIVNUM is DOUBLE PRECISION array, dimension (2, N lg N) +*> Each number indicates the S value to be used in the +*> corresponding Givens rotation. +*> \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 = 1, an eigenvalue did not converge +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, + $ LDQ, RHO, INDXQ, QSTORE, QPTR, PRMPTR, PERM, + $ GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, + $ INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + INTEGER CURLVL, CURPBM, CUTPNT, INFO, LDQ, N, QSIZ, + $ TLVLS + DOUBLE PRECISION RHO +* .. +* .. Array Arguments .. + INTEGER GIVCOL( 2, * ), GIVPTR( * ), INDXQ( * ), + $ IWORK( * ), PERM( * ), PRMPTR( * ), QPTR( * ) + DOUBLE PRECISION D( * ), GIVNUM( 2, * ), QSTORE( * ), RWORK( * ) + COMPLEX*16 Q( LDQ, * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER COLTYP, CURR, I, IDLMDA, INDX, + $ INDXC, INDXP, IQ, IW, IZ, K, N1, N2, PTR +* .. +* .. External Subroutines .. + EXTERNAL DLAED9, DLAEDA, DLAMRG, XERBLA, ZLACRM, ZLAED8 +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 +* +* IF( ICOMPQ.LT.0 .OR. ICOMPQ.GT.1 ) THEN +* INFO = -1 +* ELSE IF( N.LT.0 ) THEN + IF( N.LT.0 ) THEN + INFO = -1 + ELSE IF( MIN( 1, N ).GT.CUTPNT .OR. N.LT.CUTPNT ) THEN + INFO = -2 + ELSE IF( QSIZ.LT.N ) THEN + INFO = -3 + ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN + INFO = -9 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZLAED7', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* +* The following values are for bookkeeping purposes only. They are +* integer pointers which indicate the portion of the workspace +* used by a particular array in DLAED2 and SLAED3. +* + IZ = 1 + IDLMDA = IZ + N + IW = IDLMDA + N + IQ = IW + N +* + INDX = 1 + INDXC = INDX + N + COLTYP = INDXC + N + INDXP = COLTYP + N +* +* Form the z-vector which consists of the last row of Q_1 and the +* first row of Q_2. +* + PTR = 1 + 2**TLVLS + DO 10 I = 1, CURLVL - 1 + PTR = PTR + 2**( TLVLS-I ) + 10 CONTINUE + CURR = PTR + CURPBM + CALL DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, + $ GIVCOL, GIVNUM, QSTORE, QPTR, RWORK( IZ ), + $ RWORK( IZ+N ), INFO ) +* +* When solving the final problem, we no longer need the stored data, +* so we will overwrite the data from this level onto the previously +* used storage space. +* + IF( CURLVL.EQ.TLVLS ) THEN + QPTR( CURR ) = 1 + PRMPTR( CURR ) = 1 + GIVPTR( CURR ) = 1 + END IF +* +* Sort and Deflate eigenvalues. +* + CALL ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, RWORK( IZ ), + $ RWORK( IDLMDA ), WORK, QSIZ, RWORK( IW ), + $ IWORK( INDXP ), IWORK( INDX ), INDXQ, + $ PERM( PRMPTR( CURR ) ), GIVPTR( CURR+1 ), + $ GIVCOL( 1, GIVPTR( CURR ) ), + $ GIVNUM( 1, GIVPTR( CURR ) ), INFO ) + PRMPTR( CURR+1 ) = PRMPTR( CURR ) + N + GIVPTR( CURR+1 ) = GIVPTR( CURR+1 ) + GIVPTR( CURR ) +* +* Solve Secular Equation. +* + IF( K.NE.0 ) THEN + CALL DLAED9( K, 1, K, N, D, RWORK( IQ ), K, RHO, + $ RWORK( IDLMDA ), RWORK( IW ), + $ QSTORE( QPTR( CURR ) ), K, INFO ) + CALL ZLACRM( QSIZ, K, WORK, QSIZ, QSTORE( QPTR( CURR ) ), K, Q, + $ LDQ, RWORK( IQ ) ) + QPTR( CURR+1 ) = QPTR( CURR ) + K**2 + IF( INFO.NE.0 ) THEN + RETURN + END IF +* +* Prepare the INDXQ sorting premutation. +* + N1 = K + N2 = N - K + CALL DLAMRG( N1, N2, D, 1, -1, INDXQ ) + ELSE + QPTR( CURR+1 ) = QPTR( CURR ) + DO 20 I = 1, N + INDXQ( I ) = I + 20 CONTINUE + END IF +* + RETURN +* +* End of ZLAED7 +* + END diff --git a/lib/linalg/zlaed8.f b/lib/linalg/zlaed8.f new file mode 100644 index 0000000000..995a673de9 --- /dev/null +++ b/lib/linalg/zlaed8.f @@ -0,0 +1,483 @@ +*> \brief \b ZLAED8 used by ZSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLAED8 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMDA, +* Q2, LDQ2, W, INDXP, INDX, INDXQ, PERM, GIVPTR, +* GIVCOL, GIVNUM, INFO ) +* +* .. Scalar Arguments .. +* INTEGER CUTPNT, GIVPTR, INFO, K, LDQ, LDQ2, N, QSIZ +* DOUBLE PRECISION RHO +* .. +* .. Array Arguments .. +* INTEGER GIVCOL( 2, * ), INDX( * ), INDXP( * ), +* $ INDXQ( * ), PERM( * ) +* DOUBLE PRECISION D( * ), DLAMDA( * ), GIVNUM( 2, * ), W( * ), +* $ Z( * ) +* COMPLEX*16 Q( LDQ, * ), Q2( LDQ2, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLAED8 merges the two sets of eigenvalues together into a single +*> sorted set. Then it tries to deflate the size of the problem. +*> There are two ways in which deflation can occur: when two or more +*> eigenvalues are close together or if there is a tiny element in the +*> Z vector. For each such occurrence the order of the related secular +*> equation problem is reduced by one. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[out] K +*> \verbatim +*> K is INTEGER +*> Contains the number of non-deflated eigenvalues. +*> This is the order of the related secular equation. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The dimension of the symmetric tridiagonal matrix. N >= 0. +*> \endverbatim +*> +*> \param[in] QSIZ +*> \verbatim +*> QSIZ is INTEGER +*> The dimension of the unitary matrix used to reduce +*> the dense or band matrix to tridiagonal form. +*> QSIZ >= N if ICOMPQ = 1. +*> \endverbatim +*> +*> \param[in,out] Q +*> \verbatim +*> Q is COMPLEX*16 array, dimension (LDQ,N) +*> On entry, Q contains the eigenvectors of the partially solved +*> system which has been previously updated in matrix +*> multiplies with other partially solved eigensystems. +*> On exit, Q contains the trailing (N-K) updated eigenvectors +*> (those which were deflated) in its last N-K columns. +*> \endverbatim +*> +*> \param[in] LDQ +*> \verbatim +*> LDQ is INTEGER +*> The leading dimension of the array Q. LDQ >= max( 1, N ). +*> \endverbatim +*> +*> \param[in,out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension (N) +*> On entry, D contains the eigenvalues of the two submatrices to +*> be combined. On exit, D contains the trailing (N-K) updated +*> eigenvalues (those which were deflated) sorted into increasing +*> order. +*> \endverbatim +*> +*> \param[in,out] RHO +*> \verbatim +*> RHO is DOUBLE PRECISION +*> Contains the off diagonal element associated with the rank-1 +*> cut which originally split the two submatrices which are now +*> being recombined. RHO is modified during the computation to +*> the value required by DLAED3. +*> \endverbatim +*> +*> \param[in] CUTPNT +*> \verbatim +*> CUTPNT is INTEGER +*> Contains the location of the last eigenvalue in the leading +*> sub-matrix. MIN(1,N) <= CUTPNT <= N. +*> \endverbatim +*> +*> \param[in] Z +*> \verbatim +*> Z is DOUBLE PRECISION array, dimension (N) +*> On input this vector contains the updating vector (the last +*> row of the first sub-eigenvector matrix and the first row of +*> the second sub-eigenvector matrix). The contents of Z are +*> destroyed during the updating process. +*> \endverbatim +*> +*> \param[out] DLAMDA +*> \verbatim +*> DLAMDA is DOUBLE PRECISION array, dimension (N) +*> Contains a copy of the first K eigenvalues which will be used +*> by DLAED3 to form the secular equation. +*> \endverbatim +*> +*> \param[out] Q2 +*> \verbatim +*> Q2 is COMPLEX*16 array, dimension (LDQ2,N) +*> If ICOMPQ = 0, Q2 is not referenced. Otherwise, +*> Contains a copy of the first K eigenvectors which will be used +*> by DLAED7 in a matrix multiply (DGEMM) to update the new +*> eigenvectors. +*> \endverbatim +*> +*> \param[in] LDQ2 +*> \verbatim +*> LDQ2 is INTEGER +*> The leading dimension of the array Q2. LDQ2 >= max( 1, N ). +*> \endverbatim +*> +*> \param[out] W +*> \verbatim +*> W is DOUBLE PRECISION array, dimension (N) +*> This will hold the first k values of the final +*> deflation-altered z-vector and will be passed to DLAED3. +*> \endverbatim +*> +*> \param[out] INDXP +*> \verbatim +*> INDXP is INTEGER array, dimension (N) +*> This will contain the permutation used to place deflated +*> values of D at the end of the array. On output INDXP(1:K) +*> points to the nondeflated D-values and INDXP(K+1:N) +*> points to the deflated eigenvalues. +*> \endverbatim +*> +*> \param[out] INDX +*> \verbatim +*> INDX is INTEGER array, dimension (N) +*> This will contain the permutation used to sort the contents of +*> D into ascending order. +*> \endverbatim +*> +*> \param[in] INDXQ +*> \verbatim +*> INDXQ is INTEGER array, dimension (N) +*> This contains the permutation which separately sorts the two +*> sub-problems in D into ascending order. Note that elements in +*> the second half of this permutation must first have CUTPNT +*> added to their values in order to be accurate. +*> \endverbatim +*> +*> \param[out] PERM +*> \verbatim +*> PERM is INTEGER array, dimension (N) +*> Contains the permutations (from deflation and sorting) to be +*> applied to each eigenblock. +*> \endverbatim +*> +*> \param[out] GIVPTR +*> \verbatim +*> GIVPTR is INTEGER +*> Contains the number of Givens rotations which took place in +*> this subproblem. +*> \endverbatim +*> +*> \param[out] GIVCOL +*> \verbatim +*> GIVCOL is INTEGER array, dimension (2, N) +*> Each pair of numbers indicates a pair of columns to take place +*> in a Givens rotation. +*> \endverbatim +*> +*> \param[out] GIVNUM +*> \verbatim +*> GIVNUM is DOUBLE PRECISION array, dimension (2, N) +*> Each number indicates the S value to be used in the +*> corresponding Givens rotation. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMDA, + $ Q2, LDQ2, W, INDXP, INDX, INDXQ, PERM, GIVPTR, + $ GIVCOL, GIVNUM, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + INTEGER CUTPNT, GIVPTR, INFO, K, LDQ, LDQ2, N, QSIZ + DOUBLE PRECISION RHO +* .. +* .. Array Arguments .. + INTEGER GIVCOL( 2, * ), INDX( * ), INDXP( * ), + $ INDXQ( * ), PERM( * ) + DOUBLE PRECISION D( * ), DLAMDA( * ), GIVNUM( 2, * ), W( * ), + $ Z( * ) + COMPLEX*16 Q( LDQ, * ), Q2( LDQ2, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION MONE, ZERO, ONE, TWO, EIGHT + PARAMETER ( MONE = -1.0D0, ZERO = 0.0D0, ONE = 1.0D0, + $ TWO = 2.0D0, EIGHT = 8.0D0 ) +* .. +* .. Local Scalars .. + INTEGER I, IMAX, J, JLAM, JMAX, JP, K2, N1, N1P1, N2 + DOUBLE PRECISION C, EPS, S, T, TAU, TOL +* .. +* .. External Functions .. + INTEGER IDAMAX + DOUBLE PRECISION DLAMCH, DLAPY2 + EXTERNAL IDAMAX, DLAMCH, DLAPY2 +* .. +* .. External Subroutines .. + EXTERNAL DCOPY, DLAMRG, DSCAL, XERBLA, ZCOPY, ZDROT, + $ ZLACPY +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, MIN, SQRT +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 +* + IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( QSIZ.LT.N ) THEN + INFO = -3 + ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN + INFO = -5 + ELSE IF( CUTPNT.LT.MIN( 1, N ) .OR. CUTPNT.GT.N ) THEN + INFO = -8 + ELSE IF( LDQ2.LT.MAX( 1, N ) ) THEN + INFO = -12 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZLAED8', -INFO ) + RETURN + END IF +* +* Need to initialize GIVPTR to O here in case of quick exit +* to prevent an unspecified code behavior (usually sigfault) +* when IWORK array on entry to *stedc is not zeroed +* (or at least some IWORK entries which used in *laed7 for GIVPTR). +* + GIVPTR = 0 +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* + N1 = CUTPNT + N2 = N - N1 + N1P1 = N1 + 1 +* + IF( RHO.LT.ZERO ) THEN + CALL DSCAL( N2, MONE, Z( N1P1 ), 1 ) + END IF +* +* Normalize z so that norm(z) = 1 +* + T = ONE / SQRT( TWO ) + DO 10 J = 1, N + INDX( J ) = J + 10 CONTINUE + CALL DSCAL( N, T, Z, 1 ) + RHO = ABS( TWO*RHO ) +* +* Sort the eigenvalues into increasing order +* + DO 20 I = CUTPNT + 1, N + INDXQ( I ) = INDXQ( I ) + CUTPNT + 20 CONTINUE + DO 30 I = 1, N + DLAMDA( I ) = D( INDXQ( I ) ) + W( I ) = Z( INDXQ( I ) ) + 30 CONTINUE + I = 1 + J = CUTPNT + 1 + CALL DLAMRG( N1, N2, DLAMDA, 1, 1, INDX ) + DO 40 I = 1, N + D( I ) = DLAMDA( INDX( I ) ) + Z( I ) = W( INDX( I ) ) + 40 CONTINUE +* +* Calculate the allowable deflation tolerance +* + IMAX = IDAMAX( N, Z, 1 ) + JMAX = IDAMAX( N, D, 1 ) + EPS = DLAMCH( 'Epsilon' ) + TOL = EIGHT*EPS*ABS( D( JMAX ) ) +* +* If the rank-1 modifier is small enough, no more needs to be done +* -- except to reorganize Q so that its columns correspond with the +* elements in D. +* + IF( RHO*ABS( Z( IMAX ) ).LE.TOL ) THEN + K = 0 + DO 50 J = 1, N + PERM( J ) = INDXQ( INDX( J ) ) + CALL ZCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 ) + 50 CONTINUE + CALL ZLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ), LDQ ) + RETURN + END IF +* +* If there are multiple eigenvalues then the problem deflates. Here +* the number of equal eigenvalues are found. As each equal +* eigenvalue is found, an elementary reflector is computed to rotate +* the corresponding eigensubspace so that the corresponding +* components of Z are zero in this new basis. +* + K = 0 + K2 = N + 1 + DO 60 J = 1, N + IF( RHO*ABS( Z( J ) ).LE.TOL ) THEN +* +* Deflate due to small z component. +* + K2 = K2 - 1 + INDXP( K2 ) = J + IF( J.EQ.N ) + $ GO TO 100 + ELSE + JLAM = J + GO TO 70 + END IF + 60 CONTINUE + 70 CONTINUE + J = J + 1 + IF( J.GT.N ) + $ GO TO 90 + IF( RHO*ABS( Z( J ) ).LE.TOL ) THEN +* +* Deflate due to small z component. +* + K2 = K2 - 1 + INDXP( K2 ) = J + ELSE +* +* Check if eigenvalues are close enough to allow deflation. +* + S = Z( JLAM ) + C = Z( J ) +* +* Find sqrt(a**2+b**2) without overflow or +* destructive underflow. +* + TAU = DLAPY2( C, S ) + T = D( J ) - D( JLAM ) + C = C / TAU + S = -S / TAU + IF( ABS( T*C*S ).LE.TOL ) THEN +* +* Deflation is possible. +* + Z( J ) = TAU + Z( JLAM ) = ZERO +* +* Record the appropriate Givens rotation +* + GIVPTR = GIVPTR + 1 + GIVCOL( 1, GIVPTR ) = INDXQ( INDX( JLAM ) ) + GIVCOL( 2, GIVPTR ) = INDXQ( INDX( J ) ) + GIVNUM( 1, GIVPTR ) = C + GIVNUM( 2, GIVPTR ) = S + CALL ZDROT( QSIZ, Q( 1, INDXQ( INDX( JLAM ) ) ), 1, + $ Q( 1, INDXQ( INDX( J ) ) ), 1, C, S ) + T = D( JLAM )*C*C + D( J )*S*S + D( J ) = D( JLAM )*S*S + D( J )*C*C + D( JLAM ) = T + K2 = K2 - 1 + I = 1 + 80 CONTINUE + IF( K2+I.LE.N ) THEN + IF( D( JLAM ).LT.D( INDXP( K2+I ) ) ) THEN + INDXP( K2+I-1 ) = INDXP( K2+I ) + INDXP( K2+I ) = JLAM + I = I + 1 + GO TO 80 + ELSE + INDXP( K2+I-1 ) = JLAM + END IF + ELSE + INDXP( K2+I-1 ) = JLAM + END IF + JLAM = J + ELSE + K = K + 1 + W( K ) = Z( JLAM ) + DLAMDA( K ) = D( JLAM ) + INDXP( K ) = JLAM + JLAM = J + END IF + END IF + GO TO 70 + 90 CONTINUE +* +* Record the last eigenvalue. +* + K = K + 1 + W( K ) = Z( JLAM ) + DLAMDA( K ) = D( JLAM ) + INDXP( K ) = JLAM +* + 100 CONTINUE +* +* Sort the eigenvalues and corresponding eigenvectors into DLAMDA +* and Q2 respectively. The eigenvalues/vectors which were not +* deflated go into the first K slots of DLAMDA and Q2 respectively, +* while those which were deflated go into the last N - K slots. +* + DO 110 J = 1, N + JP = INDXP( J ) + DLAMDA( J ) = D( JP ) + PERM( J ) = INDXQ( INDX( JP ) ) + CALL ZCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 ) + 110 CONTINUE +* +* The deflated eigenvalues and their corresponding vectors go back +* into the last N - K slots of D and Q respectively. +* + IF( K.LT.N ) THEN + CALL DCOPY( N-K, DLAMDA( K+1 ), 1, D( K+1 ), 1 ) + CALL ZLACPY( 'A', QSIZ, N-K, Q2( 1, K+1 ), LDQ2, Q( 1, K+1 ), + $ LDQ ) + END IF +* + RETURN +* +* End of ZLAED8 +* + END diff --git a/lib/linalg/zstedc.f b/lib/linalg/zstedc.f new file mode 100644 index 0000000000..74d390af7e --- /dev/null +++ b/lib/linalg/zstedc.f @@ -0,0 +1,483 @@ +*> \brief \b ZSTEDC +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZSTEDC + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, +* LRWORK, IWORK, LIWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER COMPZ +* INTEGER INFO, LDZ, LIWORK, LRWORK, LWORK, N +* .. +* .. Array Arguments .. +* INTEGER IWORK( * ) +* DOUBLE PRECISION D( * ), E( * ), RWORK( * ) +* COMPLEX*16 WORK( * ), Z( LDZ, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZSTEDC computes all eigenvalues and, optionally, eigenvectors of a +*> symmetric tridiagonal matrix using the divide and conquer method. +*> The eigenvectors of a full or band complex Hermitian matrix can also +*> be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this +*> matrix to tridiagonal form. +*> +*> This code makes very mild assumptions about floating point +*> arithmetic. It will work on machines with a guard digit in +*> add/subtract, or on those binary machines without guard digits +*> which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2. +*> It could conceivably fail on hexadecimal or decimal machines +*> without guard digits, but we know of none. See DLAED3 for details. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] COMPZ +*> \verbatim +*> COMPZ is CHARACTER*1 +*> = 'N': Compute eigenvalues only. +*> = 'I': Compute eigenvectors of tridiagonal matrix also. +*> = 'V': Compute eigenvectors of original Hermitian matrix +*> also. On entry, Z contains the unitary matrix used +*> to reduce the original matrix to tridiagonal form. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The dimension of the symmetric tridiagonal matrix. N >= 0. +*> \endverbatim +*> +*> \param[in,out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension (N) +*> On entry, the diagonal elements of the tridiagonal matrix. +*> On exit, if INFO = 0, the eigenvalues in ascending order. +*> \endverbatim +*> +*> \param[in,out] E +*> \verbatim +*> E is DOUBLE PRECISION array, dimension (N-1) +*> On entry, the subdiagonal elements of the tridiagonal matrix. +*> On exit, E has been destroyed. +*> \endverbatim +*> +*> \param[in,out] Z +*> \verbatim +*> Z is COMPLEX*16 array, dimension (LDZ,N) +*> On entry, if COMPZ = 'V', then Z contains the unitary +*> matrix used in the reduction to tridiagonal form. +*> On exit, if INFO = 0, then if COMPZ = 'V', Z contains the +*> orthonormal eigenvectors of the original Hermitian matrix, +*> and if COMPZ = 'I', Z contains the orthonormal eigenvectors +*> of the symmetric tridiagonal matrix. +*> If COMPZ = 'N', then Z is not referenced. +*> \endverbatim +*> +*> \param[in] LDZ +*> \verbatim +*> LDZ is INTEGER +*> The leading dimension of the array Z. LDZ >= 1. +*> If eigenvectors are desired, then LDZ >= max(1,N). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of the array WORK. +*> If COMPZ = 'N' or 'I', or N <= 1, LWORK must be at least 1. +*> If COMPZ = 'V' and N > 1, LWORK must be at least N*N. +*> Note that for COMPZ = 'V', then if N is less than or +*> equal to the minimum divide size, usually 25, then LWORK need +*> only be 1. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal sizes of the WORK, RWORK and +*> IWORK arrays, returns these values as the first entries of +*> the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK)) +*> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK. +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER +*> The dimension of the array RWORK. +*> If COMPZ = 'N' or N <= 1, LRWORK must be at least 1. +*> If COMPZ = 'V' and N > 1, LRWORK must be at least +*> 1 + 3*N + 2*N*lg N + 4*N**2 , +*> where lg( N ) = smallest integer k such +*> that 2**k >= N. +*> If COMPZ = 'I' and N > 1, LRWORK must be at least +*> 1 + 4*N + 2*N**2 . +*> Note that for COMPZ = 'I' or 'V', then if N is less than or +*> equal to the minimum divide size, usually 25, then LRWORK +*> need only be max(1,2*(N-1)). +*> +*> If LRWORK = -1, then a workspace query is assumed; the +*> routine only calculates the optimal sizes of the WORK, RWORK +*> and IWORK arrays, returns these values as the first entries +*> of the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, dimension (MAX(1,LIWORK)) +*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. +*> \endverbatim +*> +*> \param[in] LIWORK +*> \verbatim +*> LIWORK is INTEGER +*> The dimension of the array IWORK. +*> If COMPZ = 'N' or N <= 1, LIWORK must be at least 1. +*> If COMPZ = 'V' or N > 1, LIWORK must be at least +*> 6 + 6*N + 5*N*lg N. +*> If COMPZ = 'I' or N > 1, LIWORK must be at least +*> 3 + 5*N . +*> Note that for COMPZ = 'I' or 'V', then if N is less than or +*> equal to the minimum divide size, usually 25, then LIWORK +*> need only be 1. +*> +*> If LIWORK = -1, then a workspace query is assumed; the +*> routine only calculates the optimal sizes of the WORK, RWORK +*> and IWORK arrays, returns these values as the first entries +*> of the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> > 0: The algorithm failed to compute an eigenvalue while +*> working on the submatrix lying in rows and columns +*> INFO/(N+1) through mod(INFO,N+1). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +*> \par Contributors: +* ================== +*> +*> Jeff Rutter, Computer Science Division, University of California +*> at Berkeley, USA +* +* ===================================================================== + SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, + $ LRWORK, IWORK, LIWORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER COMPZ + INTEGER INFO, LDZ, LIWORK, LRWORK, LWORK, N +* .. +* .. Array Arguments .. + INTEGER IWORK( * ) + DOUBLE PRECISION D( * ), E( * ), RWORK( * ) + COMPLEX*16 WORK( * ), Z( LDZ, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE, TWO + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 ) +* .. +* .. Local Scalars .. + LOGICAL LQUERY + INTEGER FINISH, I, ICOMPZ, II, J, K, LGN, LIWMIN, LL, + $ LRWMIN, LWMIN, M, SMLSIZ, START + DOUBLE PRECISION EPS, ORGNRM, P, TINY +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV + DOUBLE PRECISION DLAMCH, DLANST + EXTERNAL LSAME, ILAENV, DLAMCH, DLANST +* .. +* .. External Subroutines .. + EXTERNAL DLASCL, DLASET, DSTEDC, DSTEQR, DSTERF, XERBLA, + $ ZLACPY, ZLACRM, ZLAED0, ZSTEQR, ZSWAP +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, INT, LOG, MAX, MOD, SQRT +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 .OR. LIWORK.EQ.-1 ) +* + IF( LSAME( COMPZ, 'N' ) ) THEN + ICOMPZ = 0 + ELSE IF( LSAME( COMPZ, 'V' ) ) THEN + ICOMPZ = 1 + ELSE IF( LSAME( COMPZ, 'I' ) ) THEN + ICOMPZ = 2 + ELSE + ICOMPZ = -1 + END IF + IF( ICOMPZ.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( ( LDZ.LT.1 ) .OR. + $ ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1, N ) ) ) THEN + INFO = -6 + END IF +* + IF( INFO.EQ.0 ) THEN +* +* Compute the workspace requirements +* + SMLSIZ = ILAENV( 9, 'ZSTEDC', ' ', 0, 0, 0, 0 ) + IF( N.LE.1 .OR. ICOMPZ.EQ.0 ) THEN + LWMIN = 1 + LIWMIN = 1 + LRWMIN = 1 + ELSE IF( N.LE.SMLSIZ ) THEN + LWMIN = 1 + LIWMIN = 1 + LRWMIN = 2*( N - 1 ) + ELSE IF( ICOMPZ.EQ.1 ) THEN + LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) ) + IF( 2**LGN.LT.N ) + $ LGN = LGN + 1 + IF( 2**LGN.LT.N ) + $ LGN = LGN + 1 + LWMIN = N*N + LRWMIN = 1 + 3*N + 2*N*LGN + 4*N**2 + LIWMIN = 6 + 6*N + 5*N*LGN + ELSE IF( ICOMPZ.EQ.2 ) THEN + LWMIN = 1 + LRWMIN = 1 + 4*N + 2*N**2 + LIWMIN = 3 + 5*N + END IF + WORK( 1 ) = LWMIN + RWORK( 1 ) = LRWMIN + IWORK( 1 ) = LIWMIN +* + IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN + INFO = -8 + ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN + INFO = -10 + ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN + INFO = -12 + END IF + END IF +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZSTEDC', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN + IF( N.EQ.1 ) THEN + IF( ICOMPZ.NE.0 ) + $ Z( 1, 1 ) = ONE + RETURN + END IF +* +* If the following conditional clause is removed, then the routine +* will use the Divide and Conquer routine to compute only the +* eigenvalues, which requires (3N + 3N**2) real workspace and +* (2 + 5N + 2N lg(N)) integer workspace. +* Since on many architectures DSTERF is much faster than any other +* algorithm for finding eigenvalues only, it is used here +* as the default. If the conditional clause is removed, then +* information on the size of workspace needs to be changed. +* +* If COMPZ = 'N', use DSTERF to compute the eigenvalues. +* + IF( ICOMPZ.EQ.0 ) THEN + CALL DSTERF( N, D, E, INFO ) + GO TO 70 + END IF +* +* If N is smaller than the minimum divide size (SMLSIZ+1), then +* solve the problem with another solver. +* + IF( N.LE.SMLSIZ ) THEN +* + CALL ZSTEQR( COMPZ, N, D, E, Z, LDZ, RWORK, INFO ) +* + ELSE +* +* If COMPZ = 'I', we simply call DSTEDC instead. +* + IF( ICOMPZ.EQ.2 ) THEN + CALL DLASET( 'Full', N, N, ZERO, ONE, RWORK, N ) + LL = N*N + 1 + CALL DSTEDC( 'I', N, D, E, RWORK, N, + $ RWORK( LL ), LRWORK-LL+1, IWORK, LIWORK, INFO ) + DO 20 J = 1, N + DO 10 I = 1, N + Z( I, J ) = RWORK( ( J-1 )*N+I ) + 10 CONTINUE + 20 CONTINUE + GO TO 70 + END IF +* +* From now on, only option left to be handled is COMPZ = 'V', +* i.e. ICOMPZ = 1. +* +* Scale. +* + ORGNRM = DLANST( 'M', N, D, E ) + IF( ORGNRM.EQ.ZERO ) + $ GO TO 70 +* + EPS = DLAMCH( 'Epsilon' ) +* + START = 1 +* +* while ( START <= N ) +* + 30 CONTINUE + IF( START.LE.N ) THEN +* +* Let FINISH be the position of the next subdiagonal entry +* such that E( FINISH ) <= TINY or FINISH = N if no such +* subdiagonal exists. The matrix identified by the elements +* between START and FINISH constitutes an independent +* sub-problem. +* + FINISH = START + 40 CONTINUE + IF( FINISH.LT.N ) THEN + TINY = EPS*SQRT( ABS( D( FINISH ) ) )* + $ SQRT( ABS( D( FINISH+1 ) ) ) + IF( ABS( E( FINISH ) ).GT.TINY ) THEN + FINISH = FINISH + 1 + GO TO 40 + END IF + END IF +* +* (Sub) Problem determined. Compute its size and solve it. +* + M = FINISH - START + 1 + IF( M.GT.SMLSIZ ) THEN +* +* Scale. +* + ORGNRM = DLANST( 'M', M, D( START ), E( START ) ) + CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M, + $ INFO ) + CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ), + $ M-1, INFO ) +* + CALL ZLAED0( N, M, D( START ), E( START ), Z( 1, START ), + $ LDZ, WORK, N, RWORK, IWORK, INFO ) + IF( INFO.GT.0 ) THEN + INFO = ( INFO / ( M+1 )+START-1 )*( N+1 ) + + $ MOD( INFO, ( M+1 ) ) + START - 1 + GO TO 70 + END IF +* +* Scale back. +* + CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M, + $ INFO ) +* + ELSE + CALL DSTEQR( 'I', M, D( START ), E( START ), RWORK, M, + $ RWORK( M*M+1 ), INFO ) + CALL ZLACRM( N, M, Z( 1, START ), LDZ, RWORK, M, WORK, N, + $ RWORK( M*M+1 ) ) + CALL ZLACPY( 'A', N, M, WORK, N, Z( 1, START ), LDZ ) + IF( INFO.GT.0 ) THEN + INFO = START*( N+1 ) + FINISH + GO TO 70 + END IF + END IF +* + START = FINISH + 1 + GO TO 30 + END IF +* +* endwhile +* +* +* Use Selection Sort to minimize swaps of eigenvectors +* + DO 60 II = 2, N + I = II - 1 + K = I + P = D( I ) + DO 50 J = II, N + IF( D( J ).LT.P ) THEN + K = J + P = D( J ) + END IF + 50 CONTINUE + IF( K.NE.I ) THEN + D( K ) = D( I ) + D( I ) = P + CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 ) + END IF + 60 CONTINUE + END IF +* + 70 CONTINUE + WORK( 1 ) = LWMIN + RWORK( 1 ) = LRWMIN + IWORK( 1 ) = LIWMIN +* + RETURN +* +* End of ZSTEDC +* + END diff --git a/lib/linalg/zunm2l.f b/lib/linalg/zunm2l.f new file mode 100644 index 0000000000..48c2dbfc0c --- /dev/null +++ b/lib/linalg/zunm2l.f @@ -0,0 +1,278 @@ +*> \brief \b ZUNM2L multiplies a general matrix by the unitary matrix from a QL factorization determined by cgeqlf (unblocked algorithm). +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNM2L + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, +* WORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE, TRANS +* INTEGER INFO, K, LDA, LDC, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNM2L overwrites the general complex m-by-n matrix C with +*> +*> Q * C if SIDE = 'L' and TRANS = 'N', or +*> +*> Q**H* C if SIDE = 'L' and TRANS = 'C', or +*> +*> C * Q if SIDE = 'R' and TRANS = 'N', or +*> +*> C * Q**H if SIDE = 'R' and TRANS = 'C', +*> +*> where Q is a complex unitary matrix defined as the product of k +*> elementary reflectors +*> +*> Q = H(k) . . . H(2) H(1) +*> +*> as returned by ZGEQLF. Q is of order m if SIDE = 'L' and of order n +*> if SIDE = 'R'. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': apply Q or Q**H from the Left +*> = 'R': apply Q or Q**H from the Right +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> = 'N': apply Q (No transpose) +*> = 'C': apply Q**H (Conjugate transpose) +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The number of elementary reflectors whose product defines +*> the matrix Q. +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,K) +*> The i-th column must contain the vector which defines the +*> elementary reflector H(i), for i = 1,2,...,k, as returned by +*> ZGEQLF in the last k columns of its array argument A. +*> A is modified by the routine but restored on exit. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. +*> If SIDE = 'L', LDA >= max(1,M); +*> if SIDE = 'R', LDA >= max(1,N). +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i), as returned by ZGEQLF. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the m-by-n matrix C. +*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension +*> (N) if SIDE = 'L', +*> (M) if SIDE = 'R' +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE, TRANS + INTEGER INFO, K, LDA, LDC, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 ONE + PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL LEFT, NOTRAN + INTEGER I, I1, I2, I3, MI, NI, NQ + COMPLEX*16 AII, TAUI +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZLARF +* .. +* .. Intrinsic Functions .. + INTRINSIC DCONJG, MAX +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + LEFT = LSAME( SIDE, 'L' ) + NOTRAN = LSAME( TRANS, 'N' ) +* +* NQ is the order of Q +* + IF( LEFT ) THEN + NQ = M + ELSE + NQ = N + END IF + IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN + INFO = -1 + ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + INFO = -2 + ELSE IF( M.LT.0 ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN + INFO = -7 + ELSE IF( LDC.LT.MAX( 1, M ) ) THEN + INFO = -10 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNM2L', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) + $ RETURN +* + IF( ( LEFT .AND. NOTRAN .OR. .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN + I1 = 1 + I2 = K + I3 = 1 + ELSE + I1 = K + I2 = 1 + I3 = -1 + END IF +* + IF( LEFT ) THEN + NI = N + ELSE + MI = M + END IF +* + DO 10 I = I1, I2, I3 + IF( LEFT ) THEN +* +* H(i) or H(i)**H is applied to C(1:m-k+i,1:n) +* + MI = M - K + I + ELSE +* +* H(i) or H(i)**H is applied to C(1:m,1:n-k+i) +* + NI = N - K + I + END IF +* +* Apply H(i) or H(i)**H +* + IF( NOTRAN ) THEN + TAUI = TAU( I ) + ELSE + TAUI = DCONJG( TAU( I ) ) + END IF + AII = A( NQ-K+I, I ) + A( NQ-K+I, I ) = ONE + CALL ZLARF( SIDE, MI, NI, A( 1, I ), 1, TAUI, C, LDC, WORK ) + A( NQ-K+I, I ) = AII + 10 CONTINUE + RETURN +* +* End of ZUNM2L +* + END diff --git a/lib/linalg/zunm2r.f b/lib/linalg/zunm2r.f new file mode 100644 index 0000000000..aec5a8bcae --- /dev/null +++ b/lib/linalg/zunm2r.f @@ -0,0 +1,283 @@ +*> \brief \b ZUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf (unblocked algorithm). +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNM2R + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, +* WORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE, TRANS +* INTEGER INFO, K, LDA, LDC, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNM2R overwrites the general complex m-by-n matrix C with +*> +*> Q * C if SIDE = 'L' and TRANS = 'N', or +*> +*> Q**H* C if SIDE = 'L' and TRANS = 'C', or +*> +*> C * Q if SIDE = 'R' and TRANS = 'N', or +*> +*> C * Q**H if SIDE = 'R' and TRANS = 'C', +*> +*> where Q is a complex unitary matrix defined as the product of k +*> elementary reflectors +*> +*> Q = H(1) H(2) . . . H(k) +*> +*> as returned by ZGEQRF. Q is of order m if SIDE = 'L' and of order n +*> if SIDE = 'R'. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': apply Q or Q**H from the Left +*> = 'R': apply Q or Q**H from the Right +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> = 'N': apply Q (No transpose) +*> = 'C': apply Q**H (Conjugate transpose) +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The number of elementary reflectors whose product defines +*> the matrix Q. +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,K) +*> The i-th column must contain the vector which defines the +*> elementary reflector H(i), for i = 1,2,...,k, as returned by +*> ZGEQRF in the first k columns of its array argument A. +*> A is modified by the routine but restored on exit. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. +*> If SIDE = 'L', LDA >= max(1,M); +*> if SIDE = 'R', LDA >= max(1,N). +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i), as returned by ZGEQRF. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the m-by-n matrix C. +*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension +*> (N) if SIDE = 'L', +*> (M) if SIDE = 'R' +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE, TRANS + INTEGER INFO, K, LDA, LDC, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 ONE + PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL LEFT, NOTRAN + INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ + COMPLEX*16 AII, TAUI +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZLARF +* .. +* .. Intrinsic Functions .. + INTRINSIC DCONJG, MAX +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + LEFT = LSAME( SIDE, 'L' ) + NOTRAN = LSAME( TRANS, 'N' ) +* +* NQ is the order of Q +* + IF( LEFT ) THEN + NQ = M + ELSE + NQ = N + END IF + IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN + INFO = -1 + ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + INFO = -2 + ELSE IF( M.LT.0 ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN + INFO = -7 + ELSE IF( LDC.LT.MAX( 1, M ) ) THEN + INFO = -10 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNM2R', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) + $ RETURN +* + IF( ( LEFT .AND. .NOT.NOTRAN .OR. .NOT.LEFT .AND. NOTRAN ) ) THEN + I1 = 1 + I2 = K + I3 = 1 + ELSE + I1 = K + I2 = 1 + I3 = -1 + END IF +* + IF( LEFT ) THEN + NI = N + JC = 1 + ELSE + MI = M + IC = 1 + END IF +* + DO 10 I = I1, I2, I3 + IF( LEFT ) THEN +* +* H(i) or H(i)**H is applied to C(i:m,1:n) +* + MI = M - I + 1 + IC = I + ELSE +* +* H(i) or H(i)**H is applied to C(1:m,i:n) +* + NI = N - I + 1 + JC = I + END IF +* +* Apply H(i) or H(i)**H +* + IF( NOTRAN ) THEN + TAUI = TAU( I ) + ELSE + TAUI = DCONJG( TAU( I ) ) + END IF + AII = A( I, I ) + A( I, I ) = ONE + CALL ZLARF( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), LDC, + $ WORK ) + A( I, I ) = AII + 10 CONTINUE + RETURN +* +* End of ZUNM2R +* + END diff --git a/lib/linalg/zunmql.f b/lib/linalg/zunmql.f new file mode 100644 index 0000000000..06353a0c75 --- /dev/null +++ b/lib/linalg/zunmql.f @@ -0,0 +1,336 @@ +*> \brief \b ZUNMQL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNMQL + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, +* WORK, LWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE, TRANS +* INTEGER INFO, K, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNMQL overwrites the general complex M-by-N matrix C with +*> +*> SIDE = 'L' SIDE = 'R' +*> TRANS = 'N': Q * C C * Q +*> TRANS = 'C': Q**H * C C * Q**H +*> +*> where Q is a complex unitary matrix defined as the product of k +*> elementary reflectors +*> +*> Q = H(k) . . . H(2) H(1) +*> +*> as returned by ZGEQLF. Q is of order M if SIDE = 'L' and of order N +*> if SIDE = 'R'. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': apply Q or Q**H from the Left; +*> = 'R': apply Q or Q**H from the Right. +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> = 'N': No transpose, apply Q; +*> = 'C': Conjugate transpose, apply Q**H. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The number of elementary reflectors whose product defines +*> the matrix Q. +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,K) +*> The i-th column must contain the vector which defines the +*> elementary reflector H(i), for i = 1,2,...,k, as returned by +*> ZGEQLF in the last k columns of its array argument A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. +*> If SIDE = 'L', LDA >= max(1,M); +*> if SIDE = 'R', LDA >= max(1,N). +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i), as returned by ZGEQLF. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the M-by-N matrix C. +*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of the array WORK. +*> If SIDE = 'L', LWORK >= max(1,N); +*> if SIDE = 'R', LWORK >= max(1,M). +*> 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 +*> this value as the first entry of the WORK array, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, LWORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE, TRANS + INTEGER INFO, K, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + 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, IWT, LDWORK, LWKOPT, + $ MI, NB, NBMIN, NI, NQ, NW +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV + EXTERNAL LSAME, ILAENV +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZLARFB, ZLARFT, ZUNM2L +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + LEFT = LSAME( SIDE, 'L' ) + NOTRAN = LSAME( TRANS, 'N' ) + LQUERY = ( LWORK.EQ.-1 ) +* +* NQ is the order of Q and NW is the minimum dimension of WORK +* + IF( LEFT ) THEN + NQ = M + NW = MAX( 1, N ) + ELSE + NQ = N + NW = MAX( 1, M ) + END IF + IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN + INFO = -1 + ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + INFO = -2 + ELSE IF( M.LT.0 ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN + 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 + NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQL', SIDE // TRANS, M, N, + $ K, -1 ) ) + LWKOPT = NW*NB + TSIZE + END IF + WORK( 1 ) = LWKOPT + END IF +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNMQL', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN + RETURN + END IF +* + NBMIN = 2 + LDWORK = NW + IF( NB.GT.1 .AND. NB.LT.K ) THEN + IF( LWORK.LT.LWKOPT ) THEN + NB = (LWORK-TSIZE) / LDWORK + NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQL', SIDE // TRANS, M, N, K, + $ -1 ) ) + END IF + END IF +* + IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN +* +* Use unblocked code +* + CALL ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + $ IINFO ) + ELSE +* +* Use blocked code +* + IWT = 1 + NW*NB + IF( ( LEFT .AND. NOTRAN ) .OR. + $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN + I1 = 1 + I2 = K + I3 = NB + ELSE + I1 = ( ( K-1 ) / NB )*NB + 1 + I2 = 1 + I3 = -NB + END IF +* + IF( LEFT ) THEN + NI = N + ELSE + MI = M + END IF +* + DO 10 I = I1, I2, I3 + IB = MIN( NB, K-I+1 ) +* +* Form the triangular factor of the block reflector +* H = H(i+ib-1) . . . H(i+1) H(i) +* + CALL ZLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB, + $ A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT ) + IF( LEFT ) THEN +* +* H or H**H is applied to C(1:m-k+i+ib-1,1:n) +* + MI = M - K + I + IB - 1 + ELSE +* +* H or H**H is applied to C(1:m,1:n-k+i+ib-1) +* + NI = N - K + I + IB - 1 + END IF +* +* Apply H or H**H +* + CALL ZLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI, + $ IB, A( 1, I ), LDA, WORK( IWT ), LDT, C, LDC, + $ WORK, LDWORK ) + 10 CONTINUE + END IF + WORK( 1 ) = LWKOPT + RETURN +* +* End of ZUNMQL +* + END diff --git a/lib/linalg/zunmqr.f b/lib/linalg/zunmqr.f new file mode 100644 index 0000000000..2ae205f4fd --- /dev/null +++ b/lib/linalg/zunmqr.f @@ -0,0 +1,337 @@ +*> \brief \b ZUNMQR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNMQR + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, +* WORK, LWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE, TRANS +* INTEGER INFO, K, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNMQR overwrites the general complex M-by-N matrix C with +*> +*> SIDE = 'L' SIDE = 'R' +*> TRANS = 'N': Q * C C * Q +*> TRANS = 'C': Q**H * C C * Q**H +*> +*> where Q is a complex unitary matrix defined as the product of k +*> elementary reflectors +*> +*> Q = H(1) H(2) . . . H(k) +*> +*> as returned by ZGEQRF. Q is of order M if SIDE = 'L' and of order N +*> if SIDE = 'R'. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': apply Q or Q**H from the Left; +*> = 'R': apply Q or Q**H from the Right. +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> = 'N': No transpose, apply Q; +*> = 'C': Conjugate transpose, apply Q**H. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The number of elementary reflectors whose product defines +*> the matrix Q. +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,K) +*> The i-th column must contain the vector which defines the +*> elementary reflector H(i), for i = 1,2,...,k, as returned by +*> ZGEQRF in the first k columns of its array argument A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. +*> If SIDE = 'L', LDA >= max(1,M); +*> if SIDE = 'R', LDA >= max(1,N). +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i), as returned by ZGEQRF. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the M-by-N matrix C. +*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of the array WORK. +*> If SIDE = 'L', LWORK >= max(1,N); +*> if SIDE = 'R', LWORK >= max(1,M). +*> 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 +*> this value as the first entry of the WORK array, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, LWORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE, TRANS + INTEGER INFO, K, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + 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, IWT, JC, LDWORK, + $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV + EXTERNAL LSAME, ILAENV +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZLARFB, ZLARFT, ZUNM2R +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + LEFT = LSAME( SIDE, 'L' ) + NOTRAN = LSAME( TRANS, 'N' ) + LQUERY = ( LWORK.EQ.-1 ) +* +* NQ is the order of Q and NW is the minimum dimension of WORK +* + IF( LEFT ) THEN + NQ = M + NW = MAX( 1, N ) + ELSE + NQ = N + NW = MAX( 1, M ) + END IF + IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN + INFO = -1 + ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + INFO = -2 + ELSE IF( M.LT.0 ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN + 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 +* + NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N, K, + $ -1 ) ) + LWKOPT = NW*NB + TSIZE + WORK( 1 ) = LWKOPT + END IF +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNMQR', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible +* + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN + WORK( 1 ) = 1 + RETURN + END IF +* + NBMIN = 2 + LDWORK = NW + IF( NB.GT.1 .AND. NB.LT.K ) THEN + IF( LWORK.LT.LWKOPT ) THEN + NB = (LWORK-TSIZE) / LDWORK + NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQR', SIDE // TRANS, M, N, K, + $ -1 ) ) + END IF + END IF +* + IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN +* +* Use unblocked code +* + CALL ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + $ IINFO ) + ELSE +* +* Use blocked code +* + IWT = 1 + NW*NB + IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. + $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN + I1 = 1 + I2 = K + I3 = NB + ELSE + I1 = ( ( K-1 ) / NB )*NB + 1 + I2 = 1 + I3 = -NB + END IF +* + IF( LEFT ) THEN + NI = N + JC = 1 + ELSE + MI = M + IC = 1 + END IF +* + DO 10 I = I1, I2, I3 + IB = MIN( NB, K-I+1 ) +* +* Form the triangular factor of the block reflector +* H = H(i) H(i+1) . . . H(i+ib-1) +* + CALL ZLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ), + $ LDA, TAU( I ), WORK( IWT ), LDT ) + IF( LEFT ) THEN +* +* H or H**H is applied to C(i:m,1:n) +* + MI = M - I + 1 + IC = I + ELSE +* +* H or H**H is applied to C(1:m,i:n) +* + NI = N - I + 1 + JC = I + END IF +* +* Apply H or H**H +* + CALL ZLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI, + $ IB, A( I, I ), LDA, WORK( IWT ), LDT, + $ C( IC, JC ), LDC, WORK, LDWORK ) + 10 CONTINUE + END IF + WORK( 1 ) = LWKOPT + RETURN +* +* End of ZUNMQR +* + END diff --git a/lib/linalg/zunmtr.f b/lib/linalg/zunmtr.f new file mode 100644 index 0000000000..441a7c2bcc --- /dev/null +++ b/lib/linalg/zunmtr.f @@ -0,0 +1,307 @@ +*> \brief \b ZUNMTR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNMTR + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, +* WORK, LWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE, TRANS, UPLO +* INTEGER INFO, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNMTR overwrites the general complex M-by-N matrix C with +*> +*> SIDE = 'L' SIDE = 'R' +*> TRANS = 'N': Q * C C * Q +*> TRANS = 'C': Q**H * C C * Q**H +*> +*> where Q is a complex unitary matrix of order nq, with nq = m if +*> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of +*> nq-1 elementary reflectors, as returned by ZHETRD: +*> +*> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); +*> +*> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': apply Q or Q**H from the Left; +*> = 'R': apply Q or Q**H from the Right. +*> \endverbatim +*> +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> = 'U': Upper triangle of A contains elementary reflectors +*> from ZHETRD; +*> = 'L': Lower triangle of A contains elementary reflectors +*> from ZHETRD. +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> = 'N': No transpose, apply Q; +*> = 'C': Conjugate transpose, apply Q**H. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. N >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension +*> (LDA,M) if SIDE = 'L' +*> (LDA,N) if SIDE = 'R' +*> The vectors which define the elementary reflectors, as +*> returned by ZHETRD. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. +*> LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension +*> (M-1) if SIDE = 'L' +*> (N-1) if SIDE = 'R' +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i), as returned by ZHETRD. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the M-by-N matrix C. +*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> 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. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal size of the WORK array, returns +*> this value as the first entry of the WORK array, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, + $ WORK, LWORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE, TRANS, UPLO + INTEGER INFO, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + LOGICAL LEFT, LQUERY, UPPER + INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV + EXTERNAL LSAME, ILAENV +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZUNMQL, ZUNMQR +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + LEFT = LSAME( SIDE, 'L' ) + UPPER = LSAME( UPLO, 'U' ) + LQUERY = ( LWORK.EQ.-1 ) +* +* NQ is the order of Q and NW is the minimum dimension of WORK +* + IF( LEFT ) THEN + NQ = M + NW = MAX( 1, N ) + ELSE + NQ = N + NW = MAX( 1, M ) + END IF + IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN + INFO = -1 + ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -2 + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) + $ THEN + INFO = -3 + ELSE IF( M.LT.0 ) THEN + INFO = -4 + ELSE IF( N.LT.0 ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN + 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 + IF( UPPER ) THEN + IF( LEFT ) THEN + NB = ILAENV( 1, 'ZUNMQL', SIDE // TRANS, M-1, N, M-1, + $ -1 ) + ELSE + NB = ILAENV( 1, 'ZUNMQL', SIDE // TRANS, M, N-1, N-1, + $ -1 ) + END IF + ELSE + IF( LEFT ) THEN + NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M-1, N, M-1, + $ -1 ) + ELSE + NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N-1, N-1, + $ -1 ) + END IF + END IF + LWKOPT = NW*NB + WORK( 1 ) = LWKOPT + END IF +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNMTR', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible +* + IF( M.EQ.0 .OR. N.EQ.0 .OR. NQ.EQ.1 ) THEN + WORK( 1 ) = 1 + RETURN + END IF +* + IF( LEFT ) THEN + MI = M - 1 + NI = N + ELSE + MI = M + NI = N - 1 + END IF +* + IF( UPPER ) THEN +* +* Q was determined by a call to ZHETRD with UPLO = 'U' +* + CALL ZUNMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, C, + $ LDC, WORK, LWORK, IINFO ) + ELSE +* +* Q was determined by a call to ZHETRD with UPLO = 'L' +* + IF( LEFT ) THEN + I1 = 2 + I2 = 1 + ELSE + I1 = 1 + I2 = 2 + END IF + CALL ZUNMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU, + $ C( I1, I2 ), LDC, WORK, LWORK, IINFO ) + END IF + WORK( 1 ) = LWKOPT + RETURN +* +* End of ZUNMTR +* + END From 1f4447d1cd4fa1db02f5e21036e37176c79029d4 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Thu, 21 Jul 2022 05:32:53 -0400 Subject: [PATCH 6/8] add USE_INTERNAL_LINALG to workaround passing BLAS/LAPACK settings to external projects --- cmake/CMakeLists.txt | 8 ++++--- cmake/Modules/Packages/LATTE.cmake | 5 ++-- doc/src/Build_extras.rst | 38 +++++++++++++++++++++++------- 3 files changed, 37 insertions(+), 14 deletions(-) diff --git a/cmake/CMakeLists.txt b/cmake/CMakeLists.txt index 669bff1533..d599a500c7 100644 --- a/cmake/CMakeLists.txt +++ b/cmake/CMakeLists.txt @@ -404,9 +404,11 @@ endif() if(PKG_MSCG OR PKG_ATC OR PKG_AWPMD OR PKG_ML-QUIP OR PKG_LATTE OR PKG_ELECTRODE) enable_language(C) - find_package(LAPACK) - find_package(BLAS) - if(NOT LAPACK_FOUND OR NOT BLAS_FOUND) + if (NOT USE_INTERNAL_LINALG) + find_package(LAPACK) + find_package(BLAS) + endif() + if(NOT LAPACK_FOUND OR NOT BLAS_FOUND OR USE_INTERNAL_LINALG) include(CheckGeneratorSupport) if(NOT CMAKE_GENERATOR_SUPPORT_FORTRAN) status(FATAL_ERROR "Cannot build internal linear algebra library as CMake build tool lacks Fortran support") diff --git a/cmake/Modules/Packages/LATTE.cmake b/cmake/Modules/Packages/LATTE.cmake index a96e850f7e..d7793fa257 100644 --- a/cmake/Modules/Packages/LATTE.cmake +++ b/cmake/Modules/Packages/LATTE.cmake @@ -23,8 +23,9 @@ if(DOWNLOAD_LATTE) # CMake cannot pass BLAS or LAPACK library variable to external project if they are a list list(LENGTH BLAS_LIBRARIES} NUM_BLAS) list(LENGTH LAPACK_LIBRARIES NUM_LAPACK) - if((NUM_BLAS GREATER 1) OR (NUM_LAPACK GREATER 1)) - message(FATAL_ERROR "Cannot compile downloaded LATTE library due to a technical limitation") + if((NUM_BLAS GREATER 1) OR (NUM_LAPACK GREATER 1) AND NOT USE_INTERNAL_LINALG) + message(FATAL_ERROR "Cannot compile downloaded LATTE library due to a technical limitation. " + "Try to configure LAMMPS with '-D USE_INTERNAL_LINALG=on' added as a workaround.") endif() include(ExternalProject) diff --git a/doc/src/Build_extras.rst b/doc/src/Build_extras.rst index 14d0e290aa..3dad393a52 100644 --- a/doc/src/Build_extras.rst +++ b/doc/src/Build_extras.rst @@ -788,8 +788,10 @@ library. .. code-block:: bash - -D DOWNLOAD_LATTE=value # download LATTE for build, value = no (default) or yes - -D LATTE_LIBRARY=path # LATTE library file (only needed if a custom location) + -D DOWNLOAD_LATTE=value # download LATTE for build, value = no (default) or yes + -D LATTE_LIBRARY=path # LATTE library file (only needed if a custom location) + -D USE_INTERNAL_LINALG=value # Use the internal linear algebra library instead of LAPACK + # value = no (default) or yes If ``DOWNLOAD_LATTE`` is set, the LATTE library will be downloaded and built inside the CMake build directory. If the LATTE library @@ -797,6 +799,13 @@ library. ``LATTE_LIBRARY`` is the filename (plus path) of the LATTE library file, not the directory the library file is in. + The LATTE library requires LAPACK (and BLAS) and CMake can identify + their locations and pass that info to the LATTE build script. But + on some systems this triggers a (current) limitation of CMake and + the configuration will fail. Try enabling ``USE_INTERNAL_LINALG`` in + those cases to use the bundled linear algebra library and work around + the limitation. + .. tab:: Traditional make You can download and build the LATTE library manually if you @@ -1913,14 +1922,25 @@ within CMake will download the non-commercial use version. .. code-block:: bash - -D DOWNLOAD_QUIP=value # download OpenKIM API v2 for build, value = no (default) or yes - -D QUIP_LIBRARY=path # path to libquip.a (only needed if a custom location) + -D DOWNLOAD_QUIP=value # download QUIP library for build, value = no (default) or yes + -D QUIP_LIBRARY=path # path to libquip.a (only needed if a custom location) + -D USE_INTERNAL_LINALG=value # Use the internal linear algebra library instead of LAPACK + # value = no (default) or yes - CMake will try to download and build the QUIP library from GitHub, if it is not - found on the local machine. This requires to have git installed. It will use the same compilers - and flags as used for compiling LAMMPS. Currently this is only supported for the GNU and the - Intel compilers. Set the ``QUIP_LIBRARY`` variable if you want to use a previously compiled - and installed QUIP library and CMake cannot find it. + CMake will try to download and build the QUIP library from GitHub, + if it is not found on the local machine. This requires to have git + installed. It will use the same compilers and flags as used for + compiling LAMMPS. Currently this is only supported for the GNU + and the Intel compilers. Set the ``QUIP_LIBRARY`` variable if you + want to use a previously compiled and installed QUIP library and + CMake cannot find it. + + The QUIP library requires LAPACK (and BLAS) and CMake can identify + their locations and pass that info to the QUIP build script. But + on some systems this triggers a (current) limitation of CMake and + the configuration will fail. Try enabling ``USE_INTERNAL_LINALG`` in + those cases to use the bundled linear algebra library and work around + the limitation. .. tab:: Traditional make From 11c46a6e9055a6c6b659b22a242e2ae102c92005 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Thu, 21 Jul 2022 08:19:39 -0400 Subject: [PATCH 7/8] correct dangling and inconsistent links to sphinx homepage and rst docs --- doc/src/Build_manual.rst | 24 ++++++++++-------------- doc/src/Modify_style.rst | 15 ++++++++------- 2 files changed, 18 insertions(+), 21 deletions(-) diff --git a/doc/src/Build_manual.rst b/doc/src/Build_manual.rst index 90633d0811..d91ac94be5 100644 --- a/doc/src/Build_manual.rst +++ b/doc/src/Build_manual.rst @@ -48,18 +48,15 @@ Build using GNU make The LAMMPS manual is written in `reStructuredText `_ format which can be translated to different output format using the `Sphinx -`_ document generator tool. It also incorporates programmer -documentation extracted from the LAMMPS C++ sources through the `Doxygen -`_ program. Currently the translation to HTML, PDF -(via LaTeX), ePUB (for many e-book readers) and MOBI (for Amazon Kindle -readers) are supported. For that to work a Python 3 interpreter, the -``doxygen`` tools and internet access to download additional files and -tools are required. This download is usually only required once or -after the documentation folder is returned to a pristine state with -``make clean-all``. - -.. _rst: https://docutils.readthedocs.io/en/sphinx-docs/user/rst/quickstart.html -.. _sphinx: https://www.sphinx-doc.org +`_ document generator tool. It also +incorporates programmer documentation extracted from the LAMMPS C++ +sources through the `Doxygen `_ program. Currently +the translation to HTML, PDF (via LaTeX), ePUB (for many e-book readers) +and MOBI (for Amazon Kindle readers) are supported. For that to work a +Python 3 interpreter, the ``doxygen`` tools and internet access to +download additional files and tools are required. This download is +usually only required once or after the documentation folder is returned +to a pristine state with ``make clean-all``. For the documentation build a python virtual environment is set up in the folder ``doc/docenv`` and various python packages are installed into @@ -252,6 +249,5 @@ manual with ``make spelling``. This requires `a library called enchant positives* (e.g. keywords, names, abbreviations) those can be added to the file ``lammps/doc/utils/sphinx-config/false_positives.txt``. -.. _rst: https://docutils.readthedocs.io/en/sphinx-docs/user/rst/quickstart.html - .. _lws: https://www.lammps.org +.. _rst: https://www.sphinx-doc.org/en/master/usage/restructuredtext/index.html diff --git a/doc/src/Modify_style.rst b/doc/src/Modify_style.rst index 2ed83ed7c6..9b394f23a9 100644 --- a/doc/src/Modify_style.rst +++ b/doc/src/Modify_style.rst @@ -100,13 +100,14 @@ Documentation (strict) Contributions that add new styles or commands or augment existing ones must include the corresponding new or modified documentation in -`ReStructuredText format `_ (.rst files in the ``doc/src/`` folder). The -documentation shall be written in American English and the .rst file -must use only ASCII characters so it can be cleanly translated to PDF -files (via `sphinx `_ and PDFLaTeX). Special characters may be included via -embedded math expression typeset in a LaTeX subset. +`ReStructuredText format `_ (.rst files in the ``doc/src/`` +folder). The documentation shall be written in American English and the +.rst file must use only ASCII characters so it can be cleanly translated +to PDF files (via `sphinx `_ and PDFLaTeX). +Special characters may be included via embedded math expression typeset +in a LaTeX subset. -.. _rst: https://docutils.readthedocs.io/en/sphinx-docs/user/rst/quickstart.html +.. _rst: https://www.sphinx-doc.org/en/master/usage/restructuredtext/index.html When adding new commands, they need to be integrated into the sphinx documentation system, and the corresponding command tables and lists @@ -133,7 +134,7 @@ error free completion of the HTML and PDF build will be performed and also a spell check, a check for correct anchors and labels, and a check for completeness of references all styles in their corresponding tables and lists is run. In case the spell check reports false positives they -can be added to the file doc/utils/sphinx-config/false_positives.txt +can be added to the file ``doc/utils/sphinx-config/false_positives.txt`` Contributions that add or modify the library interface or "public" APIs from the C++ code or the Fortran module must include suitable doxygen From c8cc2b1b24467a18482a07bf90962c3341316622 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Thu, 21 Jul 2022 08:41:44 -0400 Subject: [PATCH 8/8] update to LAPACK version 3.10.1 --- lib/linalg/dasum.f | 8 +++--- lib/linalg/daxpy.f | 8 +++--- lib/linalg/dbdsqr.f | 7 ++--- lib/linalg/dcabs1.f | 8 +++--- lib/linalg/dcopy.f | 8 +++--- lib/linalg/ddot.f | 8 +++--- lib/linalg/dgebd2.f | 5 +--- lib/linalg/dgebrd.f | 8 ++---- lib/linalg/dgecon.f | 5 +--- lib/linalg/dgelq2.f | 17 +++++++----- lib/linalg/dgelqf.f | 15 +++++++---- lib/linalg/dgelsd.f | 5 +--- lib/linalg/dgelss.f | 5 +--- lib/linalg/dgemm.f | 15 ++++------- lib/linalg/dgemv.f | 7 ++--- lib/linalg/dgeqr2.f | 18 ++++++++----- lib/linalg/dgeqrf.f | 34 ++++++++++++++++-------- lib/linalg/dger.f | 7 ++--- lib/linalg/dgesv.f | 5 +--- lib/linalg/dgesvd.f | 5 +--- lib/linalg/dgetf2.f | 5 +--- lib/linalg/dgetrf.f | 5 +--- lib/linalg/dgetrf2.f | 5 +--- lib/linalg/dgetri.f | 5 +--- lib/linalg/dgetrs.f | 5 +--- lib/linalg/disnan.f | 5 +--- lib/linalg/dlabad.f | 5 +--- lib/linalg/dlabrd.f | 5 +--- lib/linalg/dlacn2.f | 28 +++++++++++++------- lib/linalg/dlacpy.f | 5 +--- lib/linalg/dladiv.f | 13 +++------- lib/linalg/dlae2.f | 5 +--- lib/linalg/dlaed0.f | 7 ++--- lib/linalg/dlaed1.f | 7 ++--- lib/linalg/dlaed2.f | 7 ++--- lib/linalg/dlaed3.f | 7 ++--- lib/linalg/dlaed4.f | 9 +++---- lib/linalg/dlaed5.f | 9 +++---- lib/linalg/dlaed6.f | 7 ++--- lib/linalg/dlaed7.f | 7 ++--- lib/linalg/dlaed8.f | 7 ++--- lib/linalg/dlaed9.f | 7 ++--- lib/linalg/dlaeda.f | 7 ++--- lib/linalg/dlaev2.f | 5 +--- lib/linalg/dlaisnan.f | 5 +--- lib/linalg/dlals0.f | 5 +--- lib/linalg/dlalsa.f | 7 ++--- lib/linalg/dlalsd.f | 5 +--- lib/linalg/dlamrg.f | 5 +--- lib/linalg/dlange.f | 5 +--- lib/linalg/dlanst.f | 5 +--- lib/linalg/dlansy.f | 5 +--- lib/linalg/dlapy2.f | 15 ++++++----- lib/linalg/dlapy3.f | 15 ++++++----- lib/linalg/dlarf.f | 5 +--- lib/linalg/dlarfb.f | 7 +++-- lib/linalg/dlarfg.f | 7 ++--- lib/linalg/dlarft.f | 5 +--- lib/linalg/dlas2.f | 5 +--- lib/linalg/dlascl.f | 5 +--- lib/linalg/dlasd4.f | 5 +--- lib/linalg/dlasd5.f | 5 +--- lib/linalg/dlasd6.f | 5 +--- lib/linalg/dlasd7.f | 5 +--- lib/linalg/dlasd8.f | 5 +--- lib/linalg/dlasda.f | 5 +--- lib/linalg/dlasdq.f | 5 +--- lib/linalg/dlasdt.f | 5 +--- lib/linalg/dlaset.f | 5 +--- lib/linalg/dlasq1.f | 5 +--- lib/linalg/dlasq2.f | 20 +++++++++------ lib/linalg/dlasq3.f | 5 +--- lib/linalg/dlasq4.f | 5 +--- lib/linalg/dlasq5.f | 5 +--- lib/linalg/dlasq6.f | 5 +--- lib/linalg/dlasr.f | 7 ++--- lib/linalg/dlasrt.f | 5 +--- lib/linalg/dlasv2.f | 5 +--- lib/linalg/dlaswp.f | 5 +--- lib/linalg/dlatrd.f | 5 +--- lib/linalg/dlatrs.f | 5 +--- lib/linalg/dorg2l.f | 5 +--- lib/linalg/dorg2r.f | 5 +--- lib/linalg/dorgbr.f | 13 ++++------ lib/linalg/dorgl2.f | 5 +--- lib/linalg/dorglq.f | 5 +--- lib/linalg/dorgql.f | 5 +--- lib/linalg/dorgqr.f | 5 +--- lib/linalg/dorgtr.f | 5 +--- lib/linalg/dorm2l.f | 5 +--- lib/linalg/dorm2r.f | 5 +--- lib/linalg/dormbr.f | 13 ++++------ lib/linalg/dorml2.f | 5 +--- lib/linalg/dormlq.f | 15 +++++------ lib/linalg/dormql.f | 7 ++--- lib/linalg/dormqr.f | 15 +++++------ lib/linalg/dormtr.f | 13 ++++------ lib/linalg/dpotf2.f | 5 +--- lib/linalg/dpotrf.f | 5 +--- lib/linalg/dpotrf2.f | 5 +--- lib/linalg/drot.f | 8 +++--- lib/linalg/drscl.f | 7 ++--- lib/linalg/dscal.f | 8 +++--- lib/linalg/dstedc.f | 5 +--- lib/linalg/dsteqr.f | 5 +--- lib/linalg/dsterf.f | 5 +--- lib/linalg/dswap.f | 8 +++--- lib/linalg/dsyev.f | 5 +--- lib/linalg/dsyevd.f | 5 +--- lib/linalg/dsygs2.f | 5 +--- lib/linalg/dsygst.f | 5 +--- lib/linalg/dsygv.f | 5 +--- lib/linalg/dsygvd.f | 5 +--- lib/linalg/dsymm.f | 7 ++--- lib/linalg/dsymv.f | 7 ++--- lib/linalg/dsyr2.f | 7 ++--- lib/linalg/dsyr2k.f | 7 ++--- lib/linalg/dsyrk.f | 7 ++--- lib/linalg/dsytd2.f | 5 +--- lib/linalg/dsytrd.f | 5 +--- lib/linalg/dtrmm.f | 7 ++--- lib/linalg/dtrmv.f | 7 ++--- lib/linalg/dtrsm.f | 7 ++--- lib/linalg/dtrsv.f | 7 ++--- lib/linalg/dtrti2.f | 5 +--- lib/linalg/dtrtri.f | 5 +--- lib/linalg/idamax.f | 10 ++++---- lib/linalg/ieeeck.f | 5 +--- lib/linalg/iladlc.f | 5 +--- lib/linalg/iladlr.f | 5 +--- lib/linalg/ilaenv.f | 60 ++++++++++++++++++++++++++----------------- lib/linalg/ilazlc.f | 5 +--- lib/linalg/ilazlr.f | 5 +--- lib/linalg/iparmq.f | 37 ++++++++++++++++---------- lib/linalg/lsame.f | 5 +--- lib/linalg/xerbla.f | 5 +--- lib/linalg/zaxpy.f | 8 +++--- lib/linalg/zcopy.f | 8 +++--- lib/linalg/zdotc.f | 12 ++++----- lib/linalg/zdscal.f | 8 +++--- lib/linalg/zgemm.f | 14 +++------- lib/linalg/zgemv.f | 7 ++--- lib/linalg/zgerc.f | 7 ++--- lib/linalg/zheev.f | 7 ++--- lib/linalg/zheevd.f | 2 +- lib/linalg/zhemv.f | 7 ++--- lib/linalg/zher2.f | 7 ++--- lib/linalg/zher2k.f | 7 ++--- lib/linalg/zhetd2.f | 17 +++++------- lib/linalg/zhetrd.f | 9 +++---- lib/linalg/zhpr.f | 7 ++--- lib/linalg/zlacgv.f | 5 +--- lib/linalg/zladiv.f | 5 +--- lib/linalg/zlanhe.f | 5 +--- lib/linalg/zlarf.f | 5 +--- lib/linalg/zlarfb.f | 7 +++-- lib/linalg/zlarfg.f | 7 ++--- lib/linalg/zlarft.f | 5 +--- lib/linalg/zlascl.f | 5 +--- lib/linalg/zlaset.f | 5 +--- lib/linalg/zlasr.f | 5 +--- lib/linalg/zlatrd.f | 9 +++---- lib/linalg/zpptrf.f | 9 +++---- lib/linalg/zpptri.f | 7 ++--- lib/linalg/zscal.f | 8 +++--- lib/linalg/zsteqr.f | 5 +--- lib/linalg/zswap.f | 8 +++--- lib/linalg/ztpmv.f | 7 ++--- lib/linalg/ztpsv.f | 7 ++--- lib/linalg/ztptri.f | 5 +--- lib/linalg/ztrmm.f | 7 ++--- lib/linalg/ztrmv.f | 7 ++--- lib/linalg/zung2l.f | 5 +--- lib/linalg/zung2r.f | 5 +--- lib/linalg/zungl2.f | 5 +--- lib/linalg/zungql.f | 5 +--- lib/linalg/zungqr.f | 5 +--- lib/linalg/zungtr.f | 5 +--- 178 files changed, 471 insertions(+), 864 deletions(-) diff --git a/lib/linalg/dasum.f b/lib/linalg/dasum.f index cc5977f770..9a360b5acd 100644 --- a/lib/linalg/dasum.f +++ b/lib/linalg/dasum.f @@ -54,8 +54,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -71,10 +69,9 @@ * ===================================================================== DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -128,4 +125,7 @@ END IF DASUM = DTEMP RETURN +* +* End of DASUM +* END diff --git a/lib/linalg/daxpy.f b/lib/linalg/daxpy.f index cb94fc1e0a..421f7c630b 100644 --- a/lib/linalg/daxpy.f +++ b/lib/linalg/daxpy.f @@ -73,8 +73,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -89,10 +87,9 @@ * ===================================================================== SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION DA @@ -149,4 +146,7 @@ END DO END IF RETURN +* +* End of DAXPY +* END diff --git a/lib/linalg/dbdsqr.f b/lib/linalg/dbdsqr.f index 93db95e7a8..c220a5875d 100644 --- a/lib/linalg/dbdsqr.f +++ b/lib/linalg/dbdsqr.f @@ -166,7 +166,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (4*N) +*> WORK is DOUBLE PRECISION array, dimension (4*(N-1)) *> \endverbatim *> *> \param[out] INFO @@ -233,18 +233,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ LDU, C, LDC, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dcabs1.f b/lib/linalg/dcabs1.f index d6d850ed0f..f6212a8595 100644 --- a/lib/linalg/dcabs1.f +++ b/lib/linalg/dcabs1.f @@ -40,17 +40,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * * ===================================================================== DOUBLE PRECISION FUNCTION DCABS1(Z) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 Z @@ -63,4 +60,7 @@ * DCABS1 = ABS(DBLE(Z)) + ABS(DIMAG(Z)) RETURN +* +* End of DCABS1 +* END diff --git a/lib/linalg/dcopy.f b/lib/linalg/dcopy.f index 27bc08582b..ded46c5ecf 100644 --- a/lib/linalg/dcopy.f +++ b/lib/linalg/dcopy.f @@ -66,8 +66,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -82,10 +80,9 @@ * ===================================================================== SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -143,4 +140,7 @@ END DO END IF RETURN +* +* End of DCOPY +* END diff --git a/lib/linalg/ddot.f b/lib/linalg/ddot.f index 3d18695aab..683a04bd46 100644 --- a/lib/linalg/ddot.f +++ b/lib/linalg/ddot.f @@ -66,8 +66,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -82,10 +80,9 @@ * ===================================================================== DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -145,4 +142,7 @@ END IF DDOT = DTEMP RETURN +* +* End of DDOT +* END diff --git a/lib/linalg/dgebd2.f b/lib/linalg/dgebd2.f index 2bec4e29c7..daaa187aff 100644 --- a/lib/linalg/dgebd2.f +++ b/lib/linalg/dgebd2.f @@ -132,8 +132,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -189,10 +187,9 @@ * ===================================================================== SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgebrd.f b/lib/linalg/dgebrd.f index 957cf2e539..0f0d1651a7 100644 --- a/lib/linalg/dgebrd.f +++ b/lib/linalg/dgebrd.f @@ -147,8 +147,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -205,10 +203,9 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N @@ -227,8 +224,7 @@ * .. Local Scalars .. LOGICAL LQUERY INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB, - $ NBMIN, NX - DOUBLE PRECISION WS + $ NBMIN, NX, WS * .. * .. External Subroutines .. EXTERNAL DGEBD2, DGEMM, DLABRD, XERBLA diff --git a/lib/linalg/dgecon.f b/lib/linalg/dgecon.f index be20bbcd2a..aa10dee9a2 100644 --- a/lib/linalg/dgecon.f +++ b/lib/linalg/dgecon.f @@ -116,18 +116,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 NORM diff --git a/lib/linalg/dgelq2.f b/lib/linalg/dgelq2.f index 04aa57fc19..9915c57d47 100644 --- a/lib/linalg/dgelq2.f +++ b/lib/linalg/dgelq2.f @@ -33,8 +33,16 @@ *> *> \verbatim *> -*> DGELQ2 computes an LQ factorization of a real m by n matrix A: -*> A = L * Q. +*> DGELQ2 computes an LQ factorization of a real m-by-n matrix A: +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a n-by-n orthogonal matrix; +*> L is a lower-triangular m-by-m matrix; +*> 0 is a m-by-(n-m) zero matrix, if m < n. +*> *> \endverbatim * * Arguments: @@ -96,8 +104,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -121,10 +127,9 @@ * ===================================================================== SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgelqf.f b/lib/linalg/dgelqf.f index 834c47168f..ed3372f965 100644 --- a/lib/linalg/dgelqf.f +++ b/lib/linalg/dgelqf.f @@ -34,7 +34,15 @@ *> \verbatim *> *> DGELQF computes an LQ factorization of a real M-by-N matrix A: -*> A = L * Q. +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a N-by-N orthogonal matrix; +*> L is a lower-triangular M-by-M matrix; +*> 0 is a M-by-(N-M) zero matrix, if M < N. +*> *> \endverbatim * * Arguments: @@ -110,8 +118,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -135,10 +141,9 @@ * ===================================================================== SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lib/linalg/dgelsd.f b/lib/linalg/dgelsd.f index f2cfd63376..b3b3d8b2d3 100644 --- a/lib/linalg/dgelsd.f +++ b/lib/linalg/dgelsd.f @@ -194,8 +194,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleGEsolve * *> \par Contributors: @@ -209,10 +207,9 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ WORK, LWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.1) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK diff --git a/lib/linalg/dgelss.f b/lib/linalg/dgelss.f index 674a7ba784..8ed703fcf2 100644 --- a/lib/linalg/dgelss.f +++ b/lib/linalg/dgelss.f @@ -164,18 +164,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEsolve * * ===================================================================== SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ WORK, LWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- 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 .. INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK diff --git a/lib/linalg/dgemm.f b/lib/linalg/dgemm.f index 3a60ca4e73..8c1b4f2066 100644 --- a/lib/linalg/dgemm.f +++ b/lib/linalg/dgemm.f @@ -166,8 +166,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -187,10 +185,9 @@ * ===================================================================== SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -215,7 +212,7 @@ * .. * .. Local Scalars .. DOUBLE PRECISION TEMP - INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB + INTEGER I,INFO,J,L,NROWA,NROWB LOGICAL NOTA,NOTB * .. * .. Parameters .. @@ -224,17 +221,15 @@ * .. * * Set NOTA and NOTB as true if A and B respectively are not -* transposed and set NROWA, NCOLA and NROWB as the number of rows -* and columns of A and the number of rows of B respectively. +* transposed and set NROWA and NROWB as the number of rows of A +* and B respectively. * NOTA = LSAME(TRANSA,'N') NOTB = LSAME(TRANSB,'N') IF (NOTA) THEN NROWA = M - NCOLA = K ELSE NROWA = K - NCOLA = M END IF IF (NOTB) THEN NROWB = K @@ -379,6 +374,6 @@ * RETURN * -* End of DGEMM . +* End of DGEMM * END diff --git a/lib/linalg/dgemv.f b/lib/linalg/dgemv.f index 08e395b1cd..6625509b3a 100644 --- a/lib/linalg/dgemv.f +++ b/lib/linalg/dgemv.f @@ -134,8 +134,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level2 * *> \par Further Details: @@ -156,10 +154,9 @@ * ===================================================================== SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -325,6 +322,6 @@ * RETURN * -* End of DGEMV . +* End of DGEMV * END diff --git a/lib/linalg/dgeqr2.f b/lib/linalg/dgeqr2.f index c1e91e9bde..5791b3a915 100644 --- a/lib/linalg/dgeqr2.f +++ b/lib/linalg/dgeqr2.f @@ -33,8 +33,17 @@ *> *> \verbatim *> -*> DGEQR2 computes a QR factorization of a real m by n matrix A: -*> A = Q * R. +*> DGEQR2 computes a QR factorization of a real m-by-n matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a m-by-m orthogonal matrix; +*> R is an upper-triangular n-by-n matrix; +*> 0 is a (m-n)-by-n zero matrix, if m > n. +*> *> \endverbatim * * Arguments: @@ -96,8 +105,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -121,10 +128,9 @@ * ===================================================================== SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgeqrf.f b/lib/linalg/dgeqrf.f index 83d7d8dd71..705e939286 100644 --- a/lib/linalg/dgeqrf.f +++ b/lib/linalg/dgeqrf.f @@ -34,7 +34,16 @@ *> \verbatim *> *> DGEQRF computes a QR factorization of a real M-by-N matrix A: -*> A = Q * R. +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -86,7 +95,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,N). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise. *> For optimum performance LWORK >= N*NB, where NB is *> the optimal blocksize. *> @@ -111,8 +121,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -136,10 +144,9 @@ * ===================================================================== SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, LDA, LWORK, M, N @@ -169,10 +176,9 @@ * * Test the input arguments * + K = MIN( M, N ) INFO = 0 NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - LWKOPT = N*NB - WORK( 1 ) = LWKOPT LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -180,19 +186,25 @@ INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN - INFO = -7 + ELSE IF( .NOT.LQUERY ) THEN + IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) ) + $ INFO = -7 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DGEQRF', -INFO ) RETURN ELSE IF( LQUERY ) THEN + IF( K.EQ.0 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = N*NB + END IF + WORK( 1 ) = LWKOPT RETURN END IF * * Quick return if possible * - K = MIN( M, N ) IF( K.EQ.0 ) THEN WORK( 1 ) = 1 RETURN diff --git a/lib/linalg/dger.f b/lib/linalg/dger.f index bdc8ef4349..8c19cb4e41 100644 --- a/lib/linalg/dger.f +++ b/lib/linalg/dger.f @@ -109,8 +109,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level2 * *> \par Further Details: @@ -130,10 +128,9 @@ * ===================================================================== SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -222,6 +219,6 @@ * RETURN * -* End of DGER . +* End of DGER * END diff --git a/lib/linalg/dgesv.f b/lib/linalg/dgesv.f index 23999e167f..3609c52f47 100644 --- a/lib/linalg/dgesv.f +++ b/lib/linalg/dgesv.f @@ -115,17 +115,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEsolve * * ===================================================================== SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- 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 .. INTEGER INFO, LDA, LDB, N, NRHS diff --git a/lib/linalg/dgesvd.f b/lib/linalg/dgesvd.f index ddf0bd5c2d..7cc8b35129 100644 --- a/lib/linalg/dgesvd.f +++ b/lib/linalg/dgesvd.f @@ -203,18 +203,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup doubleGEsing * * ===================================================================== SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, $ VT, LDVT, WORK, LWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * .. Scalar Arguments .. CHARACTER JOBU, JOBVT diff --git a/lib/linalg/dgetf2.f b/lib/linalg/dgetf2.f index 5458a5f3eb..fc1587842e 100644 --- a/lib/linalg/dgetf2.f +++ b/lib/linalg/dgetf2.f @@ -101,17 +101,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgetrf.f b/lib/linalg/dgetrf.f index 9a340b60f3..73d0f3601a 100644 --- a/lib/linalg/dgetrf.f +++ b/lib/linalg/dgetrf.f @@ -101,17 +101,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgetrf2.f b/lib/linalg/dgetrf2.f index 77948d2305..40af0793dd 100644 --- a/lib/linalg/dgetrf2.f +++ b/lib/linalg/dgetrf2.f @@ -106,17 +106,14 @@ *> \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 computational routine -- * -- 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 diff --git a/lib/linalg/dgetri.f b/lib/linalg/dgetri.f index 9d8cf2ad3e..92ef90c186 100644 --- a/lib/linalg/dgetri.f +++ b/lib/linalg/dgetri.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, LDA, LWORK, N diff --git a/lib/linalg/dgetrs.f b/lib/linalg/dgetrs.f index 7ac727776e..d3464f685a 100644 --- a/lib/linalg/dgetrs.f +++ b/lib/linalg/dgetrs.f @@ -114,17 +114,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 TRANS diff --git a/lib/linalg/disnan.f b/lib/linalg/disnan.f index a565ed36d4..e621b2589c 100644 --- a/lib/linalg/disnan.f +++ b/lib/linalg/disnan.f @@ -52,17 +52,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * * ===================================================================== LOGICAL FUNCTION DISNAN( DIN ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. DOUBLE PRECISION, INTENT(IN) :: DIN diff --git a/lib/linalg/dlabad.f b/lib/linalg/dlabad.f index 01b8158f66..95b35e53b8 100644 --- a/lib/linalg/dlabad.f +++ b/lib/linalg/dlabad.f @@ -67,17 +67,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLABAD( SMALL, LARGE ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. DOUBLE PRECISION LARGE, SMALL diff --git a/lib/linalg/dlabrd.f b/lib/linalg/dlabrd.f index b5e734dc7c..86dfc10c7c 100644 --- a/lib/linalg/dlabrd.f +++ b/lib/linalg/dlabrd.f @@ -156,8 +156,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -210,10 +208,9 @@ SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, $ LDY ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER LDA, LDX, LDY, M, N, NB diff --git a/lib/linalg/dlacn2.f b/lib/linalg/dlacn2.f index 952854043a..ee2e7ca266 100644 --- a/lib/linalg/dlacn2.f +++ b/lib/linalg/dlacn2.f @@ -101,8 +101,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -136,10 +134,9 @@ * ===================================================================== SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER KASE, N @@ -160,7 +157,7 @@ * .. * .. Local Scalars .. INTEGER I, JLAST - DOUBLE PRECISION ALTSGN, ESTOLD, TEMP + DOUBLE PRECISION ALTSGN, ESTOLD, TEMP, XS * .. * .. External Functions .. INTEGER IDAMAX @@ -171,7 +168,7 @@ EXTERNAL DCOPY * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, NINT, SIGN + INTRINSIC ABS, DBLE, NINT * .. * .. Executable Statements .. * @@ -199,7 +196,11 @@ EST = DASUM( N, X, 1 ) * DO 30 I = 1, N - X( I ) = SIGN( ONE, X( I ) ) + IF( X(I).GE.ZERO ) THEN + X(I) = ONE + ELSE + X(I) = -ONE + END IF ISGN( I ) = NINT( X( I ) ) 30 CONTINUE KASE = 2 @@ -232,7 +233,12 @@ ESTOLD = EST EST = DASUM( N, V, 1 ) DO 80 I = 1, N - IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) ) + IF( X(I).GE.ZERO ) THEN + XS = ONE + ELSE + XS = -ONE + END IF + IF( NINT( XS ).NE.ISGN( I ) ) $ GO TO 90 80 CONTINUE * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. @@ -244,7 +250,11 @@ $ GO TO 120 * DO 100 I = 1, N - X( I ) = SIGN( ONE, X( I ) ) + IF( X(I).GE.ZERO ) THEN + X(I) = ONE + ELSE + X(I) = -ONE + END IF ISGN( I ) = NINT( X( I ) ) 100 CONTINUE KASE = 2 diff --git a/lib/linalg/dlacpy.f b/lib/linalg/dlacpy.f index d1c396724a..917aa1e2a2 100644 --- a/lib/linalg/dlacpy.f +++ b/lib/linalg/dlacpy.f @@ -96,17 +96,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 UPLO diff --git a/lib/linalg/dladiv.f b/lib/linalg/dladiv.f index dd8110adf2..4265618fed 100644 --- a/lib/linalg/dladiv.f +++ b/lib/linalg/dladiv.f @@ -84,17 +84,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date January 2013 -* *> \ingroup doubleOTHERauxiliary * * ===================================================================== SUBROUTINE DLADIV( A, B, C, D, P, Q ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 @@ -178,10 +175,9 @@ SUBROUTINE DLADIV1( A, B, C, D, P, Q ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 @@ -218,10 +214,9 @@ DOUBLE PRECISION FUNCTION DLADIV2( A, B, C, D, R, T ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 @@ -251,6 +246,6 @@ * RETURN * -* End of DLADIV12 +* End of DLADIV2 * END diff --git a/lib/linalg/dlae2.f b/lib/linalg/dlae2.f index ed77ff6dfe..a0e3971b41 100644 --- a/lib/linalg/dlae2.f +++ b/lib/linalg/dlae2.f @@ -78,8 +78,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -102,10 +100,9 @@ * ===================================================================== SUBROUTINE DLAE2( A, B, C, RT1, RT2 ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. DOUBLE PRECISION A, B, C, RT1, RT2 diff --git a/lib/linalg/dlaed0.f b/lib/linalg/dlaed0.f index 4e92da98ea..fe3b6249e9 100644 --- a/lib/linalg/dlaed0.f +++ b/lib/linalg/dlaed0.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED0 used by sstedc. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. +*> \brief \b DLAED0 used by DSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. * * =========== DOCUMENTATION =========== * @@ -158,8 +158,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -172,10 +170,9 @@ SUBROUTINE DLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, $ WORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER ICOMPQ, INFO, LDQ, LDQS, N, QSIZ diff --git a/lib/linalg/dlaed1.f b/lib/linalg/dlaed1.f index 30e71fa241..3718139c14 100644 --- a/lib/linalg/dlaed1.f +++ b/lib/linalg/dlaed1.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED1 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal. +*> \brief \b DLAED1 used by DSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== * @@ -148,8 +148,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -163,10 +161,9 @@ SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 CUTPNT, INFO, LDQ, N diff --git a/lib/linalg/dlaed2.f b/lib/linalg/dlaed2.f index fbcc87a880..9b1f1e0930 100644 --- a/lib/linalg/dlaed2.f +++ b/lib/linalg/dlaed2.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED2 used by sstedc. Merges eigenvalues and deflates secular equation. Used when the original matrix is tridiagonal. +*> \brief \b DLAED2 used by DSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== * @@ -197,8 +197,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -212,10 +210,9 @@ SUBROUTINE DLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMDA, W, $ Q2, INDX, INDXC, INDXP, COLTYP, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDQ, N, N1 diff --git a/lib/linalg/dlaed3.f b/lib/linalg/dlaed3.f index d200fc0a22..c58944e604 100644 --- a/lib/linalg/dlaed3.f +++ b/lib/linalg/dlaed3.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED3 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal. +*> \brief \b DLAED3 used by DSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== * @@ -170,8 +170,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -185,10 +183,9 @@ SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX, $ CTOT, W, S, INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER INFO, K, LDQ, N, N1 diff --git a/lib/linalg/dlaed4.f b/lib/linalg/dlaed4.f index e7dc839df5..3ee3ef920f 100644 --- a/lib/linalg/dlaed4.f +++ b/lib/linalg/dlaed4.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED4 used by sstedc. Finds a single root of the secular equation. +*> \brief \b DLAED4 used by DSTEDC. Finds a single root of the secular equation. * * =========== DOCUMENTATION =========== * @@ -82,7 +82,7 @@ *> \param[out] DELTA *> \verbatim *> DELTA is DOUBLE PRECISION array, dimension (N) -*> If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th +*> If N > 2, DELTA contains (D(j) - lambda_I) in its j-th *> component. If N = 1, then DELTA(1) = 1. If N = 2, see DLAED5 *> for detail. The vector DELTA contains the information necessary *> to construct the eigenvectors by DLAED3 and DLAED9. @@ -132,8 +132,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -145,10 +143,9 @@ * ===================================================================== SUBROUTINE DLAED4( N, I, D, Z, DELTA, RHO, DLAM, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER I, INFO, N diff --git a/lib/linalg/dlaed5.f b/lib/linalg/dlaed5.f index 3ea9e401cf..d9e977e6b7 100644 --- a/lib/linalg/dlaed5.f +++ b/lib/linalg/dlaed5.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED5 used by sstedc. Solves the 2-by-2 secular equation. +*> \brief \b DLAED5 used by DSTEDC. Solves the 2-by-2 secular equation. * * =========== DOCUMENTATION =========== * @@ -95,8 +95,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -108,10 +106,9 @@ * ===================================================================== SUBROUTINE DLAED5( I, D, Z, DELTA, RHO, DLAM ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER I @@ -184,6 +181,6 @@ END IF RETURN * -* End OF DLAED5 +* End of DLAED5 * END diff --git a/lib/linalg/dlaed6.f b/lib/linalg/dlaed6.f index daa8db39e4..a0c0364e56 100644 --- a/lib/linalg/dlaed6.f +++ b/lib/linalg/dlaed6.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED6 used by sstedc. Computes one Newton step in solution of the secular equation. +*> \brief \b DLAED6 used by DSTEDC. Computes one Newton step in solution of the secular equation. * * =========== DOCUMENTATION =========== * @@ -115,8 +115,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Further Details: @@ -140,10 +138,9 @@ * ===================================================================== SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. LOGICAL ORGATI diff --git a/lib/linalg/dlaed7.f b/lib/linalg/dlaed7.f index 9c528added..d968c56752 100644 --- a/lib/linalg/dlaed7.f +++ b/lib/linalg/dlaed7.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED7 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. +*> \brief \b DLAED7 used by DSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== * @@ -244,8 +244,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -260,10 +258,9 @@ $ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N, diff --git a/lib/linalg/dlaed8.f b/lib/linalg/dlaed8.f index f64679dc05..3631fb4566 100644 --- a/lib/linalg/dlaed8.f +++ b/lib/linalg/dlaed8.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED8 used by sstedc. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. +*> \brief \b DLAED8 used by DSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== * @@ -228,8 +228,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -243,10 +241,9 @@ $ CUTPNT, Z, DLAMDA, Q2, LDQ2, W, PERM, GIVPTR, $ GIVCOL, GIVNUM, INDXP, INDX, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER CUTPNT, GIVPTR, ICOMPQ, INFO, K, LDQ, LDQ2, N, diff --git a/lib/linalg/dlaed9.f b/lib/linalg/dlaed9.f index d3be22502a..b88cdd9077 100644 --- a/lib/linalg/dlaed9.f +++ b/lib/linalg/dlaed9.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED9 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense. +*> \brief \b DLAED9 used by DSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== * @@ -142,8 +142,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -156,10 +154,9 @@ SUBROUTINE DLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W, $ S, LDS, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, KSTART, KSTOP, LDQ, LDS, N diff --git a/lib/linalg/dlaeda.f b/lib/linalg/dlaeda.f index 4ca08a0879..8864fd7f2a 100644 --- a/lib/linalg/dlaeda.f +++ b/lib/linalg/dlaeda.f @@ -1,4 +1,4 @@ -*> \brief \b DLAEDA used by sstedc. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense. +*> \brief \b DLAEDA used by DSTEDC. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== * @@ -152,8 +152,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -166,10 +164,9 @@ SUBROUTINE DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, $ GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER CURLVL, CURPBM, INFO, N, TLVLS diff --git a/lib/linalg/dlaev2.f b/lib/linalg/dlaev2.f index 4906f1a20c..9e29991a6d 100644 --- a/lib/linalg/dlaev2.f +++ b/lib/linalg/dlaev2.f @@ -94,8 +94,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -120,10 +118,9 @@ * ===================================================================== SUBROUTINE DLAEV2( A, B, C, RT1, RT2, CS1, SN1 ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. DOUBLE PRECISION A, B, C, CS1, RT1, RT2, SN1 diff --git a/lib/linalg/dlaisnan.f b/lib/linalg/dlaisnan.f index c2e87d88a0..2caf5fb1d0 100644 --- a/lib/linalg/dlaisnan.f +++ b/lib/linalg/dlaisnan.f @@ -67,17 +67,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * * ===================================================================== LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. DOUBLE PRECISION, INTENT(IN) :: DIN1, DIN2 diff --git a/lib/linalg/dlals0.f b/lib/linalg/dlals0.f index d4cff166d6..cfca222806 100644 --- a/lib/linalg/dlals0.f +++ b/lib/linalg/dlals0.f @@ -252,8 +252,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * *> \par Contributors: @@ -268,10 +266,9 @@ $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, $ POLES, DIFL, DIFR, Z, K, C, S, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER GIVPTR, ICOMPQ, INFO, K, LDB, LDBX, LDGCOL, diff --git a/lib/linalg/dlalsa.f b/lib/linalg/dlalsa.f index 478ee24b0e..da8e0fa175 100644 --- a/lib/linalg/dlalsa.f +++ b/lib/linalg/dlalsa.f @@ -43,7 +43,7 @@ *> *> \verbatim *> -*> DLALSA is an intermediate step in solving the least squares problem +*> DLALSA is an itermediate step in solving the least squares problem *> by computing the SVD of the coefficient matrix in compact form (The *> singular vectors are computed as products of simple orthorgonal *> matrices.). @@ -250,8 +250,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleOTHERcomputational * *> \par Contributors: @@ -267,10 +265,9 @@ $ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK, $ IWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS, diff --git a/lib/linalg/dlalsd.f b/lib/linalg/dlalsd.f index 510e0455a6..d22c45dc6e 100644 --- a/lib/linalg/dlalsd.f +++ b/lib/linalg/dlalsd.f @@ -164,8 +164,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * *> \par Contributors: @@ -179,10 +177,9 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, $ RANK, WORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO diff --git a/lib/linalg/dlamrg.f b/lib/linalg/dlamrg.f index de19508e45..80bd354b97 100644 --- a/lib/linalg/dlamrg.f +++ b/lib/linalg/dlamrg.f @@ -92,17 +92,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 DTRD1, DTRD2, N1, N2 diff --git a/lib/linalg/dlange.f b/lib/linalg/dlange.f index 9dbf45e818..9d214cb542 100644 --- a/lib/linalg/dlange.f +++ b/lib/linalg/dlange.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 NORM diff --git a/lib/linalg/dlanst.f b/lib/linalg/dlanst.f index e952e2dd21..c5bc7ea038 100644 --- a/lib/linalg/dlanst.f +++ b/lib/linalg/dlanst.f @@ -93,17 +93,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 NORM diff --git a/lib/linalg/dlansy.f b/lib/linalg/dlansy.f index 2372fce0a8..949c5535a2 100644 --- a/lib/linalg/dlansy.f +++ b/lib/linalg/dlansy.f @@ -115,17 +115,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 NORM, UPLO diff --git a/lib/linalg/dlapy2.f b/lib/linalg/dlapy2.f index bc01829a24..1f63193bb7 100644 --- a/lib/linalg/dlapy2.f +++ b/lib/linalg/dlapy2.f @@ -31,7 +31,7 @@ *> \verbatim *> *> DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary -*> overflow. +*> overflow and unnecessary underflow. *> \endverbatim * * Arguments: @@ -56,17 +56,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION DLAPY2( X, Y ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. DOUBLE PRECISION X, Y @@ -81,13 +78,16 @@ PARAMETER ( ONE = 1.0D0 ) * .. * .. Local Scalars .. - DOUBLE PRECISION W, XABS, YABS, Z + DOUBLE PRECISION W, XABS, YABS, Z, HUGEVAL LOGICAL X_IS_NAN, Y_IS_NAN * .. * .. External Functions .. LOGICAL DISNAN EXTERNAL DISNAN * .. +* .. External Subroutines .. + DOUBLE PRECISION DLAMCH +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT * .. @@ -97,13 +97,14 @@ Y_IS_NAN = DISNAN( Y ) IF ( X_IS_NAN ) DLAPY2 = X IF ( Y_IS_NAN ) DLAPY2 = Y + HUGEVAL = DLAMCH( 'Overflow' ) * IF ( .NOT.( X_IS_NAN.OR.Y_IS_NAN ) ) THEN XABS = ABS( X ) YABS = ABS( Y ) W = MAX( XABS, YABS ) Z = MIN( XABS, YABS ) - IF( Z.EQ.ZERO ) THEN + IF( Z.EQ.ZERO .OR. W.GT.HUGEVAL ) THEN DLAPY2 = W ELSE DLAPY2 = W*SQRT( ONE+( Z / W )**2 ) diff --git a/lib/linalg/dlapy3.f b/lib/linalg/dlapy3.f index 3bbba88875..230a65cdb2 100644 --- a/lib/linalg/dlapy3.f +++ b/lib/linalg/dlapy3.f @@ -31,7 +31,7 @@ *> \verbatim *> *> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause -*> unnecessary overflow. +*> unnecessary overflow and unnecessary underflow. *> \endverbatim * * Arguments: @@ -61,17 +61,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. DOUBLE PRECISION X, Y, Z @@ -84,18 +81,22 @@ PARAMETER ( ZERO = 0.0D0 ) * .. * .. Local Scalars .. - DOUBLE PRECISION W, XABS, YABS, ZABS + DOUBLE PRECISION W, XABS, YABS, ZABS, HUGEVAL +* .. +* .. External Subroutines .. + DOUBLE PRECISION DLAMCH * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT * .. * .. Executable Statements .. * + HUGEVAL = DLAMCH( 'Overflow' ) XABS = ABS( X ) YABS = ABS( Y ) ZABS = ABS( Z ) W = MAX( XABS, YABS, ZABS ) - IF( W.EQ.ZERO ) THEN + IF( W.EQ.ZERO .OR. W.GT.HUGEVAL ) THEN * W can be zero for max(0,nan,0) * adding all three entries together will make sure * NaN will not disappear. diff --git a/lib/linalg/dlarf.f b/lib/linalg/dlarf.f index e99d0bb2a9..ed21638645 100644 --- a/lib/linalg/dlarf.f +++ b/lib/linalg/dlarf.f @@ -117,17 +117,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * * ===================================================================== SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 SIDE diff --git a/lib/linalg/dlarfb.f b/lib/linalg/dlarfb.f index 5b2cc2ba80..a3fa083b43 100644 --- a/lib/linalg/dlarfb.f +++ b/lib/linalg/dlarfb.f @@ -92,6 +92,8 @@ *> K is INTEGER *> The order of the matrix T (= the number of elementary *> reflectors whose product defines the block reflector). +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. *> \endverbatim *> *> \param[in] V @@ -159,8 +161,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2013 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -195,10 +195,9 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, $ T, LDT, C, LDC, WORK, LDWORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2013 * * .. Scalar Arguments .. CHARACTER DIRECT, SIDE, STOREV, TRANS diff --git a/lib/linalg/dlarfg.f b/lib/linalg/dlarfg.f index cb177a5703..9bfb45a6b0 100644 --- a/lib/linalg/dlarfg.f +++ b/lib/linalg/dlarfg.f @@ -99,17 +99,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * * ===================================================================== SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER INCX, N @@ -170,7 +167,7 @@ CALL DSCAL( N-1, RSAFMN, X, INCX ) BETA = BETA*RSAFMN ALPHA = ALPHA*RSAFMN - IF( ABS( BETA ).LT.SAFMIN ) + IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) ) $ GO TO 10 * * New BETA is at most 1, at least SAFMIN diff --git a/lib/linalg/dlarft.f b/lib/linalg/dlarft.f index e69a6b792e..a8d9de61f1 100644 --- a/lib/linalg/dlarft.f +++ b/lib/linalg/dlarft.f @@ -130,8 +130,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -163,10 +161,9 @@ * ===================================================================== SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 DIRECT, STOREV diff --git a/lib/linalg/dlas2.f b/lib/linalg/dlas2.f index 83873bc612..ea929e86f7 100644 --- a/lib/linalg/dlas2.f +++ b/lib/linalg/dlas2.f @@ -78,8 +78,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -107,10 +105,9 @@ * ===================================================================== SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. DOUBLE PRECISION F, G, H, SSMAX, SSMIN diff --git a/lib/linalg/dlascl.f b/lib/linalg/dlascl.f index 03e1000a87..05ad1c4f3c 100644 --- a/lib/linalg/dlascl.f +++ b/lib/linalg/dlascl.f @@ -136,17 +136,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. CHARACTER TYPE diff --git a/lib/linalg/dlasd4.f b/lib/linalg/dlasd4.f index 8b4a8762c8..acfd896b3b 100644 --- a/lib/linalg/dlasd4.f +++ b/lib/linalg/dlasd4.f @@ -140,8 +140,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -153,10 +151,9 @@ * ===================================================================== SUBROUTINE DLASD4( N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER I, INFO, N diff --git a/lib/linalg/dlasd5.f b/lib/linalg/dlasd5.f index 4896ba6b97..645c2fdc3e 100644 --- a/lib/linalg/dlasd5.f +++ b/lib/linalg/dlasd5.f @@ -103,8 +103,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -116,10 +114,9 @@ * ===================================================================== SUBROUTINE DLASD5( I, D, Z, DELTA, RHO, DSIGMA, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER I diff --git a/lib/linalg/dlasd6.f b/lib/linalg/dlasd6.f index 5cab78a070..51e67588dd 100644 --- a/lib/linalg/dlasd6.f +++ b/lib/linalg/dlasd6.f @@ -297,8 +297,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -313,10 +311,9 @@ $ LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, $ IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL, diff --git a/lib/linalg/dlasd7.f b/lib/linalg/dlasd7.f index 66f665cf88..ff9ba4c36a 100644 --- a/lib/linalg/dlasd7.f +++ b/lib/linalg/dlasd7.f @@ -264,8 +264,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -280,10 +278,9 @@ $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, $ C, S, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL, diff --git a/lib/linalg/dlasd8.f b/lib/linalg/dlasd8.f index fc5c48c528..a769bdb22e 100644 --- a/lib/linalg/dlasd8.f +++ b/lib/linalg/dlasd8.f @@ -152,8 +152,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -166,10 +164,9 @@ SUBROUTINE DLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR, $ DSIGMA, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER ICOMPQ, INFO, K, LDDIFR diff --git a/lib/linalg/dlasda.f b/lib/linalg/dlasda.f index f41a108b80..3e169a4edb 100644 --- a/lib/linalg/dlasda.f +++ b/lib/linalg/dlasda.f @@ -258,8 +258,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -273,10 +271,9 @@ $ DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL, $ PERM, GIVNUM, C, S, WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER ICOMPQ, INFO, LDGCOL, LDU, N, SMLSIZ, SQRE diff --git a/lib/linalg/dlasdq.f b/lib/linalg/dlasdq.f index e7d3575a98..0c39b24f0d 100644 --- a/lib/linalg/dlasdq.f +++ b/lib/linalg/dlasdq.f @@ -197,8 +197,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -211,10 +209,9 @@ SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, $ U, LDU, C, LDC, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. CHARACTER UPLO diff --git a/lib/linalg/dlasdt.f b/lib/linalg/dlasdt.f index 37da2d035e..0d9999ea62 100644 --- a/lib/linalg/dlasdt.f +++ b/lib/linalg/dlasdt.f @@ -92,8 +92,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -105,10 +103,9 @@ * ===================================================================== SUBROUTINE DLASDT( N, LVL, ND, INODE, NDIML, NDIMR, MSUB ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER LVL, MSUB, N, ND diff --git a/lib/linalg/dlaset.f b/lib/linalg/dlaset.f index 3a0c469a3c..625c757b6b 100644 --- a/lib/linalg/dlaset.f +++ b/lib/linalg/dlaset.f @@ -103,17 +103,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 UPLO diff --git a/lib/linalg/dlasq1.f b/lib/linalg/dlasq1.f index 468676eebd..27fa30736e 100644 --- a/lib/linalg/dlasq1.f +++ b/lib/linalg/dlasq1.f @@ -101,17 +101,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLASQ1( N, D, E, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, N diff --git a/lib/linalg/dlasq2.f b/lib/linalg/dlasq2.f index 68d9228704..608ca7a619 100644 --- a/lib/linalg/dlasq2.f +++ b/lib/linalg/dlasq2.f @@ -95,8 +95,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Further Details: @@ -112,10 +110,9 @@ * ===================================================================== SUBROUTINE DLASQ2( N, Z, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, N @@ -184,10 +181,18 @@ * * 2-by-2 case. * - IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN - INFO = -2 + IF( Z( 1 ).LT.ZERO ) THEN + INFO = -201 CALL XERBLA( 'DLASQ2', 2 ) RETURN + ELSE IF( Z( 2 ).LT.ZERO ) THEN + INFO = -202 + CALL XERBLA( 'DLASQ2', 2 ) + RETURN + ELSE IF( Z( 3 ).LT.ZERO ) THEN + INFO = -203 + CALL XERBLA( 'DLASQ2', 2 ) + RETURN ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN D = Z( 3 ) Z( 3 ) = Z( 1 ) @@ -267,8 +272,7 @@ * * Check whether the machine is IEEE conformable. * - IEEE = ILAENV( 10, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 .AND. - $ ILAENV( 11, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 + IEEE = ( ILAENV( 10, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 ) * * Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...). * diff --git a/lib/linalg/dlasq3.f b/lib/linalg/dlasq3.f index c095bdbbb5..e4bdafe06e 100644 --- a/lib/linalg/dlasq3.f +++ b/lib/linalg/dlasq3.f @@ -173,8 +173,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== @@ -182,10 +180,9 @@ $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, $ DN2, G, TAU ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. LOGICAL IEEE diff --git a/lib/linalg/dlasq4.f b/lib/linalg/dlasq4.f index d4ddbbc7b2..2652ddb2ba 100644 --- a/lib/linalg/dlasq4.f +++ b/lib/linalg/dlasq4.f @@ -135,8 +135,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * *> \par Further Details: @@ -151,10 +149,9 @@ SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, $ DN1, DN2, TAU, TTYPE, G ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- 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 I0, N0, N0IN, PP, TTYPE diff --git a/lib/linalg/dlasq5.f b/lib/linalg/dlasq5.f index 3812c879fa..5679ab60a5 100644 --- a/lib/linalg/dlasq5.f +++ b/lib/linalg/dlasq5.f @@ -136,18 +136,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, $ DN, DNM1, DNM2, IEEE, EPS ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. LOGICAL IEEE diff --git a/lib/linalg/dlasq6.f b/lib/linalg/dlasq6.f index d871386bdb..9218b5060e 100644 --- a/lib/linalg/dlasq6.f +++ b/lib/linalg/dlasq6.f @@ -111,18 +111,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, $ DNM1, DNM2 ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER I0, N0, PP diff --git a/lib/linalg/dlasr.f b/lib/linalg/dlasr.f index 6059c6293a..dd0cedd85e 100644 --- a/lib/linalg/dlasr.f +++ b/lib/linalg/dlasr.f @@ -175,7 +175,7 @@ *> \verbatim *> A is DOUBLE PRECISION array, dimension (LDA,N) *> The M-by-N matrix A. On exit, A is overwritten by P*A if -*> SIDE = 'R' or by A*P**T if SIDE = 'L'. +*> SIDE = 'L' or by A*P**T if SIDE = 'R'. *> \endverbatim *> *> \param[in] LDA @@ -192,17 +192,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 DIRECT, PIVOT, SIDE diff --git a/lib/linalg/dlasrt.f b/lib/linalg/dlasrt.f index 4705311d78..d789239e3d 100644 --- a/lib/linalg/dlasrt.f +++ b/lib/linalg/dlasrt.f @@ -81,17 +81,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLASRT( ID, N, D, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. CHARACTER ID diff --git a/lib/linalg/dlasv2.f b/lib/linalg/dlasv2.f index 9371d6d3b2..64a06dee1a 100644 --- a/lib/linalg/dlasv2.f +++ b/lib/linalg/dlasv2.f @@ -107,8 +107,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -138,10 +136,9 @@ * ===================================================================== SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. DOUBLE PRECISION CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN diff --git a/lib/linalg/dlaswp.f b/lib/linalg/dlaswp.f index 202fd8df1b..b35729a205 100644 --- a/lib/linalg/dlaswp.f +++ b/lib/linalg/dlaswp.f @@ -99,8 +99,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -115,10 +113,9 @@ * ===================================================================== SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER INCX, K1, K2, LDA, N diff --git a/lib/linalg/dlatrd.f b/lib/linalg/dlatrd.f index a1df43e48a..010a85a212 100644 --- a/lib/linalg/dlatrd.f +++ b/lib/linalg/dlatrd.f @@ -139,8 +139,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -198,10 +196,9 @@ * ===================================================================== SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 UPLO diff --git a/lib/linalg/dlatrs.f b/lib/linalg/dlatrs.f index 5ad5f66c55..43f92911d7 100644 --- a/lib/linalg/dlatrs.f +++ b/lib/linalg/dlatrs.f @@ -158,8 +158,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -238,10 +236,9 @@ SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, $ CNORM, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 DIAG, NORMIN, TRANS, UPLO diff --git a/lib/linalg/dorg2l.f b/lib/linalg/dorg2l.f index 36ff4e5d4b..0a42d4cf5a 100644 --- a/lib/linalg/dorg2l.f +++ b/lib/linalg/dorg2l.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/dorg2r.f b/lib/linalg/dorg2r.f index 4b71011a9f..c64ad4b0ac 100644 --- a/lib/linalg/dorg2r.f +++ b/lib/linalg/dorg2r.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/dorgbr.f b/lib/linalg/dorgbr.f index cfebda5abd..1b242ff97f 100644 --- a/lib/linalg/dorgbr.f +++ b/lib/linalg/dorgbr.f @@ -150,17 +150,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup doubleGBcomputational * * ===================================================================== SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * .. Scalar Arguments .. CHARACTER VECT @@ -221,8 +218,8 @@ CALL DORGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( M.GT.1 ) THEN - CALL DORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL DORGQR( M-1, M-1, M-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF ELSE @@ -230,8 +227,8 @@ CALL DORGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( N.GT.1 ) THEN - CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL DORGLQ( N-1, N-1, N-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF END IF diff --git a/lib/linalg/dorgl2.f b/lib/linalg/dorgl2.f index 5d8985d758..ce1d2c6750 100644 --- a/lib/linalg/dorgl2.f +++ b/lib/linalg/dorgl2.f @@ -106,17 +106,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/dorglq.f b/lib/linalg/dorglq.f index 912b5de84e..8c37c18b75 100644 --- a/lib/linalg/dorglq.f +++ b/lib/linalg/dorglq.f @@ -120,17 +120,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, LWORK, M, N diff --git a/lib/linalg/dorgql.f b/lib/linalg/dorgql.f index ea12be91b1..45e5bf19f1 100644 --- a/lib/linalg/dorgql.f +++ b/lib/linalg/dorgql.f @@ -121,17 +121,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, LWORK, M, N diff --git a/lib/linalg/dorgqr.f b/lib/linalg/dorgqr.f index 628eeacba7..a41ce7ed56 100644 --- a/lib/linalg/dorgqr.f +++ b/lib/linalg/dorgqr.f @@ -121,17 +121,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, LWORK, M, N diff --git a/lib/linalg/dorgtr.f b/lib/linalg/dorgtr.f index 72623eac06..0a0ab15a78 100644 --- a/lib/linalg/dorgtr.f +++ b/lib/linalg/dorgtr.f @@ -116,17 +116,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO diff --git a/lib/linalg/dorm2l.f b/lib/linalg/dorm2l.f index 1014cb2378..c99039c541 100644 --- a/lib/linalg/dorm2l.f +++ b/lib/linalg/dorm2l.f @@ -151,18 +151,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 SIDE, TRANS diff --git a/lib/linalg/dorm2r.f b/lib/linalg/dorm2r.f index 632b70e740..ac88eec8dc 100644 --- a/lib/linalg/dorm2r.f +++ b/lib/linalg/dorm2r.f @@ -151,18 +151,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 SIDE, TRANS diff --git a/lib/linalg/dormbr.f b/lib/linalg/dormbr.f index f035d0ae66..86abb10072 100644 --- a/lib/linalg/dormbr.f +++ b/lib/linalg/dormbr.f @@ -187,18 +187,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, $ LDC, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 SIDE, TRANS, VECT @@ -240,10 +237,10 @@ * IF( LEFT ) THEN NQ = M - NW = N + NW = MAX( 1, N ) ELSE NQ = N - NW = M + NW = MAX( 1, M ) END IF IF( .NOT.APPLYQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN INFO = -1 @@ -263,7 +260,7 @@ INFO = -8 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -11 - ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN INFO = -13 END IF * @@ -285,7 +282,7 @@ $ -1 ) END IF END IF - LWKOPT = MAX( 1, NW )*NB + LWKOPT = NW*NB WORK( 1 ) = LWKOPT END IF * diff --git a/lib/linalg/dorml2.f b/lib/linalg/dorml2.f index 2c55c7f1fd..a9ddd460d8 100644 --- a/lib/linalg/dorml2.f +++ b/lib/linalg/dorml2.f @@ -151,18 +151,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 SIDE, TRANS diff --git a/lib/linalg/dormlq.f b/lib/linalg/dormlq.f index bb5469d273..ef039285ab 100644 --- a/lib/linalg/dormlq.f +++ b/lib/linalg/dormlq.f @@ -159,18 +159,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 SIDE, TRANS @@ -217,10 +214,10 @@ * IF( LEFT ) THEN NQ = M - NW = N + NW = MAX( 1, N ) ELSE NQ = N - NW = M + NW = MAX( 1, M ) END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 @@ -236,7 +233,7 @@ INFO = -7 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -10 - ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN INFO = -12 END IF * @@ -246,7 +243,7 @@ * NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, K, $ -1 ) ) - LWKOPT = MAX( 1, NW )*NB + TSIZE + LWKOPT = NW*NB + TSIZE WORK( 1 ) = LWKOPT END IF * @@ -267,7 +264,7 @@ NBMIN = 2 LDWORK = NW IF( NB.GT.1 .AND. NB.LT.K ) THEN - IF( LWORK.LT.NW*NB+TSIZE ) THEN + IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK NBMIN = MAX( 2, ILAENV( 2, 'DORMLQ', SIDE // TRANS, M, N, K, $ -1 ) ) diff --git a/lib/linalg/dormql.f b/lib/linalg/dormql.f index 7d2b5d6c32..7c9f189e0d 100644 --- a/lib/linalg/dormql.f +++ b/lib/linalg/dormql.f @@ -159,18 +159,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 SIDE, TRANS @@ -269,7 +266,7 @@ NBMIN = 2 LDWORK = NW IF( NB.GT.1 .AND. NB.LT.K ) THEN - IF( LWORK.LT.NW*NB+TSIZE ) THEN + IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK NBMIN = MAX( 2, ILAENV( 2, 'DORMQL', SIDE // TRANS, M, N, K, $ -1 ) ) diff --git a/lib/linalg/dormqr.f b/lib/linalg/dormqr.f index 7f2ebb9ace..4d0bae3a5f 100644 --- a/lib/linalg/dormqr.f +++ b/lib/linalg/dormqr.f @@ -159,18 +159,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 SIDE, TRANS @@ -216,10 +213,10 @@ * IF( LEFT ) THEN NQ = M - NW = N + NW = MAX( 1, N ) ELSE NQ = N - NW = M + NW = MAX( 1, M ) END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 @@ -235,7 +232,7 @@ INFO = -7 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -10 - ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN INFO = -12 END IF * @@ -245,7 +242,7 @@ * NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K, $ -1 ) ) - LWKOPT = MAX( 1, NW )*NB + TSIZE + LWKOPT = NW*NB + TSIZE WORK( 1 ) = LWKOPT END IF * @@ -266,7 +263,7 @@ NBMIN = 2 LDWORK = NW IF( NB.GT.1 .AND. NB.LT.K ) THEN - IF( LWORK.LT.NW*NB+TSIZE ) THEN + IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS, M, N, K, $ -1 ) ) diff --git a/lib/linalg/dormtr.f b/lib/linalg/dormtr.f index d2443c1dac..1f664d63cc 100644 --- a/lib/linalg/dormtr.f +++ b/lib/linalg/dormtr.f @@ -163,18 +163,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, $ WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 SIDE, TRANS, UPLO @@ -214,10 +211,10 @@ * IF( LEFT ) THEN NQ = M - NW = N + NW = MAX( 1, N ) ELSE NQ = N - NW = M + NW = MAX( 1, M ) END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 @@ -234,7 +231,7 @@ INFO = -7 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -10 - ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN INFO = -12 END IF * @@ -256,7 +253,7 @@ $ -1 ) END IF END IF - LWKOPT = MAX( 1, NW )*NB + LWKOPT = NW*NB WORK( 1 ) = LWKOPT END IF * diff --git a/lib/linalg/dpotf2.f b/lib/linalg/dpotf2.f index 1fb60a903b..08fa4957fd 100644 --- a/lib/linalg/dpotf2.f +++ b/lib/linalg/dpotf2.f @@ -102,17 +102,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doublePOcomputational * * ===================================================================== SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO diff --git a/lib/linalg/dpotrf.f b/lib/linalg/dpotrf.f index 1fa75a4654..1679fc3cd8 100644 --- a/lib/linalg/dpotrf.f +++ b/lib/linalg/dpotrf.f @@ -100,17 +100,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doublePOcomputational * * ===================================================================== SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO diff --git a/lib/linalg/dpotrf2.f b/lib/linalg/dpotrf2.f index 0d419c4f00..6c28ce6d67 100644 --- a/lib/linalg/dpotrf2.f +++ b/lib/linalg/dpotrf2.f @@ -99,17 +99,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doublePOcomputational * * ===================================================================== RECURSIVE SUBROUTINE DPOTRF2( UPLO, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO diff --git a/lib/linalg/drot.f b/lib/linalg/drot.f index 0d33ea76c8..0386626c8f 100644 --- a/lib/linalg/drot.f +++ b/lib/linalg/drot.f @@ -76,8 +76,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -92,10 +90,9 @@ * ===================================================================== SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION C,S @@ -139,4 +136,7 @@ END DO END IF RETURN +* +* End of DROT +* END diff --git a/lib/linalg/drscl.f b/lib/linalg/drscl.f index 9251143680..fcd8569650 100644 --- a/lib/linalg/drscl.f +++ b/lib/linalg/drscl.f @@ -77,17 +77,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * * ===================================================================== SUBROUTINE DRSCL( N, SA, SX, INCX ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER INCX, N @@ -112,7 +109,7 @@ EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DSCAL + EXTERNAL DSCAL, DLABAD * .. * .. Intrinsic Functions .. INTRINSIC ABS diff --git a/lib/linalg/dscal.f b/lib/linalg/dscal.f index e0a92de6ba..3713427334 100644 --- a/lib/linalg/dscal.f +++ b/lib/linalg/dscal.f @@ -62,8 +62,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -79,10 +77,9 @@ * ===================================================================== SUBROUTINE DSCAL(N,DA,DX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION DA @@ -133,4 +130,7 @@ END DO END IF RETURN +* +* End of DSCAL +* END diff --git a/lib/linalg/dstedc.f b/lib/linalg/dstedc.f index 61b44bc06b..2ed84afaac 100644 --- a/lib/linalg/dstedc.f +++ b/lib/linalg/dstedc.f @@ -173,8 +173,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -188,10 +186,9 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. CHARACTER COMPZ diff --git a/lib/linalg/dsteqr.f b/lib/linalg/dsteqr.f index c34a548984..50a9188c7c 100644 --- a/lib/linalg/dsteqr.f +++ b/lib/linalg/dsteqr.f @@ -124,17 +124,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 COMPZ diff --git a/lib/linalg/dsterf.f b/lib/linalg/dsterf.f index 3401894819..b0f8d36084 100644 --- a/lib/linalg/dsterf.f +++ b/lib/linalg/dsterf.f @@ -79,17 +79,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DSTERF( N, D, E, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, N diff --git a/lib/linalg/dswap.f b/lib/linalg/dswap.f index 94dfea3bb9..b7600aa2d4 100644 --- a/lib/linalg/dswap.f +++ b/lib/linalg/dswap.f @@ -66,8 +66,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -82,10 +80,9 @@ * ===================================================================== SUBROUTINE DSWAP(N,DX,INCX,DY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -150,4 +147,7 @@ END DO END IF RETURN +* +* End of DSWAP +* END diff --git a/lib/linalg/dsyev.f b/lib/linalg/dsyev.f index ee8c479abe..da7557ee02 100644 --- a/lib/linalg/dsyev.f +++ b/lib/linalg/dsyev.f @@ -125,17 +125,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYeigen * * ===================================================================== SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- 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 JOBZ, UPLO diff --git a/lib/linalg/dsyevd.f b/lib/linalg/dsyevd.f index 2db67846dc..edbe896fe8 100644 --- a/lib/linalg/dsyevd.f +++ b/lib/linalg/dsyevd.f @@ -167,8 +167,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYeigen * *> \par Contributors: @@ -185,10 +183,9 @@ SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- 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 JOBZ, UPLO diff --git a/lib/linalg/dsygs2.f b/lib/linalg/dsygs2.f index a54955c01e..8a39bea77e 100644 --- a/lib/linalg/dsygs2.f +++ b/lib/linalg/dsygs2.f @@ -120,17 +120,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYcomputational * * ===================================================================== SUBROUTINE DSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO diff --git a/lib/linalg/dsygst.f b/lib/linalg/dsygst.f index 5055acdf1d..05b90372ab 100644 --- a/lib/linalg/dsygst.f +++ b/lib/linalg/dsygst.f @@ -120,17 +120,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYcomputational * * ===================================================================== SUBROUTINE DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO diff --git a/lib/linalg/dsygv.f b/lib/linalg/dsygv.f index 651abc5c7b..5208dbb1f1 100644 --- a/lib/linalg/dsygv.f +++ b/lib/linalg/dsygv.f @@ -167,18 +167,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYeigen * * ===================================================================== SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, $ LWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- 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 JOBZ, UPLO diff --git a/lib/linalg/dsygvd.f b/lib/linalg/dsygvd.f index 29c78283a7..61134bedce 100644 --- a/lib/linalg/dsygvd.f +++ b/lib/linalg/dsygvd.f @@ -203,8 +203,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYeigen * *> \par Further Details: @@ -227,10 +225,9 @@ SUBROUTINE DSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, $ LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- 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 JOBZ, UPLO diff --git a/lib/linalg/dsymm.f b/lib/linalg/dsymm.f index 622d2469f1..683e79f6ad 100644 --- a/lib/linalg/dsymm.f +++ b/lib/linalg/dsymm.f @@ -168,8 +168,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -189,10 +187,9 @@ * ===================================================================== SUBROUTINE DSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -362,6 +359,6 @@ * RETURN * -* End of DSYMM . +* End of DSYMM * END diff --git a/lib/linalg/dsymv.f b/lib/linalg/dsymv.f index 4bf973f10a..17310d7c62 100644 --- a/lib/linalg/dsymv.f +++ b/lib/linalg/dsymv.f @@ -130,8 +130,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level2 * *> \par Further Details: @@ -152,10 +150,9 @@ * ===================================================================== SUBROUTINE DSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -328,6 +325,6 @@ * RETURN * -* End of DSYMV . +* End of DSYMV * END diff --git a/lib/linalg/dsyr2.f b/lib/linalg/dsyr2.f index 8970c4dcfd..4bad19b96b 100644 --- a/lib/linalg/dsyr2.f +++ b/lib/linalg/dsyr2.f @@ -126,8 +126,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level2 * *> \par Further Details: @@ -147,10 +145,9 @@ * ===================================================================== SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -293,6 +290,6 @@ * RETURN * -* End of DSYR2 . +* End of DSYR2 * END diff --git a/lib/linalg/dsyr2k.f b/lib/linalg/dsyr2k.f index f3a5940c7f..f5d16e0854 100644 --- a/lib/linalg/dsyr2k.f +++ b/lib/linalg/dsyr2k.f @@ -170,8 +170,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -192,10 +190,9 @@ * ===================================================================== SUBROUTINE DSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -394,6 +391,6 @@ * RETURN * -* End of DSYR2K. +* End of DSYR2K * END diff --git a/lib/linalg/dsyrk.f b/lib/linalg/dsyrk.f index 4be4d8d3c4..0548c0ce2f 100644 --- a/lib/linalg/dsyrk.f +++ b/lib/linalg/dsyrk.f @@ -148,8 +148,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -169,10 +167,9 @@ * ===================================================================== SUBROUTINE DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -359,6 +356,6 @@ * RETURN * -* End of DSYRK . +* End of DSYRK * END diff --git a/lib/linalg/dsytd2.f b/lib/linalg/dsytd2.f index 6fb4d5507e..977b6daa41 100644 --- a/lib/linalg/dsytd2.f +++ b/lib/linalg/dsytd2.f @@ -120,8 +120,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYcomputational * *> \par Further Details: @@ -173,10 +171,9 @@ * ===================================================================== SUBROUTINE DSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO diff --git a/lib/linalg/dsytrd.f b/lib/linalg/dsytrd.f index d330b241fa..3dcfc3db2b 100644 --- a/lib/linalg/dsytrd.f +++ b/lib/linalg/dsytrd.f @@ -139,8 +139,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYcomputational * *> \par Further Details: @@ -192,10 +190,9 @@ * ===================================================================== SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO diff --git a/lib/linalg/dtrmm.f b/lib/linalg/dtrmm.f index 0241c4d146..b2cc0a1fa8 100644 --- a/lib/linalg/dtrmm.f +++ b/lib/linalg/dtrmm.f @@ -156,8 +156,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -177,10 +175,9 @@ * ===================================================================== SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -410,6 +407,6 @@ * RETURN * -* End of DTRMM . +* End of DTRMM * END diff --git a/lib/linalg/dtrmv.f b/lib/linalg/dtrmv.f index 11c12ac724..e8af8e6136 100644 --- a/lib/linalg/dtrmv.f +++ b/lib/linalg/dtrmv.f @@ -125,8 +125,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level2 * *> \par Further Details: @@ -147,10 +145,9 @@ * ===================================================================== SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -337,6 +334,6 @@ * RETURN * -* End of DTRMV . +* End of DTRMV * END diff --git a/lib/linalg/dtrsm.f b/lib/linalg/dtrsm.f index 5a92bcafd0..fa8080bc92 100644 --- a/lib/linalg/dtrsm.f +++ b/lib/linalg/dtrsm.f @@ -159,8 +159,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -181,10 +179,9 @@ * ===================================================================== SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -438,6 +435,6 @@ * RETURN * -* End of DTRSM . +* End of DTRSM * END diff --git a/lib/linalg/dtrsv.f b/lib/linalg/dtrsv.f index 331f1d4311..d8ea9fa898 100644 --- a/lib/linalg/dtrsv.f +++ b/lib/linalg/dtrsv.f @@ -136,17 +136,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * * ===================================================================== SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -333,6 +330,6 @@ * RETURN * -* End of DTRSV . +* End of DTRSV * END diff --git a/lib/linalg/dtrti2.f b/lib/linalg/dtrti2.f index 0a9d5b696c..0d9115554c 100644 --- a/lib/linalg/dtrti2.f +++ b/lib/linalg/dtrti2.f @@ -103,17 +103,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 DIAG, UPLO diff --git a/lib/linalg/dtrtri.f b/lib/linalg/dtrtri.f index d34b40bcc0..1cf9a9aafb 100644 --- a/lib/linalg/dtrtri.f +++ b/lib/linalg/dtrtri.f @@ -102,17 +102,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 DIAG, UPLO diff --git a/lib/linalg/idamax.f b/lib/linalg/idamax.f index 17041680a4..1be301ea3e 100644 --- a/lib/linalg/idamax.f +++ b/lib/linalg/idamax.f @@ -43,7 +43,7 @@ *> \param[in] INCX *> \verbatim *> INCX is INTEGER -*> storage spacing between elements of SX +*> storage spacing between elements of DX *> \endverbatim * * Authors: @@ -54,8 +54,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup aux_blas * *> \par Further Details: @@ -71,10 +69,9 @@ * ===================================================================== INTEGER FUNCTION IDAMAX(N,DX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -123,4 +120,7 @@ END DO END IF RETURN +* +* End of IDAMAX +* END diff --git a/lib/linalg/ieeeck.f b/lib/linalg/ieeeck.f index 2655958b4a..74065c3b4e 100644 --- a/lib/linalg/ieeeck.f +++ b/lib/linalg/ieeeck.f @@ -75,17 +75,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER ISPEC diff --git a/lib/linalg/iladlc.f b/lib/linalg/iladlc.f index c6476113d1..a98e7218bf 100644 --- a/lib/linalg/iladlc.f +++ b/lib/linalg/iladlc.f @@ -71,17 +71,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== INTEGER FUNCTION ILADLC( M, N, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER M, N, LDA diff --git a/lib/linalg/iladlr.f b/lib/linalg/iladlr.f index e8951d86cc..b1abded84b 100644 --- a/lib/linalg/iladlr.f +++ b/lib/linalg/iladlr.f @@ -71,17 +71,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== INTEGER FUNCTION ILADLR( M, N, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER M, N, LDA diff --git a/lib/linalg/ilaenv.f b/lib/linalg/ilaenv.f index 2be0581517..af28503986 100644 --- a/lib/linalg/ilaenv.f +++ b/lib/linalg/ilaenv.f @@ -79,9 +79,9 @@ *> = 9: maximum size of the subproblems at the bottom of the *> computation tree in the divide-and-conquer algorithm *> (used by xGELSD and xGESDD) -*> =10: ieee NaN arithmetic can be trusted not to trap +*> =10: ieee infinity and NaN arithmetic can be trusted not to trap *> =11: infinity arithmetic can be trusted not to trap -*> 12 <= ISPEC <= 16: +*> 12 <= ISPEC <= 17: *> xHSEQR or related subroutines, *> see IPARMQ for detailed explanation *> \endverbatim @@ -132,8 +132,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -162,10 +160,9 @@ * ===================================================================== INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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*( * ) NAME, OPTS @@ -176,8 +173,8 @@ * * .. Local Scalars .. INTEGER I, IC, IZ, NB, NBMIN, NX - LOGICAL CNAME, SNAME - CHARACTER C1*1, C2*2, C4*2, C3*3, SUBNAM*6 + LOGICAL CNAME, SNAME, TWOSTAGE + CHARACTER C1*1, C2*2, C4*2, C3*3, SUBNAM*16 * .. * .. Intrinsic Functions .. INTRINSIC CHAR, ICHAR, INT, MIN, REAL @@ -189,8 +186,7 @@ * .. Executable Statements .. * GO TO ( 10, 10, 10, 80, 90, 100, 110, 120, - $ 130, 140, 150, 160, 160, 160, 160, 160, - $ 170, 170, 170, 170, 170 )ISPEC + $ 130, 140, 150, 160, 160, 160, 160, 160, 160)ISPEC * * Invalid value for ISPEC * @@ -257,6 +253,8 @@ C2 = SUBNAM( 2: 3 ) C3 = SUBNAM( 4: 6 ) C4 = C3( 2: 3 ) + TWOSTAGE = LEN( SUBNAM ).GE.11 + $ .AND. SUBNAM( 11: 11 ).EQ.'2' * GO TO ( 50, 60, 70 )ISPEC * @@ -270,7 +268,16 @@ * NB = 1 * - IF( C2.EQ.'GE' ) THEN + IF( SUBNAM(2:6).EQ.'LAORH' ) THEN +* +* This is for *LAORHR_GETRFNP routine +* + IF( SNAME ) THEN + NB = 32 + ELSE + NB = 32 + END IF + ELSE IF( C2.EQ.'GE' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN NB = 64 @@ -360,9 +367,17 @@ ELSE IF( C2.EQ.'SY' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN - NB = 64 + IF( TWOSTAGE ) THEN + NB = 192 + ELSE + NB = 64 + END IF ELSE - NB = 64 + IF( TWOSTAGE ) THEN + NB = 192 + ELSE + NB = 64 + END IF END IF ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN NB = 32 @@ -371,7 +386,11 @@ END IF ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN IF( C3.EQ.'TRF' ) THEN - NB = 64 + IF( TWOSTAGE ) THEN + NB = 192 + ELSE + NB = 64 + END IF ELSE IF( C3.EQ.'TRD' ) THEN NB = 32 ELSE IF( C3.EQ.'GST' ) THEN @@ -664,7 +683,7 @@ * 140 CONTINUE * -* ISPEC = 10: ieee NaN arithmetic can be trusted not to trap +* ISPEC = 10: ieee and infinity NaN arithmetic can be trusted not to trap * * ILAENV = 0 ILAENV = 1 @@ -675,7 +694,7 @@ * 150 CONTINUE * -* ISPEC = 11: infinity arithmetic can be trusted not to trap +* ISPEC = 11: ieee infinity arithmetic can be trusted not to trap * * ILAENV = 0 ILAENV = 1 @@ -686,17 +705,10 @@ * 160 CONTINUE * -* 12 <= ISPEC <= 16: xHSEQR or related subroutines. +* 12 <= ISPEC <= 17: xHSEQR or related subroutines. * ILAENV = IPARMQ( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) RETURN -* - 170 CONTINUE -* -* 17 <= ISPEC <= 21: 2stage eigenvalues and SVD or related subroutines. -* - ILAENV = IPARAM2STAGE( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) - RETURN * * End of ILAENV * diff --git a/lib/linalg/ilazlc.f b/lib/linalg/ilazlc.f index 07dfc93e31..8af3430e61 100644 --- a/lib/linalg/ilazlc.f +++ b/lib/linalg/ilazlc.f @@ -71,17 +71,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== INTEGER FUNCTION ILAZLC( M, N, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER M, N, LDA diff --git a/lib/linalg/ilazlr.f b/lib/linalg/ilazlr.f index 4ca4ed1a44..e0134a6a35 100644 --- a/lib/linalg/ilazlr.f +++ b/lib/linalg/ilazlr.f @@ -71,17 +71,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== INTEGER FUNCTION ILAZLR( M, N, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER M, N, LDA diff --git a/lib/linalg/iparmq.f b/lib/linalg/iparmq.f index e576e0db01..54c05471ca 100644 --- a/lib/linalg/iparmq.f +++ b/lib/linalg/iparmq.f @@ -60,7 +60,7 @@ *> invest in an (expensive) multi-shift QR sweep. *> If the aggressive early deflation subroutine *> finds LD converged eigenvalues from an order -*> NW deflation window and LD.GT.(NW*NIBBLE)/100, +*> NW deflation window and LD > (NW*NIBBLE)/100, *> then the next QR sweep is skipped and early *> deflation is applied immediately to the *> remaining active diagonal block. Setting @@ -100,17 +100,21 @@ *> IPARMQ(ISPEC=16)=1 may be more efficient than *> IPARMQ(ISPEC=16)=2 despite the greater level of *> arithmetic work implied by the latter choice.) +*> +*> ISPEC=17: (ICOST) An estimate of the relative cost of flops +*> within the near-the-diagonal shift chase compared +*> to flops within the BLAS calls of a QZ sweep. *> \endverbatim *> *> \param[in] NAME *> \verbatim -*> NAME is character string +*> NAME is CHARACTER string *> Name of the calling subroutine *> \endverbatim *> *> \param[in] OPTS *> \verbatim -*> OPTS is character string +*> OPTS is CHARACTER string *> This is a concatenation of the string arguments to *> TTQRE. *> \endverbatim @@ -147,8 +151,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -184,8 +186,8 @@ *> This depends on ILO, IHI and NS, the *> number of simultaneous shifts returned *> by IPARMQ(ISPEC=15). The default for -*> (IHI-ILO+1).LE.500 is NS. The default -*> for (IHI-ILO+1).GT.500 is 3*NS/2. +*> (IHI-ILO+1) <= 500 is NS. The default +*> for (IHI-ILO+1) > 500 is 3*NS/2. *> *> IPARMQ(ISPEC=14) Nibble crossover point. Default: 14. *> @@ -217,15 +219,18 @@ *> IPARMQ(ISPEC=16) Select structured matrix multiply. *> (See ISPEC=16 above for details.) *> Default: 3. +*> +*> IPARMQ(ISPEC=17) Relative cost heuristic for blocksize selection. +*> Expressed as a percentage. +*> Default: 10. *> \endverbatim *> * ===================================================================== INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER IHI, ILO, ISPEC, LWORK, N @@ -233,12 +238,12 @@ * * ================================================================ * .. Parameters .. - INTEGER INMIN, INWIN, INIBL, ISHFTS, IACC22 + INTEGER INMIN, INWIN, INIBL, ISHFTS, IACC22, ICOST PARAMETER ( INMIN = 12, INWIN = 13, INIBL = 14, - $ ISHFTS = 15, IACC22 = 16 ) - INTEGER NMIN, K22MIN, KACMIN, NIBBLE, KNWSWP + $ ISHFTS = 15, IACC22 = 16, ICOST = 17 ) + INTEGER NMIN, K22MIN, KACMIN, NIBBLE, KNWSWP, RCOST PARAMETER ( NMIN = 75, K22MIN = 14, KACMIN = 14, - $ NIBBLE = 14, KNWSWP = 500 ) + $ NIBBLE = 14, KNWSWP = 500, RCOST = 10 ) REAL TWO PARAMETER ( TWO = 2.0 ) * .. @@ -384,6 +389,12 @@ $ IPARMQ = 2 END IF * + ELSE IF( ISPEC.EQ.ICOST ) THEN +* +* === Relative cost of near-the-diagonal chase vs +* BLAS updates === +* + IPARMQ = RCOST ELSE * ===== invalid value of ispec ===== IPARMQ = -1 diff --git a/lib/linalg/lsame.f b/lib/linalg/lsame.f index d819478696..6aa4007065 100644 --- a/lib/linalg/lsame.f +++ b/lib/linalg/lsame.f @@ -46,17 +46,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup aux_blas * * ===================================================================== LOGICAL FUNCTION LSAME(CA,CB) * -* -- Reference BLAS level1 routine (version 3.1) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS 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 CA,CB diff --git a/lib/linalg/xerbla.f b/lib/linalg/xerbla.f index 4a0350988c..6b141499ee 100644 --- a/lib/linalg/xerbla.f +++ b/lib/linalg/xerbla.f @@ -63,17 +63,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE XERBLA( SRNAME, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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*(*) SRNAME diff --git a/lib/linalg/zaxpy.f b/lib/linalg/zaxpy.f index b7b9ee69e4..35c0e4b892 100644 --- a/lib/linalg/zaxpy.f +++ b/lib/linalg/zaxpy.f @@ -72,8 +72,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -88,10 +86,9 @@ * ===================================================================== SUBROUTINE ZAXPY(N,ZA,ZX,INCX,ZY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ZA @@ -136,4 +133,7 @@ END IF * RETURN +* +* End of ZAXPY +* END diff --git a/lib/linalg/zcopy.f b/lib/linalg/zcopy.f index 3777079730..1efcdb6b0f 100644 --- a/lib/linalg/zcopy.f +++ b/lib/linalg/zcopy.f @@ -65,8 +65,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -81,10 +79,9 @@ * ===================================================================== SUBROUTINE ZCOPY(N,ZX,INCX,ZY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -122,4 +119,7 @@ END DO END IF RETURN +* +* End of ZCOPY +* END diff --git a/lib/linalg/zdotc.f b/lib/linalg/zdotc.f index e6cd11b21d..bcc29e2dad 100644 --- a/lib/linalg/zdotc.f +++ b/lib/linalg/zdotc.f @@ -39,7 +39,7 @@ *> *> \param[in] ZX *> \verbatim -*> ZX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) *> \endverbatim *> *> \param[in] INCX @@ -50,7 +50,7 @@ *> *> \param[in] ZY *> \verbatim -*> ZY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) *> \endverbatim *> *> \param[in] INCY @@ -67,8 +67,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -83,10 +81,9 @@ * ===================================================================== COMPLEX*16 FUNCTION ZDOTC(N,ZX,INCX,ZY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -131,4 +128,7 @@ END IF ZDOTC = ZTEMP RETURN +* +* End of ZDOTC +* END diff --git a/lib/linalg/zdscal.f b/lib/linalg/zdscal.f index 71d4da55be..b3546ba206 100644 --- a/lib/linalg/zdscal.f +++ b/lib/linalg/zdscal.f @@ -61,8 +61,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -78,10 +76,9 @@ * ===================================================================== SUBROUTINE ZDSCAL(N,DA,ZX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION DA @@ -117,4 +114,7 @@ END DO END IF RETURN +* +* End of ZDSCAL +* END diff --git a/lib/linalg/zgemm.f b/lib/linalg/zgemm.f index c3ac7551d1..0b712f1b73 100644 --- a/lib/linalg/zgemm.f +++ b/lib/linalg/zgemm.f @@ -166,8 +166,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level3 * *> \par Further Details: @@ -187,10 +185,9 @@ * ===================================================================== SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -215,7 +212,7 @@ * .. * .. Local Scalars .. COMPLEX*16 TEMP - INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB + INTEGER I,INFO,J,L,NROWA,NROWB LOGICAL CONJA,CONJB,NOTA,NOTB * .. * .. Parameters .. @@ -228,8 +225,7 @@ * Set NOTA and NOTB as true if A and B respectively are not * conjugated or transposed, set CONJA and CONJB as true if A and * B respectively are to be transposed but not conjugated and set -* NROWA, NCOLA and NROWB as the number of rows and columns of A -* and the number of rows of B respectively. +* NROWA and NROWB as the number of rows of A and B respectively. * NOTA = LSAME(TRANSA,'N') NOTB = LSAME(TRANSB,'N') @@ -237,10 +233,8 @@ CONJB = LSAME(TRANSB,'C') IF (NOTA) THEN NROWA = M - NCOLA = K ELSE NROWA = K - NCOLA = M END IF IF (NOTB) THEN NROWB = K @@ -478,6 +472,6 @@ * RETURN * -* End of ZGEMM . +* End of ZGEMM * END diff --git a/lib/linalg/zgemv.f b/lib/linalg/zgemv.f index 7088d383f4..2664454b94 100644 --- a/lib/linalg/zgemv.f +++ b/lib/linalg/zgemv.f @@ -136,8 +136,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -158,10 +156,9 @@ * ===================================================================== SUBROUTINE ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -345,6 +342,6 @@ * RETURN * -* End of ZGEMV . +* End of ZGEMV * END diff --git a/lib/linalg/zgerc.f b/lib/linalg/zgerc.f index 058dccfc1c..2eb4349367 100644 --- a/lib/linalg/zgerc.f +++ b/lib/linalg/zgerc.f @@ -109,8 +109,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -130,10 +128,9 @@ * ===================================================================== SUBROUTINE ZGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -222,6 +219,6 @@ * RETURN * -* End of ZGERC . +* End of ZGERC * END diff --git a/lib/linalg/zheev.f b/lib/linalg/zheev.f index 3e87778740..59af34a742 100644 --- a/lib/linalg/zheev.f +++ b/lib/linalg/zheev.f @@ -132,18 +132,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16HEeigen * * ===================================================================== SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, $ INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- 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 JOBZ, UPLO @@ -224,7 +221,7 @@ END IF * IF( N.EQ.1 ) THEN - W( 1 ) = A( 1, 1 ) + W( 1 ) = DBLE( A( 1, 1 ) ) WORK( 1 ) = 1 IF( WANTZ ) $ A( 1, 1 ) = CONE diff --git a/lib/linalg/zheevd.f b/lib/linalg/zheevd.f index 7f58c7f726..a6484eb032 100644 --- a/lib/linalg/zheevd.f +++ b/lib/linalg/zheevd.f @@ -284,7 +284,7 @@ LIWMIN = 1 END IF LOPT = MAX( LWMIN, N + - $ N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) ) + $ ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) ) LROPT = LRWMIN LIOPT = LIWMIN END IF diff --git a/lib/linalg/zhemv.f b/lib/linalg/zhemv.f index 3ea0753f40..dad68bf25b 100644 --- a/lib/linalg/zhemv.f +++ b/lib/linalg/zhemv.f @@ -132,8 +132,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -154,10 +152,9 @@ * ===================================================================== SUBROUTINE ZHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -332,6 +329,6 @@ * RETURN * -* End of ZHEMV . +* End of ZHEMV * END diff --git a/lib/linalg/zher2.f b/lib/linalg/zher2.f index e3a383189d..d1f2b57ec4 100644 --- a/lib/linalg/zher2.f +++ b/lib/linalg/zher2.f @@ -129,8 +129,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -150,10 +148,9 @@ * ===================================================================== SUBROUTINE ZHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -312,6 +309,6 @@ * RETURN * -* End of ZHER2 . +* End of ZHER2 * END diff --git a/lib/linalg/zher2k.f b/lib/linalg/zher2k.f index 474c65e575..5c75083cd5 100644 --- a/lib/linalg/zher2k.f +++ b/lib/linalg/zher2k.f @@ -174,8 +174,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level3 * *> \par Further Details: @@ -198,10 +196,9 @@ * ===================================================================== SUBROUTINE ZHER2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -438,6 +435,6 @@ * RETURN * -* End of ZHER2K. +* End of ZHER2K * END diff --git a/lib/linalg/zhetd2.f b/lib/linalg/zhetd2.f index 6c5b8aae3d..a6d900b7c7 100644 --- a/lib/linalg/zhetd2.f +++ b/lib/linalg/zhetd2.f @@ -122,8 +122,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16HEcomputational * *> \par Further Details: @@ -175,10 +173,9 @@ * ===================================================================== SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO @@ -248,7 +245,7 @@ * ALPHA = A( I, I+1 ) CALL ZLARFG( I, ALPHA, A( 1, I+1 ), 1, TAUI ) - E( I ) = ALPHA + E( I ) = DBLE( ALPHA ) * IF( TAUI.NE.ZERO ) THEN * @@ -276,10 +273,10 @@ A( I, I ) = DBLE( A( I, I ) ) END IF A( I, I+1 ) = E( I ) - D( I+1 ) = A( I+1, I+1 ) + D( I+1 ) = DBLE( A( I+1, I+1 ) ) TAU( I ) = TAUI 10 CONTINUE - D( 1 ) = A( 1, 1 ) + D( 1 ) = DBLE( A( 1, 1 ) ) ELSE * * Reduce the lower triangle of A @@ -292,7 +289,7 @@ * ALPHA = A( I+1, I ) CALL ZLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAUI ) - E( I ) = ALPHA + E( I ) = DBLE( ALPHA ) * IF( TAUI.NE.ZERO ) THEN * @@ -321,10 +318,10 @@ A( I+1, I+1 ) = DBLE( A( I+1, I+1 ) ) END IF A( I+1, I ) = E( I ) - D( I ) = A( I, I ) + D( I ) = DBLE( A( I, I ) ) TAU( I ) = TAUI 20 CONTINUE - D( N ) = A( N, N ) + D( N ) = DBLE( A( N, N ) ) END IF * RETURN diff --git a/lib/linalg/zhetrd.f b/lib/linalg/zhetrd.f index 51c9fc2ec9..5b7d6546cc 100644 --- a/lib/linalg/zhetrd.f +++ b/lib/linalg/zhetrd.f @@ -139,8 +139,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16HEcomputational * *> \par Further Details: @@ -192,10 +190,9 @@ * ===================================================================== SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO @@ -328,7 +325,7 @@ * DO 10 J = I, I + NB - 1 A( J-1, J ) = E( J-1 ) - D( J ) = A( J, J ) + D( J ) = DBLE( A( J, J ) ) 10 CONTINUE 20 CONTINUE * @@ -360,7 +357,7 @@ * DO 30 J = I, I + NB - 1 A( J+1, J ) = E( J ) - D( J ) = A( J, J ) + D( J ) = DBLE( A( J, J ) ) 30 CONTINUE 40 CONTINUE * diff --git a/lib/linalg/zhpr.f b/lib/linalg/zhpr.f index af82dfbd8c..2ba5774a21 100644 --- a/lib/linalg/zhpr.f +++ b/lib/linalg/zhpr.f @@ -109,8 +109,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -130,10 +128,9 @@ * ===================================================================== SUBROUTINE ZHPR(UPLO,N,ALPHA,X,INCX,AP) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -274,6 +271,6 @@ * RETURN * -* End of ZHPR . +* End of ZHPR * END diff --git a/lib/linalg/zlacgv.f b/lib/linalg/zlacgv.f index 1e3ca6e73f..dc935e08f4 100644 --- a/lib/linalg/zlacgv.f +++ b/lib/linalg/zlacgv.f @@ -67,17 +67,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLACGV( N, X, INCX ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER INCX, N diff --git a/lib/linalg/zladiv.f b/lib/linalg/zladiv.f index 0bf6ea87d5..ae111d73d6 100644 --- a/lib/linalg/zladiv.f +++ b/lib/linalg/zladiv.f @@ -57,17 +57,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== COMPLEX*16 FUNCTION ZLADIV( X, Y ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. COMPLEX*16 X, Y diff --git a/lib/linalg/zlanhe.f b/lib/linalg/zlanhe.f index 7c7f7f3be4..bbb4843ffd 100644 --- a/lib/linalg/zlanhe.f +++ b/lib/linalg/zlanhe.f @@ -117,17 +117,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16HEauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 NORM, UPLO diff --git a/lib/linalg/zlarf.f b/lib/linalg/zlarf.f index f1be80d37b..e555d18ecd 100644 --- a/lib/linalg/zlarf.f +++ b/lib/linalg/zlarf.f @@ -121,17 +121,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 SIDE diff --git a/lib/linalg/zlarfb.f b/lib/linalg/zlarfb.f index b4a2b4d1a0..c5f424db31 100644 --- a/lib/linalg/zlarfb.f +++ b/lib/linalg/zlarfb.f @@ -92,6 +92,8 @@ *> K is INTEGER *> The order of the matrix T (= the number of elementary *> reflectors whose product defines the block reflector). +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. *> \endverbatim *> *> \param[in] V @@ -159,8 +161,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2013 -* *> \ingroup complex16OTHERauxiliary * *> \par Further Details: @@ -195,10 +195,9 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, $ T, LDT, C, LDC, WORK, LDWORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2013 * * .. Scalar Arguments .. CHARACTER DIRECT, SIDE, STOREV, TRANS diff --git a/lib/linalg/zlarfg.f b/lib/linalg/zlarfg.f index f8a795d547..d69796cadc 100644 --- a/lib/linalg/zlarfg.f +++ b/lib/linalg/zlarfg.f @@ -99,17 +99,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. INTEGER INCX, N @@ -175,7 +172,7 @@ BETA = BETA*RSAFMN ALPHI = ALPHI*RSAFMN ALPHR = ALPHR*RSAFMN - IF( ABS( BETA ).LT.SAFMIN ) + IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) ) $ GO TO 10 * * New BETA is at most 1, at least SAFMIN diff --git a/lib/linalg/zlarft.f b/lib/linalg/zlarft.f index 78ad2f1481..5ad0996fab 100644 --- a/lib/linalg/zlarft.f +++ b/lib/linalg/zlarft.f @@ -130,8 +130,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup complex16OTHERauxiliary * *> \par Further Details: @@ -163,10 +161,9 @@ * ===================================================================== SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. CHARACTER DIRECT, STOREV diff --git a/lib/linalg/zlascl.f b/lib/linalg/zlascl.f index c53c6f5ad7..3d53f5ae60 100644 --- a/lib/linalg/zlascl.f +++ b/lib/linalg/zlascl.f @@ -136,17 +136,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 .. CHARACTER TYPE diff --git a/lib/linalg/zlaset.f b/lib/linalg/zlaset.f index 796678217b..00f5f595fc 100644 --- a/lib/linalg/zlaset.f +++ b/lib/linalg/zlaset.f @@ -99,17 +99,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 UPLO diff --git a/lib/linalg/zlasr.f b/lib/linalg/zlasr.f index 69891ba522..07c91329c4 100644 --- a/lib/linalg/zlasr.f +++ b/lib/linalg/zlasr.f @@ -193,17 +193,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 DIRECT, PIVOT, SIDE diff --git a/lib/linalg/zlatrd.f b/lib/linalg/zlatrd.f index ccc040993f..ee2a484723 100644 --- a/lib/linalg/zlatrd.f +++ b/lib/linalg/zlatrd.f @@ -140,8 +140,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * *> \par Further Details: @@ -199,10 +197,9 @@ * ===================================================================== SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- 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 UPLO @@ -271,7 +268,7 @@ * ALPHA = A( I-1, I ) CALL ZLARFG( I-1, ALPHA, A( 1, I ), 1, TAU( I-1 ) ) - E( I-1 ) = ALPHA + E( I-1 ) = DBLE( ALPHA ) A( I-1, I ) = ONE * * Compute W(1:i-1,i) @@ -325,7 +322,7 @@ ALPHA = A( I+1, I ) CALL ZLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1, $ TAU( I ) ) - E( I ) = ALPHA + E( I ) = DBLE( ALPHA ) A( I+1, I ) = ONE * * Compute W(i+1:n,i) diff --git a/lib/linalg/zpptrf.f b/lib/linalg/zpptrf.f index 6e50b46828..a34d639131 100644 --- a/lib/linalg/zpptrf.f +++ b/lib/linalg/zpptrf.f @@ -92,8 +92,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * *> \par Further Details: @@ -119,10 +117,9 @@ * ===================================================================== SUBROUTINE ZPPTRF( UPLO, N, AP, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO @@ -192,8 +189,8 @@ * * Compute U(J,J) and test for non-positive-definiteness. * - AJJ = DBLE( AP( JJ ) ) - ZDOTC( J-1, AP( JC ), 1, AP( JC ), - $ 1 ) + AJJ = DBLE( AP( JJ ) ) - DBLE( ZDOTC( J-1, + $ AP( JC ), 1, AP( JC ), 1 ) ) IF( AJJ.LE.ZERO ) THEN AP( JJ ) = AJJ GO TO 30 diff --git a/lib/linalg/zpptri.f b/lib/linalg/zpptri.f index cde2f6dc72..a74466eb80 100644 --- a/lib/linalg/zpptri.f +++ b/lib/linalg/zpptri.f @@ -86,17 +86,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZPPTRI( UPLO, N, AP, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO @@ -164,7 +161,7 @@ JJ = JJ + J IF( J.GT.1 ) $ CALL ZHPR( 'Upper', J-1, ONE, AP( JC ), 1, AP ) - AJJ = AP( JJ ) + AJJ = DBLE( AP( JJ ) ) CALL ZDSCAL( J, AJJ, AP( JC ), 1 ) 10 CONTINUE * diff --git a/lib/linalg/zscal.f b/lib/linalg/zscal.f index 9f6d4b1d39..8085f5a399 100644 --- a/lib/linalg/zscal.f +++ b/lib/linalg/zscal.f @@ -61,8 +61,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -78,10 +76,9 @@ * ===================================================================== SUBROUTINE ZSCAL(N,ZA,ZX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ZA @@ -114,4 +111,7 @@ END DO END IF RETURN +* +* End of ZSCAL +* END diff --git a/lib/linalg/zsteqr.f b/lib/linalg/zsteqr.f index ac47890685..47f4004e8d 100644 --- a/lib/linalg/zsteqr.f +++ b/lib/linalg/zsteqr.f @@ -125,17 +125,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 COMPZ diff --git a/lib/linalg/zswap.f b/lib/linalg/zswap.f index 6768d5e6e0..93f8fc52d0 100644 --- a/lib/linalg/zswap.f +++ b/lib/linalg/zswap.f @@ -65,8 +65,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -81,10 +79,9 @@ * ===================================================================== SUBROUTINE ZSWAP(N,ZX,INCX,ZY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -126,4 +123,7 @@ END DO END IF RETURN +* +* End of ZSWAP +* END diff --git a/lib/linalg/ztpmv.f b/lib/linalg/ztpmv.f index 65aa2a0abc..363fd5a2ac 100644 --- a/lib/linalg/ztpmv.f +++ b/lib/linalg/ztpmv.f @@ -120,8 +120,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -142,10 +140,9 @@ * ===================================================================== SUBROUTINE ZTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -383,6 +380,6 @@ * RETURN * -* End of ZTPMV . +* End of ZTPMV * END diff --git a/lib/linalg/ztpsv.f b/lib/linalg/ztpsv.f index 538888424a..c6f24d0b27 100644 --- a/lib/linalg/ztpsv.f +++ b/lib/linalg/ztpsv.f @@ -123,8 +123,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -144,10 +142,9 @@ * ===================================================================== SUBROUTINE ZTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -385,6 +382,6 @@ * RETURN * -* End of ZTPSV . +* End of ZTPSV * END diff --git a/lib/linalg/ztptri.f b/lib/linalg/ztptri.f index 35388194c3..31284ad637 100644 --- a/lib/linalg/ztptri.f +++ b/lib/linalg/ztptri.f @@ -91,8 +91,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * *> \par Further Details: @@ -117,10 +115,9 @@ * ===================================================================== SUBROUTINE ZTPTRI( UPLO, DIAG, N, AP, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 DIAG, UPLO diff --git a/lib/linalg/ztrmm.f b/lib/linalg/ztrmm.f index 0f445f52a7..c59c367cee 100644 --- a/lib/linalg/ztrmm.f +++ b/lib/linalg/ztrmm.f @@ -156,8 +156,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level3 * *> \par Further Details: @@ -177,10 +175,9 @@ * ===================================================================== SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -447,6 +444,6 @@ * RETURN * -* End of ZTRMM . +* End of ZTRMM * END diff --git a/lib/linalg/ztrmv.f b/lib/linalg/ztrmv.f index 52d1ae6799..e8314facb7 100644 --- a/lib/linalg/ztrmv.f +++ b/lib/linalg/ztrmv.f @@ -125,8 +125,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -147,10 +145,9 @@ * ===================================================================== SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -368,6 +365,6 @@ * RETURN * -* End of ZTRMV . +* End of ZTRMV * END diff --git a/lib/linalg/zung2l.f b/lib/linalg/zung2l.f index 1a48c4d6bc..add5cb946b 100644 --- a/lib/linalg/zung2l.f +++ b/lib/linalg/zung2l.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/zung2r.f b/lib/linalg/zung2r.f index 4a3fed0f0d..2823b7ebdd 100644 --- a/lib/linalg/zung2r.f +++ b/lib/linalg/zung2r.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNG2R( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/zungl2.f b/lib/linalg/zungl2.f index 0774cc4405..e7a0b59603 100644 --- a/lib/linalg/zungl2.f +++ b/lib/linalg/zungl2.f @@ -106,17 +106,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNGL2( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/zungql.f b/lib/linalg/zungql.f index c63a47db56..1804ca65ff 100644 --- a/lib/linalg/zungql.f +++ b/lib/linalg/zungql.f @@ -121,17 +121,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, LWORK, M, N diff --git a/lib/linalg/zungqr.f b/lib/linalg/zungqr.f index 5f95b64e88..b3f2c4507f 100644 --- a/lib/linalg/zungqr.f +++ b/lib/linalg/zungqr.f @@ -121,17 +121,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 .. INTEGER INFO, K, LDA, LWORK, M, N diff --git a/lib/linalg/zungtr.f b/lib/linalg/zungtr.f index 728854332f..01e100a8cd 100644 --- a/lib/linalg/zungtr.f +++ b/lib/linalg/zungtr.f @@ -116,17 +116,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- 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 UPLO