diff --git a/.gitignore b/.gitignore index f5eb6ae4e..fa2b91d9b 100644 --- a/.gitignore +++ b/.gitignore @@ -14,6 +14,7 @@ lapack-3.4.2.tgz lapack-netlib/make.inc lapack-netlib/lapacke/include/lapacke_mangling.h lapack-netlib/TESTING/testing_results.txt +lapack-netlib/INSTALL/test* *.so *.so.* *.a diff --git a/lapack-netlib/BLAS/blas.pc.in b/lapack-netlib/BLAS/blas.pc.in index 845a25c36..b8963c5bf 100644 --- a/lapack-netlib/BLAS/blas.pc.in +++ b/lapack-netlib/BLAS/blas.pc.in @@ -1,9 +1,9 @@ -prefix=@prefix@ -libdir=@libdir@ +prefix=@CMAKE_INSTALL_PREFIX@ +libdir=@CMAKE_INSTALL_PREFIX@/@CMAKE_INSTALL_LIBDIR@ Name: blas Description: Basic Linear Algebra Subprograms F77 reference implementations Version: @LAPACK_VERSION@ URL: http://www.netlib.org/blas/ -Libs: -L${libdir} -lblas +Libs: -L@CMAKE_INSTALL_PREFIX@/@CMAKE_INSTALL_LIBDIR@ -lblas Libs.private: -lm diff --git a/lapack-netlib/CBLAS/CMakeLists.txt b/lapack-netlib/CBLAS/CMakeLists.txt index 98b481f05..95b3bf6e0 100644 --- a/lapack-netlib/CBLAS/CMakeLists.txt +++ b/lapack-netlib/CBLAS/CMakeLists.txt @@ -65,9 +65,9 @@ if(ALL_TARGETS) list(GET ALL_TARGETS 0 _cblas_config_build_guard_target) endif() -configure_file(${CMAKE_CURRENT_SOURCE_DIR}/CMAKE/cblas-config-version.cmake.in +configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cmake/cblas-config-version.cmake.in ${LAPACK_BINARY_DIR}/cblas-config-version.cmake @ONLY) -configure_file(${CMAKE_CURRENT_SOURCE_DIR}/CMAKE/cblas-config-build.cmake.in +configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cmake/cblas-config-build.cmake.in ${LAPACK_BINARY_DIR}/cblas-config.cmake @ONLY) diff --git a/lapack-netlib/CBLAS/testing/CMakeLists.txt b/lapack-netlib/CBLAS/testing/CMakeLists.txt index c7eb87e22..28c55353f 100644 --- a/lapack-netlib/CBLAS/testing/CMakeLists.txt +++ b/lapack-netlib/CBLAS/testing/CMakeLists.txt @@ -16,7 +16,6 @@ macro(add_cblas_test output input target) -DINTDIR=${CMAKE_CFG_INTDIR} -P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake") else() - string(REPLACE "." "_" input_name ${input}) add_test(NAME CBLAS-${testName} COMMAND "${CMAKE_COMMAND}" -DTEST=$ -DOUTPUT=${TEST_OUTPUT} diff --git a/lapack-netlib/CBLAS/testing/Makefile b/lapack-netlib/CBLAS/testing/Makefile index 2ad1ad1d9..b4213e410 100644 --- a/lapack-netlib/CBLAS/testing/Makefile +++ b/lapack-netlib/CBLAS/testing/Makefile @@ -41,7 +41,7 @@ all2: stest2 dtest2 ctest2 ztest2 all3: stest3 dtest3 ctest3 ztest3 clean: - rm -f core *.o a.out x* + rm -f core *.o *.out x* cleanobj: rm -f core *.o a.out cleanexe: diff --git a/lapack-netlib/CBLAS/testing/c_cblat3.f b/lapack-netlib/CBLAS/testing/c_cblat3.f index b03d47916..62a43643e 100644 --- a/lapack-netlib/CBLAS/testing/c_cblat3.f +++ b/lapack-netlib/CBLAS/testing/c_cblat3.f @@ -1365,8 +1365,9 @@ * 150 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - CALL CPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, - $ M, N, ALPHA, LDA, LDB) + IF( TRACE ) + $ CALL CPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, + $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE RETURN diff --git a/lapack-netlib/CBLAS/testing/c_dblat3.f b/lapack-netlib/CBLAS/testing/c_dblat3.f index fb9acbb91..846ac953c 100644 --- a/lapack-netlib/CBLAS/testing/c_dblat3.f +++ b/lapack-netlib/CBLAS/testing/c_dblat3.f @@ -1335,8 +1335,9 @@ * 150 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - CALL DPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, - $ M, N, ALPHA, LDA, LDB) + IF( TRACE ) + $ CALL DPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, + $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE RETURN diff --git a/lapack-netlib/CBLAS/testing/c_sblat3.f b/lapack-netlib/CBLAS/testing/c_sblat3.f index 948fd6ed1..c6b42d545 100644 --- a/lapack-netlib/CBLAS/testing/c_sblat3.f +++ b/lapack-netlib/CBLAS/testing/c_sblat3.f @@ -1339,8 +1339,9 @@ * 150 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - CALL SPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, - $ M, N, ALPHA, LDA, LDB) + IF( TRACE ) + $ CALL SPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, + $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE RETURN diff --git a/lapack-netlib/CBLAS/testing/c_zblat2.f b/lapack-netlib/CBLAS/testing/c_zblat2.f index 236088ff3..12bf0e77a 100644 --- a/lapack-netlib/CBLAS/testing/c_zblat2.f +++ b/lapack-netlib/CBLAS/testing/c_zblat2.f @@ -1350,7 +1350,7 @@ * * Call the subroutine. * - IF( SNAME( 4: 5 ).EQ.'mv' )THEN + IF( SNAME( 10: 11 ).EQ.'mv' )THEN IF( FULL )THEN IF( TRACE ) $ WRITE( NTRA, FMT = 9993 )NC, SNAME, @@ -1376,7 +1376,7 @@ CALL CZTPMV( IORDER, UPLO, TRANS, DIAG, $ N, AA, XX, INCX ) END IF - ELSE IF( SNAME( 4: 5 ).EQ.'sv' )THEN + ELSE IF( SNAME( 10: 11 ).EQ.'sv' )THEN IF( FULL )THEN IF( TRACE ) $ WRITE( NTRA, FMT = 9993 )NC, SNAME, @@ -1465,7 +1465,7 @@ END IF * IF( .NOT.NULL )THEN - IF( SNAME( 4: 5 ).EQ.'mv' )THEN + IF( SNAME( 10: 11 ).EQ.'mv' )THEN * * Check the result. * @@ -1473,7 +1473,7 @@ $ INCX, ZERO, Z, INCX, XT, G, $ XX, EPS, ERR, FATAL, NOUT, $ .TRUE. ) - ELSE IF( SNAME( 4: 5 ).EQ.'sv' )THEN + ELSE IF( SNAME( 10: 11 ).EQ.'sv' )THEN * * Compute approximation to original vector. * @@ -1611,7 +1611,7 @@ * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK * .. Executable Statements .. - CONJ = SNAME( 5: 5 ).EQ.'c' + CONJ = SNAME( 11: 11 ).EQ.'c' * Define the number of arguments. NARGS = 9 * diff --git a/lapack-netlib/CBLAS/testing/c_zblat3.f b/lapack-netlib/CBLAS/testing/c_zblat3.f index 6e9dbbd8c..4b278a162 100644 --- a/lapack-netlib/CBLAS/testing/c_zblat3.f +++ b/lapack-netlib/CBLAS/testing/c_zblat3.f @@ -1366,8 +1366,9 @@ * 150 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - CALL ZPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, - $ M, N, ALPHA, LDA, LDB) + IF( TRACE ) + $ CALL ZPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, + $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE RETURN diff --git a/lapack-netlib/CMAKE/CheckFortranTypeSizes.cmake b/lapack-netlib/CMAKE/CheckFortranTypeSizes.cmake index 1f410e310..992311756 100644 --- a/lapack-netlib/CMAKE/CheckFortranTypeSizes.cmake +++ b/lapack-netlib/CMAKE/CheckFortranTypeSizes.cmake @@ -18,7 +18,7 @@ macro( _CHECK_FORTRAN_TYPE_SIZE _TYPE_NAME _TEST_SIZES ) foreach( __TEST_SIZE ${_TEST_SIZES} ) - set( __TEST_FILE ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/testFortran${_TYPE_NAME}Size${__TEST_SIZE}.f90 ) + set( __TEST_FILE ${PROJECT_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/testFortran${_TYPE_NAME}Size${__TEST_SIZE}.f90 ) file( WRITE ${__TEST_FILE} " PROGRAM check_size @@ -27,7 +27,7 @@ macro( _CHECK_FORTRAN_TYPE_SIZE _TYPE_NAME _TEST_SIZES ) pa => a END PROGRAM ") - try_compile( SIZEOF_${_TYPE_NAME} ${PROJECT_BINARY_DIR} ${__TEST_FILE} ) +try_compile( SIZEOF_${_TYPE_NAME} ${PROJECT_BINARY_DIR} ${__TEST_FILE} ) if( SIZEOF_${_TYPE_NAME} ) message( STATUS "Testing default ${_TYPE_NAME}*${__TEST_SIZE} - found" ) set( SIZEOF_${_TYPE_NAME} ${__TEST_SIZE} CACHE INTERNAL "Size of the default ${_TYPE_NAME} type" FORCE ) diff --git a/lapack-netlib/CMakeLists.txt b/lapack-netlib/CMakeLists.txt index ab29bd274..657875fee 100644 --- a/lapack-netlib/CMakeLists.txt +++ b/lapack-netlib/CMakeLists.txt @@ -3,7 +3,7 @@ project(LAPACK Fortran) set(LAPACK_MAJOR_VERSION 3) set(LAPACK_MINOR_VERSION 6) -set(LAPACK_PATCH_VERSION 0) +set(LAPACK_PATCH_VERSION 1) set( LAPACK_VERSION ${LAPACK_MAJOR_VERSION}.${LAPACK_MINOR_VERSION}.${LAPACK_PATCH_VERSION} @@ -17,11 +17,10 @@ set( set(CMAKE_MACOSX_RPATH ON) set(CMAKE_SKIP_BUILD_RPATH FALSE) set(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE) - set(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_PREFIX}/lib") - set(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE) - list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${CMAKE_INSTALL_PREFIX}/lib" isSystemDir) + list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${CMAKE_INSTALL_PREFIX}/lib${LIB_SUFFIX}" isSystemDir) if("${isSystemDir}" STREQUAL "-1") - set(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_PREFIX}/lib") + set(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_PREFIX}/lib${LIB_SUFFIX}") + set(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE) endif() @@ -37,7 +36,7 @@ set(CMAKE_MODULE_PATH "${LAPACK_SOURCE_DIR}/CMAKE" ${CMAKE_MODULE_PATH}) if (UNIX) if ( "${CMAKE_Fortran_COMPILER}" MATCHES "ifort" ) - set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fltconsistency -fp_port" ) + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fp-model strict" ) endif () if ( "${CMAKE_Fortran_COMPILER}" MATCHES "xlf" ) set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qnosave -qstrict=none" ) @@ -47,6 +46,33 @@ if (UNIX) STRING(REPLACE \;mtsk\; \; CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES "${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}") endif () +if ( CMAKE_Fortran_COMPILER_ID STREQUAL "Compaq" ) + if ( WIN32 ) + if (CMAKE_GENERATOR STREQUAL "NMake Makefiles") + get_filename_component(CMAKE_Fortran_COMPILER_CMDNAM ${CMAKE_Fortran_COMPILER} NAME_WE) + message(STATUS "Using Compaq Fortran compiler with command name ${CMAKE_Fortran_COMPILER_CMDNAM}") + set( cmd ${CMAKE_Fortran_COMPILER_CMDNAM} ) + string( TOLOWER "${cmd}" cmdlc ) + if ( cmdlc STREQUAL "df" ) + message(STATUS "Assume the Compaq Visual Fortran Compiler is being used") + set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_OBJECTS 1) + set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_INCLUDES 1) + #This is a workaround that is needed to avoid forward-slashes in the + #filenames listed in response files from incorrectly being interpreted as + #introducing compiler command options + if (${BUILD_SHARED_LIBS}) + message(FATAL_ERROR "Making of shared libraries with CVF has not been tested.") + endif() + set(str "NMake version 9 or later should be used. NMake version 6.0 which is\n") + set(str "${str} included with the CVF distribution fails to build Lapack because\n") + set(str "${str} the number of source files exceeds the limit for NMake v6.0\n") + message(STATUS ${str}) + set(CMAKE_Fortran_LINK_EXECUTABLE "LINK /out: ") + endif() + endif() + endif() +endif() + # Get Python find_package(PythonInterp) message(STATUS "Looking for Python found - ${PYTHONINTERP_FOUND}") diff --git a/lapack-netlib/DOCS/Doxyfile b/lapack-netlib/DOCS/Doxyfile index 2ffed29f2..1dedbe7aa 100644 --- a/lapack-netlib/DOCS/Doxyfile +++ b/lapack-netlib/DOCS/Doxyfile @@ -210,7 +210,7 @@ INHERIT_DOCS = YES # of the file/class/namespace that contains it. # The default value is: NO. -SEPARATE_MEMBER_PAGES = NO +SEPARATE_MEMBER_PAGES = YES # The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen # uses this value to replace tabs by spaces in code fragments. diff --git a/lapack-netlib/INSTALL/Makefile b/lapack-netlib/INSTALL/Makefile index d322048b0..a745cad8a 100644 --- a/lapack-netlib/INSTALL/Makefile +++ b/lapack-netlib/INSTALL/Makefile @@ -1,7 +1,7 @@ include ../make.inc .SUFFIXES : .o .f -all: slamch.o dlamch.o testlsame testslamch testdlamch testsecond testdsecnd testieee testversion +all: testlsame testslamch testdlamch testsecond testdsecnd testieee testversion slamch.o dlamch.o testlsame: lsame.o lsametst.o $(LOADER) $(LOADOPTS) -o testlsame lsame.o lsametst.o diff --git a/lapack-netlib/INSTALL/ilaver.f b/lapack-netlib/INSTALL/ilaver.f index c882d03f5..b32ea1972 100644 --- a/lapack-netlib/INSTALL/ilaver.f +++ b/lapack-netlib/INSTALL/ilaver.f @@ -41,7 +41,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -51,7 +51,7 @@ * -- LAPACK computational routine (version 3.6.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * ===================================================================== * @@ -59,7 +59,7 @@ * ===================================================================== VERS_MAJOR = 3 VERS_MINOR = 6 - VERS_PATCH = 0 + VERS_PATCH = 1 * ===================================================================== * RETURN diff --git a/lapack-netlib/INSTALL/make.inc.ifort b/lapack-netlib/INSTALL/make.inc.ifort index 5fca5c47e..504ab1c38 100644 --- a/lapack-netlib/INSTALL/make.inc.ifort +++ b/lapack-netlib/INSTALL/make.inc.ifort @@ -1,7 +1,7 @@ #################################################################### # LAPACK make include file. # # LAPACK, Version 3.6.0 # -# November 2015 # +# June 2016 # #################################################################### # SHELL = /bin/sh @@ -13,9 +13,9 @@ SHELL = /bin/sh # and desired load options for your machine. # FORTRAN = ifort -OPTS = -O3 +OPTS = -O3 -fp-model strict DRVOPTS = $(OPTS) -NOOPT = -O3 -fltconsistency -fp_port +NOOPT = -O0 -fp-model strict LOADER = ifort LOADOPTS = # diff --git a/lapack-netlib/LAPACKE/CMakeLists.txt b/lapack-netlib/LAPACKE/CMakeLists.txt index 008f24cd3..4c61eaa04 100644 --- a/lapack-netlib/LAPACKE/CMakeLists.txt +++ b/lapack-netlib/LAPACKE/CMakeLists.txt @@ -81,7 +81,7 @@ configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cmake/lapacke-config-install.cmake.in install(FILES ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/lapacke-config.cmake ${LAPACK_BINARY_DIR}/lapacke-config-version.cmake - DESTINATION lib/cmake/lapacke-${LAPACK_VERSION} + DESTINATION ${LIBRARY_DIR}/cmake/lapacke-${LAPACK_VERSION} ) install(EXPORT lapacke-targets diff --git a/lapack-netlib/LAPACKE/include/lapacke.h b/lapack-netlib/LAPACKE/include/lapacke.h index 03c33213e..7034f8d5f 100644 --- a/lapack-netlib/LAPACKE/include/lapacke.h +++ b/lapack-netlib/LAPACKE/include/lapacke.h @@ -180,14 +180,14 @@ lapack_int LAPACKE_zbdsqr( int matrix_layout, char uplo, lapack_int n, lapack_int ldc ); lapack_int LAPACKE_sbdsvdx( int matrix_layout, char uplo, char jobz, char range, lapack_int n, float* d, float* e, - lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, float* z, lapack_int ldz, lapack_int* superb ); lapack_int LAPACKE_dbdsvdx( int matrix_layout, char uplo, char jobz, char range, lapack_int n, double* d, double* e, - lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, double* z, lapack_int ldz, lapack_int* superb ); lapack_int LAPACKE_sdisna( char job, lapack_int m, lapack_int n, const float* d, @@ -999,29 +999,29 @@ lapack_int LAPACKE_zgesvd( int matrix_layout, char jobu, char jobvt, lapack_int LAPACKE_sgesvdx( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, float* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, float* u, lapack_int ldu, float* vt, lapack_int ldvt, lapack_int* superb ); lapack_int LAPACKE_dgesvdx( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, double* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, double* u, lapack_int ldu, double* vt, lapack_int ldvt, lapack_int* superb ); lapack_int LAPACKE_cgesvdx( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, lapack_complex_float* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, lapack_complex_float* u, lapack_int ldu, lapack_complex_float* vt, lapack_int ldvt, lapack_int* superb ); lapack_int LAPACKE_zgesvdx( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, lapack_complex_double* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, lapack_complex_double* u, lapack_int ldu, lapack_complex_double* vt, lapack_int ldvt, lapack_int* superb ); @@ -4738,17 +4738,17 @@ lapack_int LAPACKE_dbdsdc_work( int matrix_layout, char uplo, char compq, lapack_int* iwork ); lapack_int LAPACKE_sbdsvdx_work( int matrix_layout, char uplo, char jobz, char range, - lapack_int n, float* d, float* e, - lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, - float* s, float* z, lapack_int ldz, - float* work, lapack_int* iwork ); + lapack_int n, float* d, float* e, + float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, + float* s, float* z, lapack_int ldz, + float* work, lapack_int* iwork ); lapack_int LAPACKE_dbdsvdx_work( int matrix_layout, char uplo, char jobz, char range, - lapack_int n, double* d, double* e, - lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, - double* s, double* z, lapack_int ldz, - double* work, lapack_int* iwork ); + lapack_int n, double* d, double* e, + double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, + double* s, double* z, lapack_int ldz, + double* work, lapack_int* iwork ); lapack_int LAPACKE_sbdsqr_work( int matrix_layout, char uplo, lapack_int n, lapack_int ncvt, lapack_int nru, lapack_int ncc, @@ -5760,30 +5760,30 @@ lapack_int LAPACKE_zgesvd_work( int matrix_layout, char jobu, char jobvt, lapack_int LAPACKE_sgesvdx_work( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, float* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, float* u, lapack_int ldu, float* vt, lapack_int ldvt, float* work, lapack_int lwork, lapack_int* iwork ); lapack_int LAPACKE_dgesvdx_work( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, double* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, double* u, lapack_int ldu, double* vt, lapack_int ldvt, double* work, lapack_int lwork, lapack_int* iwork ); lapack_int LAPACKE_cgesvdx_work( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, lapack_complex_float* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, lapack_complex_float* u, lapack_int ldu, lapack_complex_float* vt, lapack_int ldvt, lapack_complex_float* work, lapack_int lwork, float* rwork, lapack_int* iwork ); lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, lapack_complex_double* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, lapack_complex_double* u, lapack_int ldu, lapack_complex_double* vt, lapack_int ldvt, lapack_complex_double* work, lapack_int lwork, @@ -10472,11 +10472,11 @@ lapack_int LAPACKE_cbbcsd_work( int matrix_layout, char jobu1, char jobu2, float* b22d, float* b22e, float* rwork, lapack_int lrwork ); lapack_int LAPACKE_cheswapr( int matrix_layout, char uplo, lapack_int n, - lapack_complex_float* a, lapack_int i1, - lapack_int i2 ); + lapack_complex_float* a, lapack_int lda, + lapack_int i1, lapack_int i2 ); lapack_int LAPACKE_cheswapr_work( int matrix_layout, char uplo, lapack_int n, - lapack_complex_float* a, lapack_int i1, - lapack_int i2 ); + lapack_complex_float* a, lapack_int lda, + lapack_int i1, lapack_int i2 ); lapack_int LAPACKE_chetri2( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv ); @@ -10502,17 +10502,17 @@ lapack_int LAPACKE_chetrs2_work( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work ); lapack_int LAPACKE_csyconv( int matrix_layout, char uplo, char way, lapack_int n, lapack_complex_float* a, lapack_int lda, - const lapack_int* ipiv, lapack_complex_float* work ); + const lapack_int* ipiv, lapack_complex_float* e ); lapack_int LAPACKE_csyconv_work( int matrix_layout, char uplo, char way, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, - lapack_complex_float* work ); + lapack_complex_float* e ); lapack_int LAPACKE_csyswapr( int matrix_layout, char uplo, lapack_int n, - lapack_complex_float* a, lapack_int i1, - lapack_int i2 ); + lapack_complex_float* a, lapack_int lda, + lapack_int i1, lapack_int i2 ); lapack_int LAPACKE_csyswapr_work( int matrix_layout, char uplo, lapack_int n, - lapack_complex_float* a, lapack_int i1, - lapack_int i2 ); + lapack_complex_float* a, lapack_int lda, + lapack_int i1, lapack_int i2 ); lapack_int LAPACKE_csytri2( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv ); @@ -10590,14 +10590,14 @@ lapack_int LAPACKE_cuncsd2by1( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, lapack_complex_float* x11, lapack_int ldx11, lapack_complex_float* x21, lapack_int ldx21, - lapack_complex_float* theta, lapack_complex_float* u1, + float* theta, lapack_complex_float* u1, lapack_int ldu1, lapack_complex_float* u2, lapack_int ldu2, lapack_complex_float* v1t, lapack_int ldv1t ); lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, lapack_complex_float* x11, lapack_int ldx11, lapack_complex_float* x21, lapack_int ldx21, - lapack_complex_float* theta, lapack_complex_float* u1, + float* theta, lapack_complex_float* u1, lapack_int ldu1, lapack_complex_float* u2, lapack_int ldu2, lapack_complex_float* v1t, lapack_int ldv1t, lapack_complex_float* work, @@ -10669,20 +10669,22 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, lapack_int ldu2, double* v1t, lapack_int ldv1t, double* work, lapack_int lwork, lapack_int* iwork ); lapack_int LAPACKE_dsyconv( int matrix_layout, char uplo, char way, lapack_int n, - double* a, lapack_int lda, const lapack_int* ipiv, double* work); + double* a, lapack_int lda, const lapack_int* ipiv, double* e); lapack_int LAPACKE_dsyconv_work( int matrix_layout, char uplo, char way, lapack_int n, double* a, lapack_int lda, - const lapack_int* ipiv, double* work ); + const lapack_int* ipiv, double* e ); lapack_int LAPACKE_dsyswapr( int matrix_layout, char uplo, lapack_int n, - double* a, lapack_int i1, lapack_int i2 ); + double* a, lapack_int lda, lapack_int i1, + lapack_int i2 ); lapack_int LAPACKE_dsyswapr_work( int matrix_layout, char uplo, lapack_int n, - double* a, lapack_int i1, lapack_int i2 ); + double* a, lapack_int lda, lapack_int i1, + lapack_int i2 ); lapack_int LAPACKE_dsytri2( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv ); lapack_int LAPACKE_dsytri2_work( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, - lapack_complex_double* work, lapack_int lwork ); + double* work, lapack_int lwork ); lapack_int LAPACKE_dsytri2x( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, lapack_int nb ); @@ -10762,20 +10764,22 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, lapack_int ldu2, float* v1t, lapack_int ldv1t, float* work, lapack_int lwork, lapack_int* iwork ); lapack_int LAPACKE_ssyconv( int matrix_layout, char uplo, char way, lapack_int n, - float* a, lapack_int lda, const lapack_int* ipiv, float* work ); + float* a, lapack_int lda, const lapack_int* ipiv, float* e ); lapack_int LAPACKE_ssyconv_work( int matrix_layout, char uplo, char way, lapack_int n, float* a, lapack_int lda, - const lapack_int* ipiv, float* work ); + const lapack_int* ipiv, float* e ); lapack_int LAPACKE_ssyswapr( int matrix_layout, char uplo, lapack_int n, - float* a, lapack_int i1, lapack_int i2 ); + float* a, lapack_int lda, lapack_int i1, + lapack_int i2 ); lapack_int LAPACKE_ssyswapr_work( int matrix_layout, char uplo, lapack_int n, - float* a, lapack_int i1, lapack_int i2 ); + float* a, lapack_int lda, lapack_int i1, + lapack_int i2 ); lapack_int LAPACKE_ssytri2( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv ); lapack_int LAPACKE_ssytri2_work( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, - lapack_complex_float* work, lapack_int lwork ); + float* work, lapack_int lwork ); lapack_int LAPACKE_ssytri2x( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, lapack_int nb ); @@ -10813,11 +10817,11 @@ lapack_int LAPACKE_zbbcsd_work( int matrix_layout, char jobu1, char jobu2, double* b22d, double* b22e, double* rwork, lapack_int lrwork ); lapack_int LAPACKE_zheswapr( int matrix_layout, char uplo, lapack_int n, - lapack_complex_double* a, lapack_int i1, - lapack_int i2 ); + lapack_complex_double* a, lapack_int lda, + lapack_int i1, lapack_int i2 ); lapack_int LAPACKE_zheswapr_work( int matrix_layout, char uplo, lapack_int n, - lapack_complex_double* a, lapack_int i1, - lapack_int i2 ); + lapack_complex_double* a, lapack_int lda, + lapack_int i1, lapack_int i2 ); lapack_int LAPACKE_zhetri2( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv ); @@ -10843,17 +10847,17 @@ lapack_int LAPACKE_zhetrs2_work( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work ); lapack_int LAPACKE_zsyconv( int matrix_layout, char uplo, char way, lapack_int n, lapack_complex_double* a, lapack_int lda, - const lapack_int* ipiv, lapack_complex_double* work ); + const lapack_int* ipiv, lapack_complex_double* e ); lapack_int LAPACKE_zsyconv_work( int matrix_layout, char uplo, char way, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, - lapack_complex_double* work ); + lapack_complex_double* e ); lapack_int LAPACKE_zsyswapr( int matrix_layout, char uplo, lapack_int n, - lapack_complex_double* a, lapack_int i1, - lapack_int i2 ); + lapack_complex_double* a, lapack_int lda, + lapack_int i1, lapack_int i2 ); lapack_int LAPACKE_zsyswapr_work( int matrix_layout, char uplo, lapack_int n, - lapack_complex_double* a, lapack_int i1, - lapack_int i2 ); + lapack_complex_double* a, lapack_int lda, + lapack_int i1, lapack_int i2 ); lapack_int LAPACKE_zsytri2( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv ); @@ -10931,14 +10935,14 @@ lapack_int LAPACKE_zuncsd2by1( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, lapack_complex_double* x11, lapack_int ldx11, lapack_complex_double* x21, lapack_int ldx21, - lapack_complex_double* theta, lapack_complex_double* u1, + double* theta, lapack_complex_double* u1, lapack_int ldu1, lapack_complex_double* u2, lapack_int ldu2, lapack_complex_double* v1t, lapack_int ldv1t ); lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, lapack_complex_double* x11, lapack_int ldx11, lapack_complex_double* x21, lapack_int ldx21, - lapack_complex_double* theta, lapack_complex_double* u1, + double* theta, lapack_complex_double* u1, lapack_int ldu1, lapack_complex_double* u2, lapack_int ldu2, lapack_complex_double* v1t, lapack_int ldv1t, lapack_complex_double* work, @@ -11243,7 +11247,7 @@ lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans, lapack_int n, lapack_int k, lapack_int l, const float* v, lapack_int ldv, const float* t, lapack_int ldt, float* a, lapack_int lda, - float* b, lapack_int ldb, const float* work, + float* b, lapack_int ldb, float* work, lapack_int ldwork ); lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, @@ -11251,7 +11255,7 @@ lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans, const double* v, lapack_int ldv, const double* t, lapack_int ldt, double* a, lapack_int lda, double* b, lapack_int ldb, - const double* work, lapack_int ldwork ); + double* work, lapack_int ldwork ); lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, @@ -11417,9 +11421,9 @@ lapack_int LAPACKE_zsyr_work( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* x, lapack_int incx, lapack_complex_double* a, lapack_int lda ); -void LAPACKE_ilaver( const lapack_int* vers_major, - const lapack_int* vers_minor, - const lapack_int* vers_patch ); +void LAPACKE_ilaver( lapack_int* vers_major, + lapack_int* vers_minor, + lapack_int* vers_patch ); #define LAPACK_sgetrf LAPACK_GLOBAL(sgetrf,SGETRF) @@ -14784,13 +14788,13 @@ void LAPACK_dbdsdc( char* uplo, char* compq, lapack_int* n, double* d, lapack_int* iwork, lapack_int *info ); void LAPACK_sbdsvdx( char* uplo, char* jobz, char* range, lapack_int* n, float* d, float* e, - lapack_int* vl, lapack_int* vu, + float* vl, float* vu, lapack_int* il, lapack_int* iu, lapack_int* ns, float* s, float* z, lapack_int* ldz, float* work, lapack_int *iwork, lapack_int *info ); void LAPACK_dbdsvdx( char* uplo, char* jobz, char* range, lapack_int* n, double* d, double* e, - lapack_int* vl, lapack_int* vu, + double* vl, double* vu, lapack_int* il, lapack_int* iu, lapack_int* ns, double* s, double* z, lapack_int* ldz, double* work, lapack_int *iwork, lapack_int *info ); @@ -16115,24 +16119,24 @@ void LAPACK_zgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n, lapack_complex_double* work, lapack_int* lwork, double* rwork, lapack_int *info ); void LAPACK_sgesvdx( char* jobu, char* jobvt, char* range, lapack_int* m, lapack_int* n, - float* a, lapack_int* lda, lapack_int* vl, lapack_int* vu, + float* a, lapack_int* lda, float* vl, float* vu, lapack_int* il, lapack_int* iu, lapack_int* ns, float* s, float* u, lapack_int* ldu, float* vt, lapack_int* ldvt, float* work, lapack_int* lwork, lapack_int *iwork, lapack_int *info ); void LAPACK_dgesvdx( char* jobu, char* jobvt, char* range, lapack_int* m, lapack_int* n, - double* a, lapack_int* lda, lapack_int* vl, lapack_int* vu, + double* a, lapack_int* lda, double* vl, double* vu, lapack_int* il, lapack_int* iu, lapack_int* ns, double* s, double* u, lapack_int* ldu, double* vt, lapack_int* ldvt, double* work, lapack_int* lwork, lapack_int *iwork, lapack_int *info ); void LAPACK_cgesvdx( char* jobu, char* jobvt, char* range, lapack_int* m, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, lapack_int* vl, lapack_int* vu, + lapack_complex_float* a, lapack_int* lda, float* vl, float* vu, lapack_int* il, lapack_int* iu, lapack_int* ns, float* s, lapack_complex_float* u, lapack_int* ldu, lapack_complex_float* vt, lapack_int* ldvt, lapack_complex_float* work, lapack_int* lwork, float* rwork, lapack_int *iwork, lapack_int *info ); void LAPACK_zgesvdx( char* jobu, char* jobvt, char* range, lapack_int* m, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, lapack_int* vl, lapack_int* vu, + lapack_complex_double* a, lapack_int* lda, double* vl, double* vu, lapack_int* il, lapack_int* iu, lapack_int* ns, double* s, lapack_complex_double* u, lapack_int* ldu, lapack_complex_double* vt, lapack_int* ldvt, @@ -17060,9 +17064,8 @@ void LAPACK_cbbcsd( char* jobu1, char* jobu2, float* b12e, float* b21d, float* b21e, float* b22d, float* b22e, float* rwork, lapack_int* lrwork , lapack_int *info ); -void LAPACK_cheswapr( char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* i1, - lapack_int* i2 ); +void LAPACK_cheswapr( char* uplo, lapack_int* n, lapack_complex_float* a, + lapack_int* lda, lapack_int* i1, lapack_int* i2 ); void LAPACK_chetri2( char* uplo, lapack_int* n, lapack_complex_float* a, lapack_int* lda, const lapack_int* ipiv, @@ -17079,10 +17082,10 @@ void LAPACK_chetrs2( char* uplo, lapack_int* n, void LAPACK_csyconv( char* uplo, char* way, lapack_int* n, lapack_complex_float* a, lapack_int* lda, const lapack_int* ipiv, - lapack_complex_float* work , lapack_int *info ); + lapack_complex_float* e , lapack_int *info ); void LAPACK_csyswapr( char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* i1, - lapack_int* i2 ); + lapack_complex_float* a, lapack_int* lda, + lapack_int* i1, lapack_int* i2 ); void LAPACK_csytri2( char* uplo, lapack_int* n, lapack_complex_float* a, lapack_int* lda, const lapack_int* ipiv, @@ -17127,7 +17130,7 @@ void LAPACK_cuncsd2by1( char* jobu1, char* jobu2, char* jobv1t, lapack_int* m, lapack_int* p, lapack_int* q, lapack_complex_float* x11, lapack_int* ldx11, lapack_complex_float* x21, - lapack_int* ldx21, lapack_complex_float* theta, + lapack_int* ldx21, float* theta, lapack_complex_float* u1, lapack_int* ldu1, lapack_complex_float* u2, lapack_int* ldu2, lapack_complex_float* v1t, lapack_int* ldv1t, @@ -17173,13 +17176,13 @@ void LAPACK_dorcsd2by1( char* jobu1, char* jobu2, lapack_int* iwork , lapack_int *info ); void LAPACK_dsyconv( char* uplo, char* way, lapack_int* n, double* a, lapack_int* lda, - const lapack_int* ipiv, double* work , lapack_int *info ); -void LAPACK_dsyswapr( char* uplo, lapack_int* n, - double* a, lapack_int* i1, lapack_int* i2 ); + const lapack_int* ipiv, double* e , lapack_int *info ); +void LAPACK_dsyswapr( char* uplo, lapack_int* n, double* a, + lapack_int* lda, lapack_int* i1, lapack_int* i2 ); void LAPACK_dsytri2( char* uplo, lapack_int* n, double* a, lapack_int* lda, const lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork , lapack_int *info ); + double* work, lapack_int* lwork , lapack_int *info ); void LAPACK_dsytri2x( char* uplo, lapack_int* n, double* a, lapack_int* lda, const lapack_int* ipiv, double* work, @@ -17227,13 +17230,13 @@ void LAPACK_sorcsd2by1( char* jobu1, char* jobu2, lapack_int* iwork , lapack_int *info ); void LAPACK_ssyconv( char* uplo, char* way, lapack_int* n, float* a, lapack_int* lda, - const lapack_int* ipiv, float* work , lapack_int *info ); -void LAPACK_ssyswapr( char* uplo, lapack_int* n, - float* a, lapack_int* i1, lapack_int* i2 ); + const lapack_int* ipiv, float* e , lapack_int *info ); +void LAPACK_ssyswapr( char* uplo, lapack_int* n, float* a, + lapack_int* lda, lapack_int* i1, lapack_int* i2 ); void LAPACK_ssytri2( char* uplo, lapack_int* n, float* a, lapack_int* lda, const lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork , lapack_int *info ); + float* work, lapack_int* lwork , lapack_int *info ); void LAPACK_ssytri2x( char* uplo, lapack_int* n, float* a, lapack_int* lda, const lapack_int* ipiv, float* work, @@ -17254,9 +17257,8 @@ void LAPACK_zbbcsd( char* jobu1, char* jobu2, double* b12e, double* b21d, double* b21e, double* b22d, double* b22e, double* rwork, lapack_int* lrwork , lapack_int *info ); -void LAPACK_zheswapr( char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* i1, - lapack_int* i2 ); +void LAPACK_zheswapr( char* uplo, lapack_int* n, lapack_complex_double* a, + lapack_int* lda, lapack_int* i1, lapack_int* i2 ); void LAPACK_zhetri2( char* uplo, lapack_int* n, lapack_complex_double* a, lapack_int* lda, const lapack_int* ipiv, @@ -17274,9 +17276,9 @@ void LAPACK_zhetrs2( char* uplo, lapack_int* n, void LAPACK_zsyconv( char* uplo, char* way, lapack_int* n, lapack_complex_double* a, lapack_int* lda, const lapack_int* ipiv, - lapack_complex_double* work , lapack_int *info ); -void LAPACK_zsyswapr( char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* i1, + lapack_complex_double* e , lapack_int *info ); +void LAPACK_zsyswapr( char* uplo, lapack_int* n, lapack_complex_double* a, + lapack_int* lda, lapack_int* i1, lapack_int* i2 ); void LAPACK_zsytri2( char* uplo, lapack_int* n, lapack_complex_double* a, lapack_int* lda, @@ -17323,7 +17325,7 @@ void LAPACK_zuncsd2by1( char* jobu1, char* jobu2, char* jobv1t, lapack_int* m, lapack_int* p, lapack_int* q, lapack_complex_double* x11, lapack_int* ldx11, lapack_complex_double* x21, - lapack_int* ldx21, lapack_complex_double* theta, + lapack_int* ldx21, double* theta, lapack_complex_double* u1, lapack_int* ldu1, lapack_complex_double* u2, lapack_int* ldu2, lapack_complex_double* v1t, lapack_int* ldv1t, diff --git a/lapack-netlib/LAPACKE/include/lapacke_config.h b/lapack-netlib/LAPACKE/include/lapacke_config.h index 8262c3488..1e2509bf0 100644 --- a/lapack-netlib/LAPACKE/include/lapacke_config.h +++ b/lapack-netlib/LAPACKE/include/lapacke_config.h @@ -34,13 +34,6 @@ #ifndef _LAPACKE_CONFIG_H_ #define _LAPACKE_CONFIG_H_ -// For Android prior to API 21 (no include) -#if defined(__ANDROID__) -#if __ANDROID_API__ < 21 -#define LAPACK_COMPLEX_STRUCTURE -#endif -#endif - #ifdef __cplusplus #if defined(LAPACK_COMPLEX_CPP) #include diff --git a/lapack-netlib/LAPACKE/include/lapacke_mangling.h b/lapack-netlib/LAPACKE/include/lapacke_mangling.h new file mode 100644 index 000000000..6211fd144 --- /dev/null +++ b/lapack-netlib/LAPACKE/include/lapacke_mangling.h @@ -0,0 +1,17 @@ +#ifndef LAPACK_HEADER_INCLUDED +#define LAPACK_HEADER_INCLUDED + +#ifndef LAPACK_GLOBAL +#if defined(LAPACK_GLOBAL_PATTERN_LC) || defined(ADD_) +#define LAPACK_GLOBAL(lcname,UCNAME) lcname##_ +#elif defined(LAPACK_GLOBAL_PATTERN_UC) || defined(UPPER) +#define LAPACK_GLOBAL(lcname,UCNAME) UCNAME +#elif defined(LAPACK_GLOBAL_PATTERN_MC) || defined(NOCHANGE) +#define LAPACK_GLOBAL(lcname,UCNAME) lcname +#else +#define LAPACK_GLOBAL(lcname,UCNAME) lcname##_ +#endif +#endif + +#endif + diff --git a/lapack-netlib/LAPACKE/src/Makefile b/lapack-netlib/LAPACKE/src/Makefile index 636ca35b6..642b87541 100644 --- a/lapack-netlib/LAPACKE/src/Makefile +++ b/lapack-netlib/LAPACKE/src/Makefile @@ -34,7 +34,7 @@ # include ../../make.inc -SRC_OBJA = \ +SRC_OBJ = \ lapacke_cbbcsd.o \ lapacke_cbbcsd_work.o \ lapacke_cbdsqr.o \ @@ -996,9 +996,7 @@ lapacke_dsytri2.o \ lapacke_dsytri2_work.o \ lapacke_dsytri2x.o \ lapacke_dsytri2x_work.o \ -lapacke_dsytri_work.o - -SRC_OBJB = \ +lapacke_dsytri_work.o \ lapacke_dsytrs.o \ lapacke_dsytrs_rook.o \ lapacke_dsytrs2.o \ @@ -2191,8 +2189,7 @@ lapacke_slagsy_work.o \ lapacke_zlagsy.o \ lapacke_zlagsy_work.o -ALLOBJA = $(SRC_OBJA) -ALLOBJB = $(SRC_OBJB) $(MATGEN_OBJ) +ALLOBJ = $(SRC_OBJ) $(MATGEN_OBJ) ifdef USEXBLAS ALLXOBJ = $(SXLASRC) $(DXLASRC) $(CXLASRC) $(ZXLASRC) @@ -2206,9 +2203,8 @@ OBJ_FILES := $(C_FILES:.o=.o) all: ../../$(LAPACKELIB) -../../$(LAPACKELIB): $(ALLOBJA) $(ALLOBJB) $(ALLXOBJ) $(DEPRECATED) - $(ARCH) $(ARCHFLAGS) ../../$(LAPACKELIB) $(ALLOBJA) - $(ARCH) $(ARCHFLAGS) ../../$(LAPACKELIB) $(ALLOBJB) $(ALLXOBJ) $(DEPRECATED) +../../$(LAPACKELIB): $(ALLOBJ) $(ALLXOBJ) $(DEPRECATED) + $(ARCH) $(ARCHFLAGS) ../../$(LAPACKELIB) $(ALLOBJ) $(ALLXOBJ) $(DEPRECATED) $(RANLIB) ../../$(LAPACKELIB) .c.o: diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgejsv.c b/lapack-netlib/LAPACKE/src/lapacke_cgejsv.c index 32143ae6e..5bfb1553b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cgejsv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cgejsv.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function cgejsv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -119,7 +119,7 @@ lapack_int LAPACKE_cgejsv( int matrix_layout, char joba, char jobu, char jobv, ( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) && ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) : - 1 )))))))); + 7 )))))))); lapack_int* iwork = NULL; float* rwork = NULL; lapack_complex_float* cwork = NULL; @@ -136,30 +136,29 @@ lapack_int LAPACKE_cgejsv( int matrix_layout, char joba, char jobu, char jobv, if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, nu, n, u, ldu ) ) { - return -13; - } - } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, nv, n, v, ldv ) ) { - return -15; - } - } #endif /* Allocate memory for working array(s) */ - iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m+3*n) ); + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(3,m+2*n) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } + lwork = MAX( lwork, 1 ); + { /* FIXUP LWORK */ + int want_u = LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ); + int want_v = LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ); + int want_sce = LAPACKE_lsame( joba, 'e' ) || LAPACKE_lsame( joba, 'g' ); + if( !want_u && !want_v && !want_sce ) lwork = MAX( lwork, 2*n+1 ); // 1.1 + if( !want_u && !want_v && want_sce ) lwork = MAX( lwork, n*n+3*n ); // 1.2 + if( want_u && LAPACKE_lsame( jobv, 'v' ) ) lwork = MAX( lwork, 5*n+2*n*n ); // 4.1 + if( want_u && LAPACKE_lsame( jobv, 'j' ) ) lwork = MAX( lwork, 4*n+n*n ); // 4.2 + } cwork = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); if( cwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } + lrwork = MAX3( lrwork, 7, n+2*m ); rwork = (float*)LAPACKE_malloc( sizeof(float) * lrwork ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgejsv_work.c b/lapack-netlib/LAPACKE/src/lapacke_cgejsv_work.c index 72c3ddce7..1311ab93e 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cgejsv_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cgejsv_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function cgejsv * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -46,7 +46,7 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_cgejsv( &joba, &jobu, &jobv, &jobr, &jobt, &jobp, &m, &n, a, - &lda, sva, u, &ldu, v, &ldv, cwork, &lwork, rwork, &lwork, + &lda, sva, u, &ldu, v, &ldv, cwork, &lwork, rwork, &lrwork, iwork, &info ); if( info < 0 ) { info = info - 1; @@ -54,6 +54,8 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m; lapack_int nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'n' ) ? 1 : + LAPACKE_lsame( jobu, 'f' ) ? m : n; lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nu); lapack_int ldv_t = MAX(1,nv); @@ -66,7 +68,7 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, LAPACKE_xerbla( "LAPACKE_cgejsv_work", info ); return info; } - if( ldu < n ) { + if( ldu < ncols_u ) { info = -14; LAPACKE_xerbla( "LAPACKE_cgejsv_work", info ); return info; @@ -86,7 +88,7 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'w' ) ) { u_t = (lapack_complex_float*) - LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,n) ); + LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; @@ -103,14 +105,6 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, } /* Transpose input matrices */ LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_cge_trans( matrix_layout, nu, n, u, ldu, u_t, ldu_t ); - } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { - LAPACKE_cge_trans( matrix_layout, nv, n, v, ldv, v_t, ldv_t ); - } /* Call LAPACK function and adjust info */ LAPACK_cgejsv( &joba, &jobu, &jobv, &jobr, &jobt, &jobp, &m, &n, a_t, &lda_t, sva, u_t, &ldu_t, v_t, &ldv_t, cwork, &lwork, @@ -121,7 +115,7 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, /* Transpose output matrices */ if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nu, n, u_t, ldu_t, u, ldu ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, nu, ncols_u, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'w' ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgemqrt.c b/lapack-netlib/LAPACKE/src/lapacke_cgemqrt.c index 5f539f307..c0631af44 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cgemqrt.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cgemqrt.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function cgemqrt * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -40,6 +40,7 @@ lapack_int LAPACKE_cgemqrt( int matrix_layout, char side, char trans, lapack_int ldt, lapack_complex_float* c, lapack_int ldc ) { + lapack_int nrows_v; lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -48,13 +49,15 @@ lapack_int LAPACKE_cgemqrt( int matrix_layout, char side, char trans, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { return -12; } - if( LAPACKE_cge_nancheck( matrix_layout, ldt, nb, t, ldt ) ) { + if( LAPACKE_cge_nancheck( matrix_layout, nb, k, t, ldt ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { return -8; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgesvdx.c b/lapack-netlib/LAPACKE/src/lapacke_cgesvdx.c index 56ee57f5b..6882a8b8f 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cgesvdx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cgesvdx.c @@ -28,15 +28,15 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function cgesvdx * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_cgesvdx( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, lapack_complex_float* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, lapack_complex_float* u, lapack_int ldu, lapack_complex_float* vt, lapack_int ldvt, lapack_int* superb ) @@ -44,9 +44,9 @@ lapack_int LAPACKE_cgesvdx( int matrix_layout, char jobu, char jobvt, char range lapack_int info = 0; lapack_int lwork = -1; lapack_complex_float* work = NULL; - lapack_complex_float work_query; + lapack_complex_float work_query; float* rwork = NULL; - lapack_int lrwork = MIN(m,n)*(MIN(m,n)*2+15*MIN(m,n)); + lapack_int lrwork = MAX(1, MIN(m,n)*(MIN(m,n)*2+15*MIN(m,n))); lapack_int* iwork = NULL; lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -68,18 +68,18 @@ lapack_int LAPACKE_cgesvdx( int matrix_layout, char jobu, char jobvt, char range } lwork = LAPACK_C2INT (work_query); /* Allocate memory for work arrays */ - rwork = (float*)LAPACKE_malloc( sizeof(float) * lwork ); - if( work == NULL ) { - info = LAPACK_WORK_MEMORY_ERROR; - goto exit_level_0; - } work = (lapack_complex_float*) - LAPACKE_malloc( sizeof(lapack_complex_float) * lrwork ); + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } - iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * (12*MIN(m,n)) ); + rwork = (float*)LAPACKE_malloc( sizeof(float) * lrwork ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,(12*MIN(m,n))) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_2; diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgesvdx_work.c b/lapack-netlib/LAPACKE/src/lapacke_cgesvdx_work.c index 614cdaef0..f9b4a966e 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cgesvdx_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cgesvdx_work.c @@ -28,15 +28,15 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function cgesvdx * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_cgesvdx_work( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, lapack_complex_float* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, lapack_complex_float* u, lapack_int ldu, lapack_complex_float* vt, lapack_int ldvt, lapack_complex_float* work, lapack_int lwork, @@ -46,21 +46,23 @@ lapack_int LAPACKE_cgesvdx_work( int matrix_layout, char jobu, char jobvt, char if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_cgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda, &vl, &vu, - &il, &iu, &ns, s, u, &ldu, vt, &ldvt, + &il, &iu, ns, s, u, &ldu, vt, &ldvt, work, &lwork, rwork, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || - LAPACKE_lsame( jobu, 's' ) ) ? m : 1; - lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : - ( LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1); - lapack_int nrows_vt = LAPACKE_lsame( jobvt, 'a' ) ? n : - ( LAPACKE_lsame( jobvt, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_u = LAPACKE_lsame( jobu, 'v' ) ? m : 0; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'v' ) ? + ( LAPACKE_lsame( range, 'i' ) ? MAX(iu - il + 1, 0) : MIN(m,n)) : 0; + lapack_int nrows_vt = LAPACKE_lsame( jobvt, 'v' ) ? + ( LAPACKE_lsame( range, 'i' ) ? MAX(iu - il + 1, 0) : MIN(m,n)) : 0; + lapack_int ncols_vt = LAPACKE_lsame( jobvt, 'v' ) ? n : 0; + lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nrows_u); lapack_int ldvt_t = MAX(1,nrows_vt); + lapack_complex_float* a_t = NULL; lapack_complex_float* u_t = NULL; lapack_complex_float* vt_t = NULL; @@ -75,7 +77,7 @@ lapack_int LAPACKE_cgesvdx_work( int matrix_layout, char jobu, char jobvt, char LAPACKE_xerbla( "LAPACKE_cgesvdx_work", info ); return info; } - if( ldvt < n ) { + if( ldvt < ncols_vt ) { info = -18; LAPACKE_xerbla( "LAPACKE_cgesvdx_work", info ); return info; @@ -83,7 +85,7 @@ lapack_int LAPACKE_cgesvdx_work( int matrix_layout, char jobu, char jobvt, char /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_cgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu, - &il, &iu, &ns, s, u, &ldu_t, vt, + &il, &iu, ns, s, u, &ldu_t, vt, &ldvt_t, work, &lwork, rwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -94,7 +96,7 @@ lapack_int LAPACKE_cgesvdx_work( int matrix_layout, char jobu, char jobvt, char info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { u_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { @@ -102,7 +104,7 @@ lapack_int LAPACKE_cgesvdx_work( int matrix_layout, char jobu, char jobvt, char goto exit_level_1; } } - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { vt_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvt_t * MAX(1,n) ); if( vt_t == NULL ) { @@ -113,28 +115,28 @@ lapack_int LAPACKE_cgesvdx_work( int matrix_layout, char jobu, char jobvt, char /* Transpose input matrices */ LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_cgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu, - &il, &iu, &ns, s, u, &ldu_t, vt, + LAPACK_cgesvdx( &jobu, &jobvt, &range, &m, &n, a_t, &lda_t, &vl, &vu, + &il, &iu, ns, s, u_t, &ldu_t, vt_t, &ldvt_t, work, &lwork, rwork, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, u, ldu ); } - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { LAPACKE_free( vt_t ); } exit_level_2: - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { LAPACKE_free( u_t ); } exit_level_1: diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgesvj.c b/lapack-netlib/LAPACKE/src/lapacke_cgesvj.c index 2f968af8b..9d3b81e45 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cgesvj.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cgesvj.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function cgesvj * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -52,8 +52,8 @@ lapack_int LAPACKE_cgesvj( int matrix_layout, char joba, char jobu, char jobv, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n : - ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1); + nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) : + ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0); if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { return -7; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgesvj_work.c b/lapack-netlib/LAPACKE/src/lapacke_cgesvj_work.c index d2f24d0c0..914813a9c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cgesvj_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cgesvj_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function cgesvj * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -50,8 +50,8 @@ lapack_int LAPACKE_cgesvj_work( int matrix_layout, char joba, char jobu, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n : - ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1); + lapack_int nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) : + ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0); lapack_int lda_t = MAX(1,m); lapack_int ldv_t = MAX(1,nrows_v); lapack_complex_float* a_t = NULL; diff --git a/lapack-netlib/LAPACKE/src/lapacke_cggsvd3_work.c b/lapack-netlib/LAPACKE/src/lapacke_cggsvd3_work.c index 652e8b72c..8144b8712 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cggsvd3_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cggsvd3_work.c @@ -93,9 +93,9 @@ lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { - LAPACK_cggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, - &lda_t, b_t, &ldb_t, alpha, beta, u_t, &ldu_t, - v_t, &ldv_t, q_t, &ldq_t, work, &lwork, rwork, + LAPACK_cggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, + &lda_t, b, &ldb_t, alpha, beta, u, &ldu_t, + v, &ldv_t, q, &ldq_t, work, &lwork, rwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_cggsvp3_work.c b/lapack-netlib/LAPACKE/src/lapacke_cggsvp3_work.c index d532391cc..23fb4b3cf 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cggsvp3_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cggsvp3_work.c @@ -87,16 +87,16 @@ lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); return info; } - if( ldv < m ) { + if( ldv < p ) { info = -19; LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { - LAPACK_cggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, - &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, &ldv_t, - q_t, &ldq_t, iwork, rwork, tau, work, &lwork, &info ); + LAPACK_cggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a, &lda_t, b, + &ldb_t, &tola, &tolb, k, l, u, &ldu_t, v, &ldv_t, + q, &ldq_t, iwork, rwork, tau, work, &lwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ @@ -124,7 +124,7 @@ lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, if( LAPACKE_lsame( jobv, 'v' ) ) { v_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * - ldv_t * MAX(1,m) ); + ldv_t * MAX(1,p) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; @@ -156,7 +156,7 @@ lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, m, v_t, ldv_t, v, ldv ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); } if( LAPACKE_lsame( jobq, 'q' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_chbtrd.c b/lapack-netlib/LAPACKE/src/lapacke_chbtrd.c index 83aa5df10..351382eda 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_chbtrd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_chbtrd.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function chbtrd * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -49,7 +49,7 @@ lapack_int LAPACKE_chbtrd( int matrix_layout, char vect, char uplo, lapack_int n if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( LAPACKE_lsame( vect, 'u' ) ) { if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) { return -10; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_cheswapr.c b/lapack-netlib/LAPACKE/src/lapacke_cheswapr.c index 7963eb370..de512fda5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cheswapr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cheswapr.c @@ -28,14 +28,14 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function cheswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_cheswapr( int matrix_layout, char uplo, lapack_int n, - lapack_complex_float* a, lapack_int i1, - lapack_int i2 ) + lapack_complex_float* a, lapack_int lda, + lapack_int i1, lapack_int i2 ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_cheswapr", -1 ); @@ -43,9 +43,9 @@ lapack_int LAPACKE_cheswapr( int matrix_layout, char uplo, lapack_int n, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, n ) ) { + if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -4; } #endif - return LAPACKE_cheswapr_work( matrix_layout, uplo, n, a, i1, i2 ); + return LAPACKE_cheswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/lapack-netlib/LAPACKE/src/lapacke_cheswapr_work.c b/lapack-netlib/LAPACKE/src/lapacke_cheswapr_work.c index e41b3a2c7..fe14cac5d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cheswapr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cheswapr_work.c @@ -28,38 +28,39 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function cheswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_cheswapr_work( int matrix_layout, char uplo, lapack_int n, - lapack_complex_float* a, lapack_int i1, - lapack_int i2 ) + lapack_complex_float* a, lapack_int lda, + lapack_int i1, lapack_int i2 ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_cheswapr( &uplo, &n, a, &i1, &i2 ); + LAPACK_cheswapr( &uplo, &n, a, &lda, &i1, &i2 ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); lapack_complex_float* a_t = NULL; /* Allocate memory for temporary array(s) */ a_t = (lapack_complex_float*) - LAPACKE_malloc( sizeof(lapack_complex_float) * n * MAX(1,n) ); + LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, n, a_t, n ); + LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_cheswapr( &uplo, &n, a_t, &i1, &i2 ); + LAPACK_cheswapr( &uplo, &n, a_t, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, n, a, n ); + LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_chetri2x.c b/lapack-netlib/LAPACKE/src/lapacke_chetri2x.c index 1d97571b6..23957f1fe 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_chetri2x.c +++ b/lapack-netlib/LAPACKE/src/lapacke_chetri2x.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function chetri2x * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -45,7 +45,7 @@ lapack_int LAPACKE_chetri2x( int matrix_layout, char uplo, lapack_int n, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, lda, n, a, lda ) ) { + if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { return -4; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_clantr.c b/lapack-netlib/LAPACKE/src/lapacke_clantr.c index 33e6e57ff..5a38fb0d7 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_clantr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_clantr.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function clantr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_clascl.c b/lapack-netlib/LAPACKE/src/lapacke_clascl.c index c21ec3e06..d393eb5e7 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_clascl.c +++ b/lapack-netlib/LAPACKE/src/lapacke_clascl.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function slaswp * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -46,50 +46,64 @@ lapack_int LAPACKE_clascl( int matrix_layout, char type, lapack_int kl, /* Optionally check input matrices for NaNs */ switch (type) { case 'G': - if( LAPACKE_cge_nancheck( matrix_layout, lda, n, a, lda ) ) { - return -9; - } + if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -9; + } break; case 'L': - // TYPE = 'L' - lower triangular matrix. - if( LAPACKE_ctr_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) { - return -9; - } + // TYPE = 'L' - lower triangle of general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_cgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) { + return -9; + } break; case 'U': - // TYPE = 'U' - upper triangular matrix - if( LAPACKE_ctr_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) { - return -9; - } + // TYPE = 'U' - upper triangle of general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_cgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) { + return -9; + } break; case 'H': - // TYPE = 'H' - upper Hessenberg matrix - if( LAPACKE_chs_nancheck( matrix_layout, n, a, lda ) ) { - return -9; - } - break; + // TYPE = 'H' - part of upper Hessenberg matrix in general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_cgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) { + return -9; + } case 'B': - // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL - // and upper bandwidth KU and with the only the lower - // half stored. - if( LAPACKE_chb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { - return -9; - } - break; - case 'Q': - // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL - // and upper bandwidth KU and with the only the upper - // half stored. - if( LAPACKE_chb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { - return -9; - } + // TYPE = 'B' - lower part of symmetric band matrix (assume m==n) + if( LAPACKE_chb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { + return -9; + } + break; + case 'Q': + // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n) + if( LAPACKE_chb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { + return -9; + } break; case 'Z': - // TYPE = 'Z' - A is a band matrix with lower bandwidth KL and upper - // bandwidth KU. See DGBTRF for storage details. - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) { - return -6; - } + // TYPE = 'Z' - band matrix laid out for ?GBTRF + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) { + return -9; + } break; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_clascl_work.c b/lapack-netlib/LAPACKE/src/lapacke_clascl_work.c index 18ac1efaf..5945c5c1c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_clascl_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_clascl_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function slaswp * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -46,7 +46,10 @@ lapack_int LAPACKE_clascl_work( int matrix_layout, char type, lapack_int kl, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int lda_t = MAX(1,lda); + lapack_int nrows_a = LAPACKE_lsame(type, 'b') ? kl + 1 : + LAPACKE_lsame(type, 'q') ? ku + 1 : + LAPACKE_lsame(type, 'z') ? 2 * kl + ku + 1 : m; + lapack_int lda_t = MAX(1,nrows_a); lapack_complex_float* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { @@ -62,12 +65,14 @@ lapack_int LAPACKE_clascl_work( int matrix_layout, char type, lapack_int kl, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + LAPACKE_cge_trans( matrix_layout, nrows_a, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_clascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info); - info = 0; /* LAPACK call is ok! */ + if( info < 0 ) { + info = info - 1; + } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_cstedc.c b/lapack-netlib/LAPACKE/src/lapacke_cstedc.c index ff8f996f2..22c4a354e 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cstedc.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cstedc.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function cstedc * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -58,7 +58,7 @@ lapack_int LAPACKE_cstedc( int matrix_layout, char compz, lapack_int n, float* d if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( LAPACKE_lsame( compz, 'v' ) ) { if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { return -6; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_csteqr.c b/lapack-netlib/LAPACKE/src/lapacke_csteqr.c index 8ea3b7ca9..57249e7de 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_csteqr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_csteqr.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function csteqr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -52,7 +52,7 @@ lapack_int LAPACKE_csteqr( int matrix_layout, char compz, lapack_int n, float* d if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( LAPACKE_lsame( compz, 'v' ) ) { if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { return -6; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_csyconv.c b/lapack-netlib/LAPACKE/src/lapacke_csyconv.c index 47633a263..da6027865 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_csyconv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_csyconv.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function csyconv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -36,7 +36,7 @@ lapack_int LAPACKE_csyconv( int matrix_layout, char uplo, char way, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, - lapack_complex_float* work ) + lapack_complex_float* e ) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -45,13 +45,13 @@ lapack_int LAPACKE_csyconv( int matrix_layout, char uplo, char way, lapack_int n } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, lda, n, a, lda ) ) { + if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { return -5; } #endif /* Call middle-level interface */ info = LAPACKE_csyconv_work( matrix_layout, uplo, way, n, a, lda, ipiv, - work ); + e ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_csyconv", info ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_csyconv_work.c b/lapack-netlib/LAPACKE/src/lapacke_csyconv_work.c index 19e9abbd1..80a85179b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_csyconv_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_csyconv_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function csyconv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -36,12 +36,12 @@ lapack_int LAPACKE_csyconv_work( int matrix_layout, char uplo, char way, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, - lapack_complex_float* work ) + lapack_complex_float* e ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_csyconv( &uplo, &way, &n, a, &lda, ipiv, work, &info ); + LAPACK_csyconv( &uplo, &way, &n, a, &lda, ipiv, e, &info ); if( info < 0 ) { info = info - 1; } @@ -64,7 +64,7 @@ lapack_int LAPACKE_csyconv_work( int matrix_layout, char uplo, char way, /* Transpose input matrices */ LAPACKE_cge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_csyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, work, &info ); + LAPACK_csyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, e, &info ); if( info < 0 ) { info = info - 1; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_csyswapr.c b/lapack-netlib/LAPACKE/src/lapacke_csyswapr.c index bb6992b0e..78577aada 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_csyswapr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_csyswapr.c @@ -28,14 +28,14 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function csyswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_csyswapr( int matrix_layout, char uplo, lapack_int n, - lapack_complex_float* a, lapack_int i1, - lapack_int i2 ) + lapack_complex_float* a, lapack_int lda, + lapack_int i1, lapack_int i2 ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_csyswapr", -1 ); @@ -43,9 +43,9 @@ lapack_int LAPACKE_csyswapr( int matrix_layout, char uplo, lapack_int n, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, n ) ) { + if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -4; } #endif - return LAPACKE_csyswapr_work( matrix_layout, uplo, n, a, i1, i2 ); + return LAPACKE_csyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/lapack-netlib/LAPACKE/src/lapacke_csyswapr_work.c b/lapack-netlib/LAPACKE/src/lapacke_csyswapr_work.c index ff8507bb2..ed215531b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_csyswapr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_csyswapr_work.c @@ -28,38 +28,39 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function csyswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_csyswapr_work( int matrix_layout, char uplo, lapack_int n, - lapack_complex_float* a, lapack_int i1, - lapack_int i2 ) + lapack_complex_float* a, lapack_int lda, + lapack_int i1, lapack_int i2 ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_csyswapr( &uplo, &n, a, &i1, &i2 ); + LAPACK_csyswapr( &uplo, &n, a, &lda, &i1, &i2 ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); lapack_complex_float* a_t = NULL; /* Allocate memory for temporary array(s) */ a_t = (lapack_complex_float*) - LAPACKE_malloc( sizeof(lapack_complex_float) * n * MAX(1,n) ); + LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, n, a_t, n ); + LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_csyswapr( &uplo, &n, a_t, &i1, &i2 ); + LAPACK_csyswapr( &uplo, &n, a_t, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, n, a, n ); + LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_ctpmqrt.c b/lapack-netlib/LAPACKE/src/lapacke_ctpmqrt.c index bcb92a819..96db86be1 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ctpmqrt.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ctpmqrt.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function ctpmqrt * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -41,6 +41,8 @@ lapack_int LAPACKE_ctpmqrt( int matrix_layout, char side, char trans, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { + lapack_int ncols_a, nrows_a; + lapack_int nrows_v; lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -49,16 +51,22 @@ lapack_int LAPACKE_ctpmqrt( int matrix_layout, char side, char trans, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) { + ncols_a = LAPACKE_lsame( side, 'L' ) ? n : + ( LAPACKE_lsame( side, 'R' ) ? k : 0 ); + nrows_a = LAPACKE_lsame( side, 'L' ) ? k : + ( LAPACKE_lsame( side, 'R' ) ? m : 0 ); + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + if( LAPACKE_cge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) { return -13; } if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { return -15; } - if( LAPACKE_cge_nancheck( matrix_layout, ldt, nb, t, ldt ) ) { + if( LAPACKE_cge_nancheck( matrix_layout, nb, k, t, ldt ) ) { return -11; } - if( LAPACKE_cge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { return -9; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_ctprfb.c b/lapack-netlib/LAPACKE/src/lapacke_ctprfb.c index a007f924c..d2e841060 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ctprfb.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ctprfb.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function ctprfb * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -41,6 +41,7 @@ lapack_int LAPACKE_ctprfb( int matrix_layout, char side, char trans, char direct lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { + lapack_int ncols_v, nrows_v; lapack_int info = 0; lapack_int ldwork; lapack_int work_size; @@ -51,16 +52,28 @@ lapack_int LAPACKE_ctprfb( int matrix_layout, char side, char trans, char direct } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ + if( LAPACKE_lsame( storev, 'C' ) ) { + ncols_v = k; + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + } else if( LAPACKE_lsame( storev, 'R' ) ) { + ncols_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + nrows_v = k; + } else { + ncols_v = 0; + nrows_v = 0; + } if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) { return -14; } if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { return -16; } - if( LAPACKE_cge_nancheck( matrix_layout, ldt, k, t, ldt ) ) { + if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) { return -12; } - if( LAPACKE_cge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -10; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_cuncsd2by1.c b/lapack-netlib/LAPACKE/src/lapacke_cuncsd2by1.c index 582ec7332..4b9cf7fe1 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cuncsd2by1.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cuncsd2by1.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function cuncsd2by1 * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -37,7 +37,7 @@ lapack_int LAPACKE_cuncsd2by1( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, lapack_complex_float* x11, lapack_int ldx11, lapack_complex_float* x21, lapack_int ldx21, - lapack_complex_float* theta, lapack_complex_float* u1, + float* theta, lapack_complex_float* u1, lapack_int ldu1, lapack_complex_float* u2, lapack_int ldu2, lapack_complex_float* v1t, lapack_int ldv1t ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_cuncsd2by1_work.c b/lapack-netlib/LAPACKE/src/lapacke_cuncsd2by1_work.c index 658467378..4ab11b189 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cuncsd2by1_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cuncsd2by1_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function cuncsd2by1 * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -37,7 +37,7 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, lapack_complex_float* x11, lapack_int ldx11, lapack_complex_float* x21, lapack_int ldx21, - lapack_complex_float* theta, lapack_complex_float* u1, + float* theta, lapack_complex_float* u1, lapack_int ldu1, lapack_complex_float* u2, lapack_int ldu2, lapack_complex_float* v1t, lapack_int ldv1t, lapack_complex_float* work, @@ -99,8 +99,8 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, /* Query optimal working array(s) size if requested */ if( lrwork == -1 || lwork == -1 ) { LAPACK_cuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, - &q, x11, &ldx11, x21, &ldx21, - theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + &q, x11, &ldx11_t, x21, &ldx21_t, + theta, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t, work, &lwork, rwork, &lrwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -146,8 +146,8 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, ldx21_t ); /* Call LAPACK function and adjust info */ LAPACK_cuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, - &q, x11, &ldx11, x21, &ldx21, - theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + &q, x11_t, &ldx11_t, x21_t, &ldx21_t, + theta, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t, &ldv1t_t, work, &lwork, rwork, &lrwork, iwork, &info ); if( info < 0 ) { info = info - 1; diff --git a/lapack-netlib/LAPACKE/src/lapacke_cunmbr_work.c b/lapack-netlib/LAPACKE/src/lapacke_cunmbr_work.c index c42f6e49e..0da3b2a82 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cunmbr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cunmbr_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function cunmbr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -73,9 +73,11 @@ lapack_int LAPACKE_cunmbr_work( int matrix_layout, char vect, char side, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - a_t = (lapack_complex_float*) - LAPACKE_malloc( sizeof(lapack_complex_float) * - lda_t * MAX(1,MIN(nq,k)) ); + if( LAPACKE_lsame( vect, 'q' ) ) { + a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,k) ); + } else { + a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,nq) ); + } if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_cunmlq_work.c b/lapack-netlib/LAPACKE/src/lapacke_cunmlq_work.c index 1804b2b68..b0bac9d40 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cunmlq_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cunmlq_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function cunmlq * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -42,6 +42,9 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans, { lapack_int info = 0; lapack_int r; + lapack_int lda_t, ldc_t; + lapack_complex_float* a_t = NULL; + lapack_complex_float* c_t = NULL; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_cunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, @@ -51,10 +54,8 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans, } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { r = LAPACKE_lsame( side, 'l' ) ? m : n; - lapack_int lda_t = MAX(1,k); - lapack_int ldc_t = MAX(1,m); - lapack_complex_float* a_t = NULL; - lapack_complex_float* c_t = NULL; + lda_t = MAX(1,k); + ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -8; @@ -73,8 +74,13 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - a_t = (lapack_complex_float*) - LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,m) ); + if( LAPACKE_lsame( side, 'l' ) ) { + a_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,m) ); + } else { + a_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); + } if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_dbdsvdx.c b/lapack-netlib/LAPACKE/src/lapacke_dbdsvdx.c index d116f0dbf..f61e11c41 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dbdsvdx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dbdsvdx.c @@ -28,20 +28,20 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dbdsvdx * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_dbdsvdx( int matrix_layout, char uplo, char jobz, char range, lapack_int n, double* d, double* e, - lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, double* z, lapack_int ldz, lapack_int* superb ) { lapack_int info = 0; - lapack_int lwork = 14*n; + lapack_int lwork = MAX(14*n,1); double* work = NULL; lapack_int* iwork = NULL; lapack_int i; @@ -54,7 +54,7 @@ lapack_int LAPACKE_dbdsvdx( int matrix_layout, char uplo, char jobz, char range, if( LAPACKE_d_nancheck( n, d, 1 ) ) { return -6; } - if( LAPACKE_d_nancheck( n, e, 1 ) ) { + if( LAPACKE_d_nancheck( n - 1, e, 1 ) ) { return -7; } #endif @@ -64,14 +64,14 @@ lapack_int LAPACKE_dbdsvdx( int matrix_layout, char uplo, char jobz, char range, info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } - iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * (12*n) ); + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(12*n,1) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Call middle-level interface */ info = LAPACKE_dbdsvdx_work( matrix_layout, uplo, jobz, range, - n, d, e, vl, vu, il, iu, ns, s, z, + n, d, e, vl, vu, il, iu, ns, s, z, ldz, work, iwork); /* Backup significant data from working array(s) */ for( i=0; i<12*n-1; i++ ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_dbdsvdx_work.c b/lapack-netlib/LAPACKE/src/lapacke_dbdsvdx_work.c index 255d8f711..29217a827 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dbdsvdx_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dbdsvdx_work.c @@ -28,15 +28,15 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dbdsvdx * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_dbdsvdx_work( int matrix_layout, char uplo, char jobz, char range, lapack_int n, double* d, double* e, - lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, double* z, lapack_int ldz, double* work, lapack_int* iwork ) { @@ -44,25 +44,27 @@ lapack_int LAPACKE_dbdsvdx_work( int matrix_layout, char uplo, char jobz, char r if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dbdsvdx( &uplo, &jobz, &range, &n, d, e, &vl, &vu, - &il, &iu, &ns, s, z, &ldz, + &il, &iu, ns, s, z, &ldz, work, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_z = ( LAPACKE_lsame( jobz, 'v' ) ) ? MAX(2, 2*n) : 1; + lapack_int nrows_z = ( LAPACKE_lsame( jobz, 'v' ) ) ? 2*n : 0; + lapack_int ncols_z = ( LAPACKE_lsame( jobz, 'v' ) ) ? + ( LAPACKE_lsame( range, 'i' ) ? MAX(0,iu - il + 1) : n + 1 ) : 0; lapack_int ldz_t = MAX(1,nrows_z); double* z_t = NULL; /* Check leading dimension(s) */ - if( ldz < nrows_z ) { + if( ldz < ncols_z ) { info = -3; LAPACKE_xerbla( "LAPACKE_dbdsvdx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'n' ) ) { + if( LAPACKE_lsame( jobz, 'v' ) ) { z_t = (double*) - LAPACKE_malloc( sizeof(double) * ldz_t * 2*n ); + LAPACKE_malloc( sizeof(double) * ldz_t * MAX(2*n,1) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; @@ -70,17 +72,17 @@ lapack_int LAPACKE_dbdsvdx_work( int matrix_layout, char uplo, char jobz, char r } /* Call LAPACK function and adjust info */ LAPACK_dbdsvdx( &uplo, &jobz, &range, &n, d, e, &vl, &vu, - &il, &iu, &ns, s, z_t, &ldz_t, work, + &il, &iu, ns, s, z_t, &ldz_t, work, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'n' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_z, nrows_z, z_t, ldz_t, z, ldz); + if( LAPACKE_lsame( jobz, 'v' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_z, ncols_z, z_t, ldz_t, z, ldz); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'n' ) ) { + if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgejsv.c b/lapack-netlib/LAPACKE/src/lapacke_dgejsv.c index 093afee97..85416056e 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgejsv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgejsv.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dgejsv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -70,7 +70,7 @@ lapack_int LAPACKE_dgejsv( int matrix_layout, char joba, char jobu, char jobv, ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && LAPACKE_lsame( jobv, 'j' ) ? MAX(7,m+3*n+n*n) : - 1) ) ) ) ) ); + 7) ) ) ) ) ); lapack_int* iwork = NULL; double* work = NULL; lapack_int i; @@ -86,25 +86,25 @@ lapack_int LAPACKE_dgejsv( int matrix_layout, char joba, char jobu, char jobv, if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, nu, n, u, ldu ) ) { - return -13; - } - } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, nv, n, v, ldv ) ) { - return -15; - } - } #endif /* Allocate memory for working array(s) */ - iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m+3*n) ); + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(3,m+3*n) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } + lwork = MAX3( lwork, 7, 2*m+n ); + { /* FIXUP LWORK */ + int want_u = LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ); + int want_v = LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ); + int want_sce = LAPACKE_lsame( joba, 'e' ) || LAPACKE_lsame( joba, 'g' ); + if( !want_u && !want_v && !want_sce ) lwork = MAX( lwork, 4*n+1 ); // 1.1 + if( !want_u && !want_v && want_sce ) lwork = MAX( lwork, n*n+4*n ); // 1.2 + if( !want_u && want_v ) lwork = MAX( lwork, 4*n+1 ); // 2 + if( want_u && !want_v ) lwork = MAX( lwork, 4*n+1 ); // 3 + if( want_u && LAPACKE_lsame( jobv, 'v' ) ) lwork = MAX( lwork, 6*n+2*n*n ); // 4.1 + if( want_u && LAPACKE_lsame( jobv, 'j' ) ) lwork = MAX3( lwork, 4*n+n*n, 2*n+n*n+6 ); // 4.2 + } work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgejsv_work.c b/lapack-netlib/LAPACKE/src/lapacke_dgejsv_work.c index 379e63d2d..fba9a374d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgejsv_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgejsv_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dgejsv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -53,6 +53,8 @@ lapack_int LAPACKE_dgejsv_work( int matrix_layout, char joba, char jobu, } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m; lapack_int nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'n' ) ? 1 : + LAPACKE_lsame( jobu, 'f' ) ? m : n; lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nu); lapack_int ldv_t = MAX(1,nv); @@ -65,7 +67,7 @@ lapack_int LAPACKE_dgejsv_work( int matrix_layout, char joba, char jobu, LAPACKE_xerbla( "LAPACKE_dgejsv_work", info ); return info; } - if( ldu < n ) { + if( ldu < ncols_u ) { info = -14; LAPACKE_xerbla( "LAPACKE_dgejsv_work", info ); return info; @@ -83,7 +85,7 @@ lapack_int LAPACKE_dgejsv_work( int matrix_layout, char joba, char jobu, } if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'w' ) ) { - u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,n) ); + u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; @@ -99,14 +101,6 @@ lapack_int LAPACKE_dgejsv_work( int matrix_layout, char joba, char jobu, } /* Transpose input matrices */ LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_dge_trans( matrix_layout, nu, n, u, ldu, u_t, ldu_t ); - } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { - LAPACKE_dge_trans( matrix_layout, nv, n, v, ldv, v_t, ldv_t ); - } /* Call LAPACK function and adjust info */ LAPACK_dgejsv( &joba, &jobu, &jobv, &jobr, &jobt, &jobp, &m, &n, a_t, &lda_t, sva, u_t, &ldu_t, v_t, &ldv_t, work, &lwork, @@ -117,7 +111,7 @@ lapack_int LAPACKE_dgejsv_work( int matrix_layout, char joba, char jobu, /* Transpose output matrices */ if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nu, n, u_t, ldu_t, u, ldu ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, nu, ncols_u, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'w' ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgemqrt.c b/lapack-netlib/LAPACKE/src/lapacke_dgemqrt.c index 68cc6debc..3fb17f0bf 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgemqrt.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgemqrt.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function dgemqrt * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -39,6 +39,7 @@ lapack_int LAPACKE_dgemqrt( int matrix_layout, char side, char trans, const double* t, lapack_int ldt, double* c, lapack_int ldc ) { + lapack_int nrows_v; lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -47,13 +48,15 @@ lapack_int LAPACKE_dgemqrt( int matrix_layout, char side, char trans, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { return -12; } - if( LAPACKE_dge_nancheck( matrix_layout, ldt, nb, t, ldt ) ) { + if( LAPACKE_dge_nancheck( matrix_layout, nb, k, t, ldt ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { return -8; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgesvdx.c b/lapack-netlib/LAPACKE/src/lapacke_dgesvdx.c index ec487cea0..ca82202df 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgesvdx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgesvdx.c @@ -28,15 +28,15 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dgesvdx * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_dgesvdx( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, double* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, double* u, lapack_int ldu, double* vt, lapack_int ldvt, lapack_int* superb ) @@ -71,7 +71,7 @@ lapack_int LAPACKE_dgesvdx( int matrix_layout, char jobu, char jobvt, char range info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } - iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * (12*MIN(m,n)) ); + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,(12*MIN(m,n))) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgesvdx_work.c b/lapack-netlib/LAPACKE/src/lapacke_dgesvdx_work.c index b334486f5..893cce0a7 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgesvdx_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgesvdx_work.c @@ -28,15 +28,15 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dgesvdx * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_dgesvdx_work( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, double* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, double* u, lapack_int ldu, double* vt, lapack_int ldvt, double* work, lapack_int lwork, lapack_int* iwork ) @@ -45,21 +45,23 @@ lapack_int LAPACKE_dgesvdx_work( int matrix_layout, char jobu, char jobvt, char if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda, &vl, &vu, - &il, &iu, &ns, s, u, &ldu, vt, &ldvt, + &il, &iu, ns, s, u, &ldu, vt, &ldvt, work, &lwork, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || - LAPACKE_lsame( jobu, 's' ) ) ? m : 1; - lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : - ( LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1); - lapack_int nrows_vt = LAPACKE_lsame( jobvt, 'a' ) ? n : - ( LAPACKE_lsame( jobvt, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_u = LAPACKE_lsame( jobu, 'v' ) ? m : 0; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'v' ) ? + ( LAPACKE_lsame( range, 'i' ) ? MAX(iu - il + 1, 0) : MIN(m,n)) : 0; + lapack_int nrows_vt = LAPACKE_lsame( jobvt, 'v' ) ? + ( LAPACKE_lsame( range, 'i' ) ? MAX(iu - il + 1, 0) : MIN(m,n)) : 0; + lapack_int ncols_vt = LAPACKE_lsame( jobvt, 'v' ) ? n : 0; + lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nrows_u); lapack_int ldvt_t = MAX(1,nrows_vt); + double* a_t = NULL; double* u_t = NULL; double* vt_t = NULL; @@ -74,7 +76,7 @@ lapack_int LAPACKE_dgesvdx_work( int matrix_layout, char jobu, char jobvt, char LAPACKE_xerbla( "LAPACKE_dgesvdx_work", info ); return info; } - if( ldvt < n ) { + if( ldvt < ncols_vt ) { info = -18; LAPACKE_xerbla( "LAPACKE_dgesvdx_work", info ); return info; @@ -82,7 +84,7 @@ lapack_int LAPACKE_dgesvdx_work( int matrix_layout, char jobu, char jobvt, char /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_dgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu, - &il, &iu, &ns, s, u, &ldu_t, vt, + &il, &iu, ns, s, u, &ldu_t, vt, &ldvt_t, work, &lwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -92,7 +94,7 @@ lapack_int LAPACKE_dgesvdx_work( int matrix_layout, char jobu, char jobvt, char info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { u_t = (double*) LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { @@ -100,7 +102,7 @@ lapack_int LAPACKE_dgesvdx_work( int matrix_layout, char jobu, char jobvt, char goto exit_level_1; } } - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { vt_t = (double*) LAPACKE_malloc( sizeof(double) * ldvt_t * MAX(1,n) ); if( vt_t == NULL ) { @@ -111,28 +113,28 @@ lapack_int LAPACKE_dgesvdx_work( int matrix_layout, char jobu, char jobvt, char /* Transpose input matrices */ LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_dgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu, - &il, &iu, &ns, s, u, &ldu_t, vt, + LAPACK_dgesvdx( &jobu, &jobvt, &range, &m, &n, a_t, &lda_t, &vl, &vu, + &il, &iu, ns, s, u_t, &ldu_t, vt_t, &ldvt_t, work, &lwork, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, u, ldu ); } - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { LAPACKE_free( vt_t ); } exit_level_2: - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { LAPACKE_free( u_t ); } exit_level_1: diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgesvj.c b/lapack-netlib/LAPACKE/src/lapacke_dgesvj.c index 1ffd432e5..542e52f79 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgesvj.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgesvj.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dgesvj * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -49,8 +49,8 @@ lapack_int LAPACKE_dgesvj( int matrix_layout, char joba, char jobu, char jobv, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n : - ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1); + nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) : + ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0); if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { return -7; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgesvj_work.c b/lapack-netlib/LAPACKE/src/lapacke_dgesvj_work.c index f2b1b9cd5..200b346cf 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgesvj_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgesvj_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dgesvj * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -48,8 +48,8 @@ lapack_int LAPACKE_dgesvj_work( int matrix_layout, char joba, char jobu, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n : - ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1); + lapack_int nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) : + ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0); lapack_int lda_t = MAX(1,m); lapack_int ldv_t = MAX(1,nrows_v); double* a_t = NULL; diff --git a/lapack-netlib/LAPACKE/src/lapacke_dggsvd3_work.c b/lapack-netlib/LAPACKE/src/lapacke_dggsvd3_work.c index dcc6bc81a..228a5b72f 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dggsvd3_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dggsvd3_work.c @@ -91,9 +91,9 @@ lapack_int LAPACKE_dggsvd3_work( int matrix_layout, char jobu, char jobv, } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { - LAPACK_dggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, - b_t, &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, - q_t, &ldq_t, work, &lwork, iwork, &info ); + LAPACK_dggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda_t, + b, &ldb_t, alpha, beta, u, &ldu_t, v, &ldv_t, + q, &ldq_t, work, &lwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_dggsvp3_work.c b/lapack-netlib/LAPACKE/src/lapacke_dggsvp3_work.c index e80a75576..d044df1e1 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dggsvp3_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dggsvp3_work.c @@ -84,15 +84,15 @@ lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); return info; } - if( ldv < m ) { + if( ldv < p ) { info = -19; LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); return info; } if( lwork == -1 ) { - LAPACK_dggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, - &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, - &ldv_t, q_t, &ldq_t, iwork, tau, work, &lwork, + LAPACK_dggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a, &lda_t, b, + &ldb_t, &tola, &tolb, k, l, u, &ldu_t, v, + &ldv_t, q, &ldq_t, iwork, tau, work, &lwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -115,7 +115,7 @@ lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, } } if( LAPACKE_lsame( jobv, 'v' ) ) { - v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,m) ); + v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,p) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; @@ -145,7 +145,7 @@ lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, m, v_t, ldv_t, v, ldv ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); } if( LAPACKE_lsame( jobq, 'q' ) ) { LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dlantr.c b/lapack-netlib/LAPACKE/src/lapacke_dlantr.c index 8fd112084..480f31d91 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dlantr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dlantr.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dlantr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_dlantr_work.c b/lapack-netlib/LAPACKE/src/lapacke_dlantr_work.c index ee5e665ee..2d570ce42 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dlantr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dlantr_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dlantr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_dlascl.c b/lapack-netlib/LAPACKE/src/lapacke_dlascl.c index d3a2f4934..9729389f4 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dlascl.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dlascl.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dlaswp * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -46,50 +46,64 @@ lapack_int LAPACKE_dlascl( int matrix_layout, char type, lapack_int kl, /* Optionally check input matrices for NaNs */ switch (type) { case 'G': - if( LAPACKE_dge_nancheck( matrix_layout, lda, n, a, lda ) ) { - return -9; - } + if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -9; + } break; case 'L': - // TYPE = 'L' - lower triangular matrix. - if( LAPACKE_dtr_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) { - return -9; - } + // TYPE = 'L' - lower triangle of general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_dgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) { + return -9; + } break; case 'U': - // TYPE = 'U' - upper triangular matrix - if( LAPACKE_dtr_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) { - return -9; - } + // TYPE = 'U' - upper triangle of general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_dgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) { + return -9; + } break; case 'H': - // TYPE = 'H' - upper Hessenberg matrix - if( LAPACKE_dhs_nancheck( matrix_layout, n, a, lda ) ) { - return -9; - } - break; + // TYPE = 'H' - part of upper Hessenberg matrix in general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_dgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) { + return -9; + } case 'B': - // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL - // and upper bandwidth KU and with the only the lower - // half stored. - if( LAPACKE_dsb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { - return -9; - } - break; - case 'Q': - // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL - // and upper bandwidth KU and with the only the upper - // half stored. - if( LAPACKE_dsb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { - return -9; - } + // TYPE = 'B' - lower part of symmetric band matrix (assume m==n) + if( LAPACKE_dsb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { + return -9; + } + break; + case 'Q': + // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n) + if( LAPACKE_dsb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { + return -9; + } break; case 'Z': - // TYPE = 'Z' - A is a band matrix with lower bandwidth KL and upper - // bandwidth KU. See DGBTRF for storage details. - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) { - return -6; - } + // TYPE = 'Z' - band matrix laid out for ?GBTRF + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) { + return -9; + } break; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_dlascl_work.c b/lapack-netlib/LAPACKE/src/lapacke_dlascl_work.c index a98f3c874..95870dd7d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dlascl_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dlascl_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dlaswp * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -46,7 +46,10 @@ lapack_int LAPACKE_dlascl_work( int matrix_layout, char type, lapack_int kl, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int lda_t = MAX(1,lda); + lapack_int nrows_a = LAPACKE_lsame(type, 'b') ? kl + 1 : + LAPACKE_lsame(type, 'q') ? ku + 1 : + LAPACKE_lsame(type, 'z') ? 2 * kl + ku + 1 : m; + lapack_int lda_t = MAX(1,nrows_a); double* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { @@ -61,12 +64,14 @@ lapack_int LAPACKE_dlascl_work( int matrix_layout, char type, lapack_int kl, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + LAPACKE_dge_trans( matrix_layout, nrows_a, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dlascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info); - info = 0; /* LAPACK call is ok! */ + if( info < 0 ) { + info = info - 1; + } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_dorcsd2by1_work.c b/lapack-netlib/LAPACKE/src/lapacke_dorcsd2by1_work.c index 8a080fbcd..cea20f407 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dorcsd2by1_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dorcsd2by1_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dorcsd2by1 * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -97,8 +97,8 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_dorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, - &q, x11, &ldx11, x21, &ldx21, - theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + &q, x11, &ldx11_t, x21, &ldx21_t, + theta, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t, work, &lwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -144,8 +144,8 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, ldx21_t ); /* Call LAPACK function and adjust info */ LAPACK_dorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, - &q, x11, &ldx11, x21, &ldx21, - theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + &q, x11_t, &ldx11_t, x21_t, &ldx21_t, + theta, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t, &ldv1t_t, work, &lwork, iwork, &info ); if( info < 0 ) { info = info - 1; diff --git a/lapack-netlib/LAPACKE/src/lapacke_dormbr_work.c b/lapack-netlib/LAPACKE/src/lapacke_dormbr_work.c index dcd8842fa..d6d1756e1 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dormbr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dormbr_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dormbr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_dormlq_work.c b/lapack-netlib/LAPACKE/src/lapacke_dormlq_work.c index f46c6d3b1..599a8032d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dormlq_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dormlq_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dormlq * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsbtrd.c b/lapack-netlib/LAPACKE/src/lapacke_dsbtrd.c index d9fa474b2..c1c9c03c5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsbtrd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsbtrd.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dsbtrd * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -48,7 +48,7 @@ lapack_int LAPACKE_dsbtrd( int matrix_layout, char vect, char uplo, lapack_int n if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( LAPACKE_lsame( vect, 'u' ) ) { if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) { return -10; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_dstedc.c b/lapack-netlib/LAPACKE/src/lapacke_dstedc.c index 70a7346d1..a974f4563 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dstedc.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dstedc.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dstedc * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -55,7 +55,7 @@ lapack_int LAPACKE_dstedc( int matrix_layout, char compz, lapack_int n, if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( LAPACKE_lsame( compz, 'v' ) ) { if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { return -6; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsteqr.c b/lapack-netlib/LAPACKE/src/lapacke_dsteqr.c index 6476aae18..81f325e66 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsteqr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsteqr.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dsteqr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -52,7 +52,7 @@ lapack_int LAPACKE_dsteqr( int matrix_layout, char compz, lapack_int n, if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( LAPACKE_lsame( compz, 'v' ) ) { if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { return -6; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyconv.c b/lapack-netlib/LAPACKE/src/lapacke_dsyconv.c index ba937a97b..39be12ef4 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyconv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyconv.c @@ -28,13 +28,13 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dsyconv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_dsyconv( int matrix_layout, char uplo, char way, lapack_int n, - double* a, lapack_int lda, const lapack_int* ipiv, double* work ) + double* a, lapack_int lda, const lapack_int* ipiv, double* e ) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -43,14 +43,14 @@ lapack_int LAPACKE_dsyconv( int matrix_layout, char uplo, char way, lapack_int n } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, lda, n, a, lda ) ) { + if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { return -5; } #endif /* Call middle-level interface */ info = LAPACKE_dsyconv_work( matrix_layout, uplo, way, n, a, lda, ipiv, - work ); + e ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dsyconv", info ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyconv_work.c b/lapack-netlib/LAPACKE/src/lapacke_dsyconv_work.c index 3355dd32c..05e812462 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyconv_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyconv_work.c @@ -28,19 +28,19 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dsyconv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_dsyconv_work( int matrix_layout, char uplo, char way, lapack_int n, double* a, lapack_int lda, - const lapack_int* ipiv, double* work ) + const lapack_int* ipiv, double* e ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_dsyconv( &uplo, &way, &n, a, &lda, ipiv, work, &info ); + LAPACK_dsyconv( &uplo, &way, &n, a, &lda, ipiv, e, &info ); if( info < 0 ) { info = info - 1; } @@ -62,7 +62,7 @@ lapack_int LAPACKE_dsyconv_work( int matrix_layout, char uplo, char way, /* Transpose input matrices */ LAPACKE_dge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_dsyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, work, &info ); + LAPACK_dsyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, e, &info ); if( info < 0 ) { info = info - 1; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyswapr.c b/lapack-netlib/LAPACKE/src/lapacke_dsyswapr.c index 728ef0900..eed600c60 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyswapr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyswapr.c @@ -28,13 +28,13 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dsyswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_dsyswapr( int matrix_layout, char uplo, lapack_int n, - double* a, lapack_int i1, lapack_int i2 ) + double* a, lapack_int lda, lapack_int i1, lapack_int i2 ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dsyswapr", -1 ); @@ -42,9 +42,9 @@ lapack_int LAPACKE_dsyswapr( int matrix_layout, char uplo, lapack_int n, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, n ) ) { + if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -4; } #endif - return LAPACKE_dsyswapr_work( matrix_layout, uplo, n, a, i1, i2 ); + return LAPACKE_dsyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyswapr_work.c b/lapack-netlib/LAPACKE/src/lapacke_dsyswapr_work.c index 2855593f6..150480325 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyswapr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyswapr_work.c @@ -28,36 +28,38 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dsyswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_dsyswapr_work( int matrix_layout, char uplo, lapack_int n, - double* a, lapack_int i1, lapack_int i2 ) + double* a, lapack_int lda, + lapack_int i1, lapack_int i2 ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_dsyswapr( &uplo, &n, a, &i1, &i2 ); + LAPACK_dsyswapr( &uplo, &n, a, &lda, &i1, &i2 ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); double* a_t = NULL; /* Allocate memory for temporary array(s) */ - a_t = (double*)LAPACKE_malloc( sizeof(double) * n * MAX(1,n) ); + a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, n, a_t, n ); + LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_dsyswapr( &uplo, &n, a_t, &i1, &i2 ); + LAPACK_dsyswapr( &uplo, &n, a_t, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, n, a, n ); + LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsytri2.c b/lapack-netlib/LAPACKE/src/lapacke_dsytri2.c index 4797491c7..8ab5d82fd 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsytri2.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsytri2.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dsytri2 * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -38,8 +38,8 @@ lapack_int LAPACKE_dsytri2( int matrix_layout, char uplo, lapack_int n, { lapack_int info = 0; lapack_int lwork = -1; - lapack_complex_double* work = NULL; - lapack_complex_double work_query; + double* work = NULL; + double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dsytri2", -1 ); return -1; @@ -58,8 +58,8 @@ lapack_int LAPACKE_dsytri2( int matrix_layout, char uplo, lapack_int n, } lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ - work = (lapack_complex_double*) - LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + work = (double*) + LAPACKE_malloc( sizeof(double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsytri2_work.c b/lapack-netlib/LAPACKE/src/lapacke_dsytri2_work.c index 2168baf0f..1f7f9088f 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsytri2_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsytri2_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dsytri2 * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -36,7 +36,7 @@ lapack_int LAPACKE_dsytri2_work( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, - lapack_complex_double* work, lapack_int lwork ) + double* work, lapack_int lwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_dtpmqrt.c b/lapack-netlib/LAPACKE/src/lapacke_dtpmqrt.c index d11f08283..9015ef098 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dtpmqrt.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dtpmqrt.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function dtpmqrt * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -40,6 +40,8 @@ lapack_int LAPACKE_dtpmqrt( int matrix_layout, char side, char trans, double* a, lapack_int lda, double* b, lapack_int ldb ) { + lapack_int ncols_a, nrows_a; + lapack_int nrows_v; lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -48,16 +50,22 @@ lapack_int LAPACKE_dtpmqrt( int matrix_layout, char side, char trans, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) { + ncols_a = LAPACKE_lsame( side, 'L' ) ? n : + ( LAPACKE_lsame( side, 'R' ) ? k : 0 ); + nrows_a = LAPACKE_lsame( side, 'L' ) ? k : + ( LAPACKE_lsame( side, 'R' ) ? m : 0 ); + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + if( LAPACKE_dge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) { return -13; } if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { return -15; } - if( LAPACKE_dge_nancheck( matrix_layout, ldt, nb, t, ldt ) ) { + if( LAPACKE_dge_nancheck( matrix_layout, nb, k, t, ldt ) ) { return -11; } - if( LAPACKE_dge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { return -9; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_dtprfb.c b/lapack-netlib/LAPACKE/src/lapacke_dtprfb.c index f67463979..9db946537 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dtprfb.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dtprfb.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function dtprfb * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -39,6 +39,7 @@ lapack_int LAPACKE_dtprfb( int matrix_layout, char side, char trans, char direct lapack_int ldv, const double* t, lapack_int ldt, double* a, lapack_int lda, double* b, lapack_int ldb ) { + lapack_int ncols_v, nrows_v; lapack_int info = 0; lapack_int ldwork; lapack_int work_size; @@ -49,16 +50,28 @@ lapack_int LAPACKE_dtprfb( int matrix_layout, char side, char trans, char direct } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ + if( LAPACKE_lsame( storev, 'C' ) ) { + ncols_v = k; + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + } else if( LAPACKE_lsame( storev, 'R' ) ) { + ncols_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + nrows_v = k; + } else { + ncols_v = 0; + nrows_v = 0; + } if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) { return -14; } if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { return -16; } - if( LAPACKE_dge_nancheck( matrix_layout, ldt, k, t, ldt ) ) { + if( LAPACKE_dge_nancheck( matrix_layout, k, k, t, ldt ) ) { return -12; } - if( LAPACKE_dge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -10; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_dtprfb_work.c b/lapack-netlib/LAPACKE/src/lapacke_dtprfb_work.c index 0f059a4b0..2c3d64af1 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dtprfb_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dtprfb_work.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native middle-level C interface to LAPACK function dtprfb * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -39,7 +39,7 @@ lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans, const double* v, lapack_int ldv, const double* t, lapack_int ldt, double* a, lapack_int lda, double* b, lapack_int ldb, - const double* work, lapack_int ldwork ) + double* work, lapack_int ldwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_ilaver.c b/lapack-netlib/LAPACKE/src/lapacke_ilaver.c index bec1d900b..86e6e490f 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ilaver.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ilaver.c @@ -28,14 +28,14 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dgesv * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" -void LAPACKE_ilaver( const lapack_int* vers_major, - const lapack_int* vers_minor, - const lapack_int* vers_patch ) +void LAPACKE_ilaver( lapack_int* vers_major, + lapack_int* vers_minor, + lapack_int* vers_patch ) { /* Call LAPACK function */ LAPACK_ilaver( vers_major, vers_minor, vers_patch ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_sbdsvdx.c b/lapack-netlib/LAPACKE/src/lapacke_sbdsvdx.c index 2d773ba9d..127417fc4 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sbdsvdx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sbdsvdx.c @@ -28,20 +28,20 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function sbdsvdx * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_sbdsvdx( int matrix_layout, char uplo, char jobz, char range, lapack_int n, float* d, float* e, - lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, float* z, lapack_int ldz, lapack_int* superb ) { lapack_int info = 0; - lapack_int lwork = 14*n; + lapack_int lwork = MAX(14*n,1); float* work = NULL; lapack_int* iwork = NULL; lapack_int i; @@ -54,7 +54,7 @@ lapack_int LAPACKE_sbdsvdx( int matrix_layout, char uplo, char jobz, char range, if( LAPACKE_s_nancheck( n, d, 1 ) ) { return -6; } - if( LAPACKE_s_nancheck( n, e, 1 ) ) { + if( LAPACKE_s_nancheck( n - 1, e, 1 ) ) { return -7; } #endif @@ -64,14 +64,14 @@ lapack_int LAPACKE_sbdsvdx( int matrix_layout, char uplo, char jobz, char range, info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } - iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * (12*n) ); + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(12*n,1) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Call middle-level interface */ info = LAPACKE_sbdsvdx_work( matrix_layout, uplo, jobz, range, - n, d, e, vl, vu, il, iu, ns, s, z, + n, d, e, vl, vu, il, iu, ns, s, z, ldz, work, iwork); /* Backup significant data from working array(s) */ for( i=0; i<12*n-1; i++ ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_sbdsvdx_work.c b/lapack-netlib/LAPACKE/src/lapacke_sbdsvdx_work.c index 4f281ef54..214c412d5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sbdsvdx_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sbdsvdx_work.c @@ -28,15 +28,15 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function sbdsvdx * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_sbdsvdx_work( int matrix_layout, char uplo, char jobz, char range, lapack_int n, float* d, float* e, - lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, float* z, lapack_int ldz, float* work, lapack_int* iwork ) { @@ -44,25 +44,27 @@ lapack_int LAPACKE_sbdsvdx_work( int matrix_layout, char uplo, char jobz, char r if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sbdsvdx( &uplo, &jobz, &range, &n, d, e, &vl, &vu, - &il, &iu, &ns, s, z, &ldz, + &il, &iu, ns, s, z, &ldz, work, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_z = ( LAPACKE_lsame( jobz, 'v' ) ) ? MAX(2, 2*n) : 1; + lapack_int nrows_z = ( LAPACKE_lsame( jobz, 'v' ) ) ? 2*n : 0; + lapack_int ncols_z = ( LAPACKE_lsame( jobz, 'v' ) ) ? + ( LAPACKE_lsame( range, 'i' ) ? MAX(0,iu - il + 1) : n + 1 ) : 0; lapack_int ldz_t = MAX(1,nrows_z); float* z_t = NULL; /* Check leading dimension(s) */ - if( ldz < nrows_z ) { + if( ldz < ncols_z ) { info = -3; LAPACKE_xerbla( "LAPACKE_sbdsvdx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'n' ) ) { + if( LAPACKE_lsame( jobz, 'v' ) ) { z_t = (float*) - LAPACKE_malloc( sizeof(float) * ldz_t * 2*n ); + LAPACKE_malloc( sizeof(float) * ldz_t * MAX(2*n,1) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; @@ -70,17 +72,17 @@ lapack_int LAPACKE_sbdsvdx_work( int matrix_layout, char uplo, char jobz, char r } /* Call LAPACK function and adjust info */ LAPACK_sbdsvdx( &uplo, &jobz, &range, &n, d, e, &vl, &vu, - &il, &iu, &ns, s, z_t, &ldz_t, work, + &il, &iu, ns, s, z_t, &ldz_t, work, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'n' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_z, nrows_z, z_t, ldz_t, z, ldz); + if( LAPACKE_lsame( jobz, 'v' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_z, ncols_z, z_t, ldz_t, z, ldz); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'n' ) ) { + if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgejsv.c b/lapack-netlib/LAPACKE/src/lapacke_sgejsv.c index 7af990183..2dc52090c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgejsv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgejsv.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function sgejsv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -70,7 +70,7 @@ lapack_int LAPACKE_sgejsv( int matrix_layout, char joba, char jobu, char jobv, ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && LAPACKE_lsame( jobv, 'j' ) ? MAX(7,m+3*n+n*n) : - 1) ) ) ) ) ); + 7) ) ) ) ) ); lapack_int* iwork = NULL; float* work = NULL; lapack_int i; @@ -86,25 +86,25 @@ lapack_int LAPACKE_sgejsv( int matrix_layout, char joba, char jobu, char jobv, if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, nu, n, u, ldu ) ) { - return -13; - } - } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, nv, n, v, ldv ) ) { - return -15; - } - } #endif /* Allocate memory for working array(s) */ - iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m+3*n) ); + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(3,m+3*n) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } + lwork = MAX3( lwork, 7, 2*m+n ); + { /* FIXUP LWORK */ + int want_u = LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ); + int want_v = LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ); + int want_sce = LAPACKE_lsame( joba, 'e' ) || LAPACKE_lsame( joba, 'g' ); + if( !want_u && !want_v && !want_sce ) lwork = MAX( lwork, 4*n+1 ); // 1.1 + if( !want_u && !want_v && want_sce ) lwork = MAX( lwork, n*n+4*n ); // 1.2 + if( !want_u && want_v ) lwork = MAX( lwork, 4*n+1 ); // 2 + if( want_u && !want_v ) lwork = MAX( lwork, 4*n+1 ); // 3 + if( want_u && LAPACKE_lsame( jobv, 'v' ) ) lwork = MAX( lwork, 6*n+2*n*n ); // 4.1 + if( want_u && LAPACKE_lsame( jobv, 'j' ) ) lwork = MAX3( lwork, 4*n+n*n, 2*n+n*n+6 ); // 4.2 + } work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgejsv_work.c b/lapack-netlib/LAPACKE/src/lapacke_sgejsv_work.c index fe2fa8fb0..559256276 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgejsv_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgejsv_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function sgejsv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -53,6 +53,8 @@ lapack_int LAPACKE_sgejsv_work( int matrix_layout, char joba, char jobu, } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m; lapack_int nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'n' ) ? 1 : + LAPACKE_lsame( jobu, 'f' ) ? m : n; lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nu); lapack_int ldv_t = MAX(1,nv); @@ -65,7 +67,7 @@ lapack_int LAPACKE_sgejsv_work( int matrix_layout, char joba, char jobu, LAPACKE_xerbla( "LAPACKE_sgejsv_work", info ); return info; } - if( ldu < n ) { + if( ldu < ncols_u ) { info = -14; LAPACKE_xerbla( "LAPACKE_sgejsv_work", info ); return info; @@ -83,7 +85,7 @@ lapack_int LAPACKE_sgejsv_work( int matrix_layout, char joba, char jobu, } if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'w' ) ) { - u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,n) ); + u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; @@ -99,14 +101,6 @@ lapack_int LAPACKE_sgejsv_work( int matrix_layout, char joba, char jobu, } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_sge_trans( matrix_layout, nu, n, u, ldu, u_t, ldu_t ); - } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { - LAPACKE_sge_trans( matrix_layout, nv, n, v, ldv, v_t, ldv_t ); - } /* Call LAPACK function and adjust info */ LAPACK_sgejsv( &joba, &jobu, &jobv, &jobr, &jobt, &jobp, &m, &n, a_t, &lda_t, sva, u_t, &ldu_t, v_t, &ldv_t, work, &lwork, @@ -117,7 +111,7 @@ lapack_int LAPACKE_sgejsv_work( int matrix_layout, char joba, char jobu, /* Transpose output matrices */ if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nu, n, u_t, ldu_t, u, ldu ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, nu, ncols_u, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'w' ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgemqrt.c b/lapack-netlib/LAPACKE/src/lapacke_sgemqrt.c index 93d4fcafb..1fa1c82d0 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgemqrt.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgemqrt.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function sgemqrt * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -39,6 +39,7 @@ lapack_int LAPACKE_sgemqrt( int matrix_layout, char side, char trans, const float* t, lapack_int ldt, float* c, lapack_int ldc ) { + lapack_int nrows_v; lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -47,13 +48,15 @@ lapack_int LAPACKE_sgemqrt( int matrix_layout, char side, char trans, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { return -12; } - if( LAPACKE_sge_nancheck( matrix_layout, ldt, nb, t, ldt ) ) { + if( LAPACKE_sge_nancheck( matrix_layout, nb, k, t, ldt ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { return -8; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgesvdx.c b/lapack-netlib/LAPACKE/src/lapacke_sgesvdx.c index c5d727a9e..6387451af 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgesvdx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgesvdx.c @@ -28,15 +28,15 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function sgesvdx * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_sgesvdx( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, float* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, float* u, lapack_int ldu, float* vt, lapack_int ldvt, lapack_int* superb ) @@ -71,7 +71,7 @@ lapack_int LAPACKE_sgesvdx( int matrix_layout, char jobu, char jobvt, char range info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } - iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * (12*MIN(m,n)) ); + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,(12*MIN(m,n))) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgesvdx_work.c b/lapack-netlib/LAPACKE/src/lapacke_sgesvdx_work.c index edab2d164..7bcf3b507 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgesvdx_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgesvdx_work.c @@ -28,15 +28,15 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function sgesvdx * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_sgesvdx_work( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, float* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, float vl, float vu, + lapack_int il, lapack_int iu, lapack_int* ns, float* s, float* u, lapack_int ldu, float* vt, lapack_int ldvt, float* work, lapack_int lwork, lapack_int* iwork ) @@ -45,21 +45,23 @@ lapack_int LAPACKE_sgesvdx_work( int matrix_layout, char jobu, char jobvt, char if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda, &vl, &vu, - &il, &iu, &ns, s, u, &ldu, vt, &ldvt, + &il, &iu, ns, s, u, &ldu, vt, &ldvt, work, &lwork, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || - LAPACKE_lsame( jobu, 's' ) ) ? m : 1; - lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : - ( LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1); - lapack_int nrows_vt = LAPACKE_lsame( jobvt, 'a' ) ? n : - ( LAPACKE_lsame( jobvt, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_u = LAPACKE_lsame( jobu, 'v' ) ? m : 0; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'v' ) ? + ( LAPACKE_lsame( range, 'i' ) ? MAX(iu - il + 1, 0) : MIN(m,n)) : 0; + lapack_int nrows_vt = LAPACKE_lsame( jobvt, 'v' ) ? + ( LAPACKE_lsame( range, 'i' ) ? MAX(iu - il + 1, 0) : MIN(m,n)) : 0; + lapack_int ncols_vt = LAPACKE_lsame( jobvt, 'v' ) ? n : 0; + lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nrows_u); lapack_int ldvt_t = MAX(1,nrows_vt); + float* a_t = NULL; float* u_t = NULL; float* vt_t = NULL; @@ -74,7 +76,7 @@ lapack_int LAPACKE_sgesvdx_work( int matrix_layout, char jobu, char jobvt, char LAPACKE_xerbla( "LAPACKE_sgesvdx_work", info ); return info; } - if( ldvt < n ) { + if( ldvt < ncols_vt ) { info = -18; LAPACKE_xerbla( "LAPACKE_sgesvdx_work", info ); return info; @@ -82,7 +84,7 @@ lapack_int LAPACKE_sgesvdx_work( int matrix_layout, char jobu, char jobvt, char /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_sgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu, - &il, &iu, &ns, s, u, &ldu_t, vt, + &il, &iu, ns, s, u, &ldu_t, vt, &ldvt_t, work, &lwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -92,7 +94,7 @@ lapack_int LAPACKE_sgesvdx_work( int matrix_layout, char jobu, char jobvt, char info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { u_t = (float*) LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { @@ -100,7 +102,7 @@ lapack_int LAPACKE_sgesvdx_work( int matrix_layout, char jobu, char jobvt, char goto exit_level_1; } } - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { vt_t = (float*) LAPACKE_malloc( sizeof(float) * ldvt_t * MAX(1,n) ); if( vt_t == NULL ) { @@ -111,28 +113,28 @@ lapack_int LAPACKE_sgesvdx_work( int matrix_layout, char jobu, char jobvt, char /* Transpose input matrices */ LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_sgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu, - &il, &iu, &ns, s, u, &ldu_t, vt, + LAPACK_sgesvdx( &jobu, &jobvt, &range, &m, &n, a_t, &lda_t, &vl, &vu, + &il, &iu, ns, s, u_t, &ldu_t, vt_t, &ldvt_t, work, &lwork, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, u, ldu ); } - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { LAPACKE_free( vt_t ); } exit_level_2: - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { LAPACKE_free( u_t ); } exit_level_1: diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgesvj.c b/lapack-netlib/LAPACKE/src/lapacke_sgesvj.c index 25e438305..c49c5412c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgesvj.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgesvj.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function sgesvj * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -49,8 +49,8 @@ lapack_int LAPACKE_sgesvj( int matrix_layout, char joba, char jobu, char jobv, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n : - ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1); + nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) : + ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0 ); if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { return -7; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgesvj_work.c b/lapack-netlib/LAPACKE/src/lapacke_sgesvj_work.c index 74bdeea35..add5e60da 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgesvj_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgesvj_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function sgesvj * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -48,8 +48,8 @@ lapack_int LAPACKE_sgesvj_work( int matrix_layout, char joba, char jobu, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n : - ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1); + lapack_int nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) : + ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0); lapack_int lda_t = MAX(1,m); lapack_int ldv_t = MAX(1,nrows_v); float* a_t = NULL; diff --git a/lapack-netlib/LAPACKE/src/lapacke_sggsvd3_work.c b/lapack-netlib/LAPACKE/src/lapacke_sggsvd3_work.c index 617ecf2a1..8964773d4 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sggsvd3_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sggsvd3_work.c @@ -91,9 +91,9 @@ lapack_int LAPACKE_sggsvd3_work( int matrix_layout, char jobu, char jobv, } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { - LAPACK_sggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, - b_t, &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, - q_t, &ldq_t, work, &lwork, iwork, &info ); + LAPACK_sggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda_t, + b, &ldb_t, alpha, beta, u, &ldu_t, v, &ldv_t, + q, &ldq_t, work, &lwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_sggsvp3_work.c b/lapack-netlib/LAPACKE/src/lapacke_sggsvp3_work.c index ec200ca8f..905b82447 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sggsvp3_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sggsvp3_work.c @@ -84,16 +84,16 @@ lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); return info; } - if( ldv < m ) { + if( ldv < p ) { info = -19; LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { - LAPACK_sggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, - &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, - v_t, &ldv_t, q_t, &ldq_t, iwork, tau, work, &lwork, + LAPACK_sggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a, &lda_t, b, + &ldb_t, &tola, &tolb, k, l, u, &ldu_t, + v, &ldv_t, q, &ldq_t, iwork, tau, work, &lwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -116,7 +116,7 @@ lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, } } if( LAPACKE_lsame( jobv, 'v' ) ) { - v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,m) ); + v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,p) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; @@ -146,7 +146,7 @@ lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, m, v_t, ldv_t, v, ldv ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); } if( LAPACKE_lsame( jobq, 'q' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_slantr.c b/lapack-netlib/LAPACKE/src/lapacke_slantr.c index 23b19b15d..e92dc62ff 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_slantr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_slantr.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function slantr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_slantr_work.c b/lapack-netlib/LAPACKE/src/lapacke_slantr_work.c index 92a0e4017..e9f84b55c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_slantr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_slantr_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function slantr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_slascl.c b/lapack-netlib/LAPACKE/src/lapacke_slascl.c index 0d5bd9559..b5368e4b8 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_slascl.c +++ b/lapack-netlib/LAPACKE/src/lapacke_slascl.c @@ -28,14 +28,14 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function slaswp * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_slascl( int matrix_layout, char type, lapack_int kl, - lapack_int ku, float cfrom, float cto, - lapack_int m, lapack_int n, float* a, + lapack_int ku, float cfrom, float cto, + lapack_int m, lapack_int n, float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -46,50 +46,64 @@ lapack_int LAPACKE_slascl( int matrix_layout, char type, lapack_int kl, /* Optionally check input matrices for NaNs */ switch (type) { case 'G': - if( LAPACKE_sge_nancheck( matrix_layout, lda, n, a, lda ) ) { - return -9; - } + if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -9; + } break; case 'L': - // TYPE = 'L' - lower triangular matrix. - if( LAPACKE_str_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) { - return -9; - } + // TYPE = 'L' - lower triangle of general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_sgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) { + return -9; + } break; case 'U': - // TYPE = 'U' - upper triangular matrix - if( LAPACKE_str_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) { - return -9; - } + // TYPE = 'U' - upper triangle of general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_sgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) { + return -9; + } break; case 'H': - // TYPE = 'H' - upper Hessenberg matrix - if( LAPACKE_shs_nancheck( matrix_layout, n, a, lda ) ) { - return -9; - } - break; + // TYPE = 'H' - part of upper Hessenberg matrix in general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_sgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) { + return -9; + } case 'B': - // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL - // and upper bandwidth KU and with the only the lower - // half stored. - if( LAPACKE_ssb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { - return -9; - } - break; - case 'Q': - // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL - // and upper bandwidth KU and with the only the upper - // half stored. - if( LAPACKE_ssb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { - return -9; - } + // TYPE = 'B' - lower part of symmetric band matrix (assume m==n) + if( LAPACKE_ssb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { + return -9; + } + break; + case 'Q': + // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n) + if( LAPACKE_ssb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { + return -9; + } break; case 'Z': - // TYPE = 'Z' - A is a band matrix with lower bandwidth KL and upper - // bandwidth KU. See DGBTRF for storage details. - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) { - return -6; - } + // TYPE = 'Z' - band matrix laid out for ?GBTRF + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) { + return -9; + } break; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_slascl_work.c b/lapack-netlib/LAPACKE/src/lapacke_slascl_work.c index 4abb59ca7..e39db388d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_slascl_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_slascl_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function slaswp * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -46,7 +46,10 @@ lapack_int LAPACKE_slascl_work( int matrix_layout, char type, lapack_int kl, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int lda_t = MAX(1,lda); + lapack_int nrows_a = LAPACKE_lsame(type, 'b') ? kl + 1 : + LAPACKE_lsame(type, 'q') ? ku + 1 : + LAPACKE_lsame(type, 'z') ? 2 * kl + ku + 1 : m; + lapack_int lda_t = MAX(1,nrows_a); float* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { @@ -61,12 +64,14 @@ lapack_int LAPACKE_slascl_work( int matrix_layout, char type, lapack_int kl, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + LAPACKE_sge_trans( matrix_layout, nrows_a, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_slascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info); - info = 0; /* LAPACK call is ok! */ + if( info < 0 ) { + info = info - 1; + } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_sorcsd2by1_work.c b/lapack-netlib/LAPACKE/src/lapacke_sorcsd2by1_work.c index d3d24518b..5990a1e3c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sorcsd2by1_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sorcsd2by1_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function sorcsd2by1 * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -97,8 +97,8 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_sorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, - &q, x11, &ldx11, x21, &ldx21, - theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + &q, x11, &ldx11_t, x21, &ldx21_t, + theta, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t, work, &lwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -144,8 +144,8 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, ldx21_t ); /* Call LAPACK function and adjust info */ LAPACK_sorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, - &q, x11, &ldx11, x21, &ldx21, - theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + &q, x11_t, &ldx11_t, x21_t, &ldx21_t, + theta, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t, &ldv1t_t, work, &lwork, iwork, &info ); if( info < 0 ) { info = info - 1; diff --git a/lapack-netlib/LAPACKE/src/lapacke_sormbr_work.c b/lapack-netlib/LAPACKE/src/lapacke_sormbr_work.c index 34bc41f30..e714fa2fe 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sormbr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sormbr_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function sormbr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_sormlq_work.c b/lapack-netlib/LAPACKE/src/lapacke_sormlq_work.c index b02a2d100..fb143359e 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sormlq_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sormlq_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function sormlq * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssbtrd.c b/lapack-netlib/LAPACKE/src/lapacke_ssbtrd.c index b70a98253..03a3ac9e5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssbtrd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssbtrd.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function ssbtrd * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -48,7 +48,7 @@ lapack_int LAPACKE_ssbtrd( int matrix_layout, char vect, char uplo, lapack_int n if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( LAPACKE_lsame( vect, 'u' ) ) { if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) { return -10; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_sstedc.c b/lapack-netlib/LAPACKE/src/lapacke_sstedc.c index c4bf76434..b5b6b49ce 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sstedc.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sstedc.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function sstedc * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -55,7 +55,7 @@ lapack_int LAPACKE_sstedc( int matrix_layout, char compz, lapack_int n, float* d if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( LAPACKE_lsame( compz, 'v' ) ) { if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { return -6; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssteqr.c b/lapack-netlib/LAPACKE/src/lapacke_ssteqr.c index 1a5a67394..fc7ea29b8 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssteqr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssteqr.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function ssteqr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -52,7 +52,7 @@ lapack_int LAPACKE_ssteqr( int matrix_layout, char compz, lapack_int n, float* d if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( LAPACKE_lsame( compz, 'v' ) ) { if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { return -6; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyconv.c b/lapack-netlib/LAPACKE/src/lapacke_ssyconv.c index 83ae6ff51..044a3dac4 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyconv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyconv.c @@ -28,13 +28,13 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function ssyconv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_ssyconv( int matrix_layout, char uplo, char way, lapack_int n, - float* a, lapack_int lda, const lapack_int* ipiv, float* work ) + float* a, lapack_int lda, const lapack_int* ipiv, float* e ) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -43,14 +43,14 @@ lapack_int LAPACKE_ssyconv( int matrix_layout, char uplo, char way, lapack_int n } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, lda, n, a, lda ) ) { + if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { return -5; } #endif /* Call middle-level interface */ info = LAPACKE_ssyconv_work( matrix_layout, uplo, way, n, a, lda, ipiv, - work ); + e ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_ssyconv", info ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyconv_work.c b/lapack-netlib/LAPACKE/src/lapacke_ssyconv_work.c index 117c0952c..2ffaf8dee 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyconv_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyconv_work.c @@ -28,19 +28,19 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function ssyconv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_ssyconv_work( int matrix_layout, char uplo, char way, lapack_int n, float* a, lapack_int lda, - const lapack_int* ipiv, float* work ) + const lapack_int* ipiv, float* e ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_ssyconv( &uplo, &way, &n, a, &lda, ipiv, work, &info ); + LAPACK_ssyconv( &uplo, &way, &n, a, &lda, ipiv, e, &info ); if( info < 0 ) { info = info - 1; } @@ -62,7 +62,7 @@ lapack_int LAPACKE_ssyconv_work( int matrix_layout, char uplo, char way, /* Transpose input matrices */ LAPACKE_sge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_ssyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, work, &info ); + LAPACK_ssyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, e, &info ); if( info < 0 ) { info = info - 1; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyswapr.c b/lapack-netlib/LAPACKE/src/lapacke_ssyswapr.c index c207edf21..43a5a3e0c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyswapr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyswapr.c @@ -28,13 +28,13 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function ssyswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_ssyswapr( int matrix_layout, char uplo, lapack_int n, - float* a, lapack_int i1, lapack_int i2 ) + float* a, lapack_int lda, lapack_int i1, lapack_int i2 ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_ssyswapr", -1 ); @@ -42,9 +42,9 @@ lapack_int LAPACKE_ssyswapr( int matrix_layout, char uplo, lapack_int n, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, n ) ) { + if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -4; } #endif - return LAPACKE_ssyswapr_work( matrix_layout, uplo, n, a, i1, i2 ); + return LAPACKE_ssyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyswapr_work.c b/lapack-netlib/LAPACKE/src/lapacke_ssyswapr_work.c index e13815883..b376abd65 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyswapr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyswapr_work.c @@ -28,36 +28,38 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function ssyswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_ssyswapr_work( int matrix_layout, char uplo, lapack_int n, - float* a, lapack_int i1, lapack_int i2 ) + float* a, lapack_int lda, + lapack_int i1, lapack_int i2 ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_ssyswapr( &uplo, &n, a, &i1, &i2 ); + LAPACK_ssyswapr( &uplo, &n, a, &lda, &i1, &i2 ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); float* a_t = NULL; /* Allocate memory for temporary array(s) */ - a_t = (float*)LAPACKE_malloc( sizeof(float) * n * MAX(1,n) ); + a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, n, a_t, n ); + LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_ssyswapr( &uplo, &n, a_t, &i1, &i2 ); + LAPACK_ssyswapr( &uplo, &n, a_t, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, n, a, n ); + LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssytri2.c b/lapack-netlib/LAPACKE/src/lapacke_ssytri2.c index c817a8b8a..eb348b112 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssytri2.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssytri2.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function ssytri2 * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -38,8 +38,8 @@ lapack_int LAPACKE_ssytri2( int matrix_layout, char uplo, lapack_int n, float* a { lapack_int info = 0; lapack_int lwork = -1; - lapack_complex_float* work = NULL; - lapack_complex_float work_query; + float* work = NULL; + float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_ssytri2", -1 ); return -1; @@ -58,8 +58,8 @@ lapack_int LAPACKE_ssytri2( int matrix_layout, char uplo, lapack_int n, float* a } lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ - work = (lapack_complex_float*) - LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + work = (float*) + LAPACKE_malloc( sizeof(float) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssytri2_work.c b/lapack-netlib/LAPACKE/src/lapacke_ssytri2_work.c index 10841945f..8a9c72951 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssytri2_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssytri2_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function ssytri2 * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -36,7 +36,7 @@ lapack_int LAPACKE_ssytri2_work( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, - lapack_complex_float* work, lapack_int lwork ) + float* work, lapack_int lwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_stpmqrt.c b/lapack-netlib/LAPACKE/src/lapacke_stpmqrt.c index 43c266a91..29df845a1 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_stpmqrt.c +++ b/lapack-netlib/LAPACKE/src/lapacke_stpmqrt.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function stpmqrt * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -39,6 +39,8 @@ lapack_int LAPACKE_stpmqrt( int matrix_layout, char side, char trans, lapack_int ldv, const float* t, lapack_int ldt, float* a, lapack_int lda, float* b, lapack_int ldb ) { + lapack_int ncols_a, nrows_a; + lapack_int nrows_v; lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -47,16 +49,22 @@ lapack_int LAPACKE_stpmqrt( int matrix_layout, char side, char trans, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) { + ncols_a = LAPACKE_lsame( side, 'L' ) ? n : + ( LAPACKE_lsame( side, 'R' ) ? k : 0 ); + nrows_a = LAPACKE_lsame( side, 'L' ) ? k : + ( LAPACKE_lsame( side, 'R' ) ? m : 0 ); + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + if( LAPACKE_sge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) { return -13; } if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { return -15; } - if( LAPACKE_sge_nancheck( matrix_layout, ldt, nb, t, ldt ) ) { + if( LAPACKE_sge_nancheck( matrix_layout, nb, k, t, ldt ) ) { return -11; } - if( LAPACKE_sge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { return -9; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_stprfb.c b/lapack-netlib/LAPACKE/src/lapacke_stprfb.c index 217a91f4d..e9321854d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_stprfb.c +++ b/lapack-netlib/LAPACKE/src/lapacke_stprfb.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function stprfb * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -39,6 +39,7 @@ lapack_int LAPACKE_stprfb( int matrix_layout, char side, char trans, char direct lapack_int ldv, const float* t, lapack_int ldt, float* a, lapack_int lda, float* b, lapack_int ldb) { + lapack_int ncols_v, nrows_v; lapack_int info = 0; lapack_int ldwork; lapack_int work_size; @@ -49,16 +50,28 @@ lapack_int LAPACKE_stprfb( int matrix_layout, char side, char trans, char direct } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ + if( LAPACKE_lsame( storev, 'C' ) ) { + ncols_v = k; + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + } else if( LAPACKE_lsame( storev, 'R' ) ) { + ncols_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + nrows_v = k; + } else { + ncols_v = 0; + nrows_v = 0; + } if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) { return -14; } if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { return -16; } - if( LAPACKE_sge_nancheck( matrix_layout, ldt, k, t, ldt ) ) { + if( LAPACKE_sge_nancheck( matrix_layout, k, k, t, ldt ) ) { return -12; } - if( LAPACKE_sge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -10; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_stprfb_work.c b/lapack-netlib/LAPACKE/src/lapacke_stprfb_work.c index f39586b2c..dd1d9c2ba 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_stprfb_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_stprfb_work.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native middle-level C interface to LAPACK function stprfb * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -38,7 +38,7 @@ lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans, lapack_int n, lapack_int k, lapack_int l, const float* v, lapack_int ldv, const float* t, lapack_int ldt, float* a, lapack_int lda, - float* b, lapack_int ldb, const float* work, + float* b, lapack_int ldb, float* work, lapack_int ldwork ) { lapack_int info = 0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c b/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c index 7a938866c..18761eaac 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zgejsv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -119,7 +119,7 @@ lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, ( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) && ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) : - 1) ) ) ) ) ) ) ) ); + 7) ) ) ) ) ) ) ) ); lapack_int* iwork = NULL; double* rwork = NULL; lapack_complex_double* cwork = NULL; @@ -136,30 +136,29 @@ lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, nu, n, u, ldu ) ) { - return -13; - } - } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, nv, n, v, ldv ) ) { - return -15; - } - } #endif /* Allocate memory for working array(s) */ - iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m+3*n) ); + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(3,m+2*n) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } + lwork = MAX( lwork, 1 ); + { /* FIXUP LWORK */ + int want_u = LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ); + int want_v = LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ); + int want_sce = LAPACKE_lsame( joba, 'e' ) || LAPACKE_lsame( joba, 'g' ); + if( !want_u && !want_v && !want_sce ) lwork = MAX( lwork, 2*n+1 ); // 1.1 + if( !want_u && !want_v && want_sce ) lwork = MAX( lwork, n*n+3*n ); // 1.2 + if( want_u && LAPACKE_lsame( jobv, 'v' ) ) lwork = MAX( lwork, 5*n+2*n*n ); // 4.1 + if( want_u && LAPACKE_lsame( jobv, 'j' ) ) lwork = MAX( lwork, 4*n+n*n ); // 4.2 + } cwork = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); if( cwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } + lrwork = MAX3( lrwork, 7, n+2*m ); rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgejsv_work.c b/lapack-netlib/LAPACKE/src/lapacke_zgejsv_work.c index 5d785e9a2..83e0d647d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgejsv_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgejsv_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function zgejsv * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -46,7 +46,7 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_zgejsv( &joba, &jobu, &jobv, &jobr, &jobt, &jobp, &m, &n, a, - &lda, sva, u, &ldu, v, &ldv, cwork, &lwork, rwork, &lwork, + &lda, sva, u, &ldu, v, &ldv, cwork, &lwork, rwork, &lrwork, iwork, &info ); if( info < 0 ) { info = info - 1; @@ -54,6 +54,8 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m; lapack_int nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'n' ) ? 1 : + LAPACKE_lsame( jobu, 'f' ) ? m : n; lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nu); lapack_int ldv_t = MAX(1,nv); @@ -66,7 +68,7 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, LAPACKE_xerbla( "LAPACKE_zgejsv_work", info ); return info; } - if( ldu < n ) { + if( ldu < ncols_u ) { info = -14; LAPACKE_xerbla( "LAPACKE_zgejsv_work", info ); return info; @@ -86,7 +88,7 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'w' ) ) { u_t = (lapack_complex_double*) - LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,n) ); + LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; @@ -103,14 +105,6 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, } /* Transpose input matrices */ LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_zge_trans( matrix_layout, nu, n, u, ldu, u_t, ldu_t ); - } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { - LAPACKE_zge_trans( matrix_layout, nv, n, v, ldv, v_t, ldv_t ); - } /* Call LAPACK function and adjust info */ LAPACK_zgejsv( &joba, &jobu, &jobv, &jobr, &jobt, &jobp, &m, &n, a_t, &lda_t, sva, u_t, &ldu_t, v_t, &ldv_t, cwork, &lwork, @@ -121,7 +115,7 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, /* Transpose output matrices */ if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nu, n, u_t, ldu_t, u, ldu ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, nu, ncols_u, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'w' ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgemqrt.c b/lapack-netlib/LAPACKE/src/lapacke_zgemqrt.c index d8b1540bc..f1f32bb5b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgemqrt.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgemqrt.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function zgemqrt * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -40,6 +40,7 @@ lapack_int LAPACKE_zgemqrt( int matrix_layout, char side, char trans, lapack_int ldt, lapack_complex_double* c, lapack_int ldc ) { + lapack_int nrows_v; lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -48,13 +49,15 @@ lapack_int LAPACKE_zgemqrt( int matrix_layout, char side, char trans, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { return -12; } - if( LAPACKE_zge_nancheck( matrix_layout, ldt, nb, t, ldt ) ) { + if( LAPACKE_zge_nancheck( matrix_layout, nb, k, t, ldt ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { return -8; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgesvdx.c b/lapack-netlib/LAPACKE/src/lapacke_zgesvdx.c index c2635da85..4847dbf1c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgesvdx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgesvdx.c @@ -28,15 +28,15 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zgesvdx * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_zgesvdx( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, lapack_complex_double* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, lapack_complex_double* u, lapack_int ldu, lapack_complex_double* vt, lapack_int ldvt, lapack_int* superb ) @@ -44,9 +44,9 @@ lapack_int LAPACKE_zgesvdx( int matrix_layout, char jobu, char jobvt, char range lapack_int info = 0; lapack_int lwork = -1; lapack_complex_double* work = NULL; - lapack_complex_double work_query; + lapack_complex_double work_query; double* rwork = NULL; - lapack_int lrwork = MIN(m,n)*(MIN(m,n)*2+15*MIN(m,n)); + lapack_int lrwork = MAX(1,MIN(m,n)*(MIN(m,n)*2+15*MIN(m,n))); lapack_int* iwork = NULL; lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -68,18 +68,18 @@ lapack_int LAPACKE_zgesvdx( int matrix_layout, char jobu, char jobvt, char range } lwork = LAPACK_Z2INT (work_query); /* Allocate memory for work arrays */ - rwork = (double*)LAPACKE_malloc( sizeof(double) * lwork ); - if( work == NULL ) { - info = LAPACK_WORK_MEMORY_ERROR; - goto exit_level_0; - } work = (lapack_complex_double*) - LAPACKE_malloc( sizeof(lapack_complex_double) * lrwork ); + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } - iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * (12*MIN(m,n)) ); + rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,(12*MIN(m,n))) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_2; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgesvdx_work.c b/lapack-netlib/LAPACKE/src/lapacke_zgesvdx_work.c index 91b20165a..249669434 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgesvdx_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgesvdx_work.c @@ -28,15 +28,15 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function zgesvdx * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char range, lapack_int m, lapack_int n, lapack_complex_double* a, - lapack_int lda, lapack_int vl, lapack_int vu, - lapack_int il, lapack_int iu, lapack_int ns, + lapack_int lda, double vl, double vu, + lapack_int il, lapack_int iu, lapack_int* ns, double* s, lapack_complex_double* u, lapack_int ldu, lapack_complex_double* vt, lapack_int ldvt, lapack_complex_double* work, lapack_int lwork, @@ -46,21 +46,23 @@ lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_zgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda, &vl, &vu, - &il, &iu, &ns, s, u, &ldu, vt, &ldvt, + &il, &iu, ns, s, u, &ldu, vt, &ldvt, work, &lwork, rwork, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || - LAPACKE_lsame( jobu, 's' ) ) ? m : 1; - lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : - ( LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1); - lapack_int nrows_vt = LAPACKE_lsame( jobvt, 'a' ) ? n : - ( LAPACKE_lsame( jobvt, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_u = LAPACKE_lsame( jobu, 'v' ) ? m : 0; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'v' ) ? + ( LAPACKE_lsame( range, 'i' ) ? MAX(iu - il + 1, 0) : MIN(m,n)) : 0; + lapack_int nrows_vt = LAPACKE_lsame( jobvt, 'v' ) ? + ( LAPACKE_lsame( range, 'i' ) ? MAX(iu - il + 1, 0) : MIN(m,n)) : 0; + lapack_int ncols_vt = LAPACKE_lsame( jobvt, 'v' ) ? n : 0; + lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nrows_u); lapack_int ldvt_t = MAX(1,nrows_vt); + lapack_complex_double* a_t = NULL; lapack_complex_double* u_t = NULL; lapack_complex_double* vt_t = NULL; @@ -75,7 +77,7 @@ lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char LAPACKE_xerbla( "LAPACKE_zgesvdx_work", info ); return info; } - if( ldvt < n ) { + if( ldvt < ncols_vt ) { info = -18; LAPACKE_xerbla( "LAPACKE_zgesvdx_work", info ); return info; @@ -83,7 +85,7 @@ lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_zgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu, - &il, &iu, &ns, s, u, &ldu_t, vt, + &il, &iu, ns, s, u, &ldu_t, vt, &ldvt_t, work, &lwork, rwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -94,7 +96,7 @@ lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { u_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { @@ -102,7 +104,7 @@ lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char goto exit_level_1; } } - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { vt_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvt_t * MAX(1,n) ); if( vt_t == NULL ) { @@ -113,28 +115,28 @@ lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char /* Transpose input matrices */ LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_zgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu, - &il, &iu, &ns, s, u, &ldu_t, vt, + LAPACK_zgesvdx( &jobu, &jobvt, &range, &m, &n, a_t, &lda_t, &vl, &vu, + &il, &iu, ns, s, u_t, &ldu_t, vt_t, &ldvt_t, work, &lwork, rwork, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, u, ldu ); } - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) { + if( LAPACKE_lsame( jobvt, 'v' ) ) { LAPACKE_free( vt_t ); } exit_level_2: - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + if( LAPACKE_lsame( jobu, 'v' ) ) { LAPACKE_free( u_t ); } exit_level_1: diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgesvj.c b/lapack-netlib/LAPACKE/src/lapacke_zgesvj.c index dbd5c436c..dfa0ca88a 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgesvj.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgesvj.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zgesvj * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -52,8 +52,8 @@ lapack_int LAPACKE_zgesvj( int matrix_layout, char joba, char jobu, char jobv, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n : - ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1); + nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) : + ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0); if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { return -7; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgesvj_work.c b/lapack-netlib/LAPACKE/src/lapacke_zgesvj_work.c index e618bf9e4..d48a5f5eb 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgesvj_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgesvj_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function zgesvj * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -50,8 +50,8 @@ lapack_int LAPACKE_zgesvj_work( int matrix_layout, char joba, char jobu, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_v = LAPACKE_lsame( jobv, 'v' ) ? n : - ( LAPACKE_lsame( jobv, 'a' ) ? mv : 1); + lapack_int nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) : + ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0); lapack_int lda_t = MAX(1,m); lapack_int ldv_t = MAX(1,nrows_v); lapack_complex_double* a_t = NULL; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgghd3.c b/lapack-netlib/LAPACKE/src/lapacke_zgghd3.c index 03becb8a9..c43f1a55d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgghd3.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgghd3.c @@ -75,7 +75,7 @@ lapack_int LAPACKE_zgghd3( int matrix_layout, char compq, char compz, if( info != 0 ) { goto exit_level_0; } - lwork = LAPACK_C2INT( work_query ); + lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ work = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_zggsvd3_work.c b/lapack-netlib/LAPACKE/src/lapacke_zggsvd3_work.c index aedd405f0..1c6515325 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zggsvd3_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zggsvd3_work.c @@ -93,9 +93,9 @@ lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { - LAPACK_zggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, - b_t, &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, - q_t, &ldq_t, work, &lwork, rwork, iwork, &info ); + LAPACK_zggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda_t, + b, &ldb_t, alpha, beta, u, &ldu_t, v, &ldv_t, + q, &ldq_t, work, &lwork, rwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zggsvp3_work.c b/lapack-netlib/LAPACKE/src/lapacke_zggsvp3_work.c index a266beb54..6ea0c8d52 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zggsvp3_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zggsvp3_work.c @@ -87,16 +87,16 @@ lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); return info; } - if( ldv < m ) { + if( ldv < p ) { info = -19; LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { - LAPACK_zggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, - &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, - &ldv_t, q_t, &ldq_t, iwork, rwork, tau, work, + LAPACK_zggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a, &lda_t, b, + &ldb_t, &tola, &tolb, k, l, u, &ldu_t, v, + &ldv_t, q, &ldq_t, iwork, rwork, tau, work, &lwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -125,7 +125,7 @@ lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, if( LAPACKE_lsame( jobv, 'v' ) ) { v_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * - ldv_t * MAX(1,m) ); + ldv_t * MAX(1,p) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; @@ -157,7 +157,7 @@ lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, m, v_t, ldv_t, v, ldv ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); } if( LAPACKE_lsame( jobq, 'q' ) ) { LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhbtrd.c b/lapack-netlib/LAPACKE/src/lapacke_zhbtrd.c index 309123cc6..c3abb6a25 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhbtrd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhbtrd.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zhbtrd * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -49,7 +49,7 @@ lapack_int LAPACKE_zhbtrd( int matrix_layout, char vect, char uplo, lapack_int n if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( LAPACKE_lsame( vect, 'u' ) ) { if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) { return -10; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheswapr.c b/lapack-netlib/LAPACKE/src/lapacke_zheswapr.c index 93350fbd4..61dbb24ec 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheswapr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheswapr.c @@ -28,14 +28,14 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zheswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_zheswapr( int matrix_layout, char uplo, lapack_int n, - lapack_complex_double* a, lapack_int i1, - lapack_int i2 ) + lapack_complex_double* a, lapack_int lda, + lapack_int i1, lapack_int i2 ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_zheswapr", -1 ); @@ -43,9 +43,9 @@ lapack_int LAPACKE_zheswapr( int matrix_layout, char uplo, lapack_int n, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, n ) ) { + if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -4; } #endif - return LAPACKE_zheswapr_work( matrix_layout, uplo, n, a, i1, i2 ); + return LAPACKE_zheswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheswapr_work.c b/lapack-netlib/LAPACKE/src/lapacke_zheswapr_work.c index e62f987bf..73853a8a8 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheswapr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheswapr_work.c @@ -28,38 +28,39 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function zheswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_zheswapr_work( int matrix_layout, char uplo, lapack_int n, - lapack_complex_double* a, lapack_int i1, - lapack_int i2 ) + lapack_complex_double* a, lapack_int lda, + lapack_int i1, lapack_int i2 ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_zheswapr( &uplo, &n, a, &i1, &i2 ); + LAPACK_zheswapr( &uplo, &n, a, &lda, &i1, &i2 ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); lapack_complex_double* a_t = NULL; /* Allocate memory for temporary array(s) */ a_t = (lapack_complex_double*) - LAPACKE_malloc( sizeof(lapack_complex_double) * n * MAX(1,n) ); + LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, n, a_t, n ); + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_zheswapr( &uplo, &n, a_t, &i1, &i2 ); + LAPACK_zheswapr( &uplo, &n, a_t, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, n, a, n ); + LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhetri2x.c b/lapack-netlib/LAPACKE/src/lapacke_zhetri2x.c index a2835dc33..b991412b8 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhetri2x.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhetri2x.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zhetri2x * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -45,7 +45,7 @@ lapack_int LAPACKE_zhetri2x( int matrix_layout, char uplo, lapack_int n, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, lda, n, a, lda ) ) { + if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { return -4; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_zlantr.c b/lapack-netlib/LAPACKE/src/lapacke_zlantr.c index 2b645e750..29f7cf27d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zlantr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zlantr.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zlantr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c b/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c index 0988bf6e8..0d8bcf550 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function zlantr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" diff --git a/lapack-netlib/LAPACKE/src/lapacke_zlascl.c b/lapack-netlib/LAPACKE/src/lapacke_zlascl.c index e4c1bb0cd..a0d382f14 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zlascl.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zlascl.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function dlaswp * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -42,54 +42,68 @@ lapack_int LAPACKE_zlascl( int matrix_layout, char type, lapack_int kl, LAPACKE_xerbla( "LAPACKE_zlascl", -1 ); return -1; } -#ifndef LAPACK_zISABLE_NAN_CHECK +#ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ switch (type) { case 'G': - if( LAPACKE_zge_nancheck( matrix_layout, lda, n, a, lda ) ) { - return -9; - } + if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -9; + } break; case 'L': - // TYPE = 'L' - lower triangular matrix. - if( LAPACKE_ztr_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) { - return -9; - } + // TYPE = 'L' - lower triangle of general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_zgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) { + return -9; + } break; case 'U': - // TYPE = 'U' - upper triangular matrix - if( LAPACKE_ztr_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) { - return -9; - } + // TYPE = 'U' - upper triangle of general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_zgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) { + return -9; + } break; case 'H': - // TYPE = 'H' - upper Hessenberg matrix - if( LAPACKE_zhs_nancheck( matrix_layout, n, a, lda ) ) { - return -9; - } - break; + // TYPE = 'H' - part of upper Hessenberg matrix in general matrix + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_zgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) { + return -9; + } case 'B': - // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL - // and upper bandwidth KU and with the only the lower - // half stored. - if( LAPACKE_zhb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { - return -9; - } - break; - case 'Q': - // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL - // and upper bandwidth KU and with the only the upper - // half stored. - if( LAPACKE_zhb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { - return -9; - } + // TYPE = 'B' - lower part of symmetric band matrix (assume m==n) + if( LAPACKE_zhb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { + return -9; + } + break; + case 'Q': + // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n) + if( LAPACKE_zhb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { + return -9; + } break; case 'Z': - // TYPE = 'Z' - A is a band matrix with lower bandwidth KL and upper - // bandwidth KU. See DGBTRF for storage details. - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) { - return -6; - } + // TYPE = 'Z' - band matrix laid out for ?GBTRF + if( matrix_layout == LAPACK_COL_MAJOR && + LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) { + return -9; + } + if( matrix_layout == LAPACK_ROW_MAJOR && + LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) { + return -9; + } break; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_zlascl_work.c b/lapack-netlib/LAPACKE/src/lapacke_zlascl_work.c index d8a76a858..44775d93e 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zlascl_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zlascl_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function dlaswp * Author: Intel Corporation -* Generated November, 2011 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -46,7 +46,10 @@ lapack_int LAPACKE_zlascl_work( int matrix_layout, char type, lapack_int kl, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int lda_t = MAX(1,lda); + lapack_int nrows_a = LAPACKE_lsame(type, 'b') ? kl + 1 : + LAPACKE_lsame(type, 'q') ? ku + 1 : + LAPACKE_lsame(type, 'z') ? 2 * kl + ku + 1 : m; + lapack_int lda_t = MAX(1,nrows_a); lapack_complex_double* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { @@ -62,12 +65,14 @@ lapack_int LAPACKE_zlascl_work( int matrix_layout, char type, lapack_int kl, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + LAPACKE_zge_trans( matrix_layout, nrows_a, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zlascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info); - info = 0; /* LAPACK call is ok! */ + if( info < 0 ) { + info = info - 1; + } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_zstedc.c b/lapack-netlib/LAPACKE/src/lapacke_zstedc.c index e88316eb5..4e194f19e 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zstedc.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zstedc.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zstedc * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -59,7 +59,7 @@ lapack_int LAPACKE_zstedc( int matrix_layout, char compz, lapack_int n, if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( LAPACKE_lsame( compz, 'v' ) ) { if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { return -6; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_zsteqr.c b/lapack-netlib/LAPACKE/src/lapacke_zsteqr.c index 0694baa9c..c25b99fe0 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zsteqr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zsteqr.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zsteqr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -53,7 +53,7 @@ lapack_int LAPACKE_zsteqr( int matrix_layout, char compz, lapack_int n, if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( LAPACKE_lsame( compz, 'v' ) ) { if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { return -6; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_zsyconv.c b/lapack-netlib/LAPACKE/src/lapacke_zsyconv.c index 9dbc06789..12eaa4698 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zsyconv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zsyconv.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zsyconv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -36,7 +36,7 @@ lapack_int LAPACKE_zsyconv( int matrix_layout, char uplo, char way, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, - lapack_complex_double* work ) + lapack_complex_double* e ) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -45,13 +45,13 @@ lapack_int LAPACKE_zsyconv( int matrix_layout, char uplo, char way, lapack_int n } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, lda, n, a, lda ) ) { + if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { return -5; } #endif /* Call middle-level interface */ info = LAPACKE_zsyconv_work( matrix_layout, uplo, way, n, a, lda, ipiv, - work ); + e ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zsyconv_work.c b/lapack-netlib/LAPACKE/src/lapacke_zsyconv_work.c index 34f1294e6..259f4d74c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zsyconv_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zsyconv_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function zsyconv * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -36,12 +36,12 @@ lapack_int LAPACKE_zsyconv_work( int matrix_layout, char uplo, char way, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, - lapack_complex_double* work ) + lapack_complex_double* e ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_zsyconv( &uplo, &way, &n, a, &lda, ipiv, work, &info ); + LAPACK_zsyconv( &uplo, &way, &n, a, &lda, ipiv, e, &info ); if( info < 0 ) { info = info - 1; } @@ -64,7 +64,7 @@ lapack_int LAPACKE_zsyconv_work( int matrix_layout, char uplo, char way, /* Transpose input matrices */ LAPACKE_zge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_zsyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, work, &info ); + LAPACK_zsyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, e, &info ); if( info < 0 ) { info = info - 1; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_zsyswapr.c b/lapack-netlib/LAPACKE/src/lapacke_zsyswapr.c index 46e948d18..9a08cf724 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zsyswapr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zsyswapr.c @@ -28,14 +28,14 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zsyswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_zsyswapr( int matrix_layout, char uplo, lapack_int n, - lapack_complex_double* a, lapack_int i1, - lapack_int i2 ) + lapack_complex_double* a, lapack_int lda, + lapack_int i1, lapack_int i2 ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_zsyswapr", -1 ); @@ -43,9 +43,9 @@ lapack_int LAPACKE_zsyswapr( int matrix_layout, char uplo, lapack_int n, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, n ) ) { + if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -4; } #endif - return LAPACKE_zsyswapr_work( matrix_layout, uplo, n, a, i1, i2 ); + return LAPACKE_zsyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/lapack-netlib/LAPACKE/src/lapacke_zsyswapr_work.c b/lapack-netlib/LAPACKE/src/lapacke_zsyswapr_work.c index 1959a2315..44a297de5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zsyswapr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zsyswapr_work.c @@ -28,38 +28,39 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function zsyswapr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" lapack_int LAPACKE_zsyswapr_work( int matrix_layout, char uplo, lapack_int n, - lapack_complex_double* a, lapack_int i1, - lapack_int i2 ) + lapack_complex_double* a, lapack_int lda, + lapack_int i1, lapack_int i2 ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_zsyswapr( &uplo, &n, a, &i1, &i2 ); + LAPACK_zsyswapr( &uplo, &n, a, &lda, &i1, &i2 ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); lapack_complex_double* a_t = NULL; /* Allocate memory for temporary array(s) */ a_t = (lapack_complex_double*) - LAPACKE_malloc( sizeof(lapack_complex_double) * n * MAX(1,n) ); + LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, n, a_t, n ); + LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - LAPACK_zsyswapr( &uplo, &n, a_t, &i1, &i2 ); + LAPACK_zsyswapr( &uplo, &n, a_t, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, n, a, n ); + LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_ztpmqrt.c b/lapack-netlib/LAPACKE/src/lapacke_ztpmqrt.c index a591363c4..72b83fc0b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ztpmqrt.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ztpmqrt.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function ztpmqrt * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -41,6 +41,8 @@ lapack_int LAPACKE_ztpmqrt( int matrix_layout, char side, char trans, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { + lapack_int ncols_a, nrows_a; + lapack_int nrows_v; lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { @@ -49,16 +51,22 @@ lapack_int LAPACKE_ztpmqrt( int matrix_layout, char side, char trans, } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) { + ncols_a = LAPACKE_lsame( side, 'L' ) ? n : + ( LAPACKE_lsame( side, 'R' ) ? k : 0 ); + nrows_a = LAPACKE_lsame( side, 'L' ) ? k : + ( LAPACKE_lsame( side, 'R' ) ? m : 0 ); + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + if( LAPACKE_zge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) { return -13; } if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { return -15; } - if( LAPACKE_zge_nancheck( matrix_layout, ldt, nb, t, ldt ) ) { + if( LAPACKE_zge_nancheck( matrix_layout, nb, k, t, ldt ) ) { return -11; } - if( LAPACKE_zge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { return -9; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c b/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c index 63a50bde9..944ca25e5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native high-level C interface to LAPACK function ztprfb * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -41,6 +41,7 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb) { + lapack_int ncols_v, nrows_v; lapack_int info = 0; lapack_int ldwork; lapack_int work_size; @@ -51,16 +52,28 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ + if( LAPACKE_lsame( storev, 'C' ) ) { + ncols_v = k; + nrows_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + } else if( LAPACKE_lsame( storev, 'R' ) ) { + ncols_v = LAPACKE_lsame( side, 'L' ) ? m : + ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + nrows_v = k; + } else { + ncols_v = 0; + nrows_v = 0; + } if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) { return -14; } if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { return -16; } - if( LAPACKE_zge_nancheck( matrix_layout, ldt, k, t, ldt ) ) { + if( LAPACKE_zge_nancheck( matrix_layout, k, k, t, ldt ) ) { return -12; } - if( LAPACKE_zge_nancheck( matrix_layout, ldv, k, v, ldv ) ) { + if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -10; } #endif diff --git a/lapack-netlib/LAPACKE/src/lapacke_zuncsd2by1.c b/lapack-netlib/LAPACKE/src/lapacke_zuncsd2by1.c index ddf944e09..65e6bd5ce 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zuncsd2by1.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zuncsd2by1.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native high-level C interface to LAPACK function zuncsd2by1 * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -37,7 +37,7 @@ lapack_int LAPACKE_zuncsd2by1( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, lapack_complex_double* x11, lapack_int ldx11, lapack_complex_double* x21, lapack_int ldx21, - lapack_complex_double* theta, lapack_complex_double* u1, + double* theta, lapack_complex_double* u1, lapack_int ldu1, lapack_complex_double* u2, lapack_int ldu2, lapack_complex_double* v1t, lapack_int ldv1t ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zuncsd2by1_work.c b/lapack-netlib/LAPACKE/src/lapacke_zuncsd2by1_work.c index 437a90e8d..9f0ad5fa4 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zuncsd2by1_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zuncsd2by1_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function zuncsd2by1 * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -37,7 +37,7 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, lapack_complex_double* x11, lapack_int ldx11, lapack_complex_double* x21, lapack_int ldx21, - lapack_complex_double* theta, lapack_complex_double* u1, + double* theta, lapack_complex_double* u1, lapack_int ldu1, lapack_complex_double* u2, lapack_int ldu2, lapack_complex_double* v1t, lapack_int ldv1t, lapack_complex_double* work, @@ -99,8 +99,8 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, /* Query optimal working array(s) size if requested */ if( lrwork == -1 || lwork == -1 ) { LAPACK_zuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, - &q, x11, &ldx11, x21, &ldx21, - theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + &q, x11, &ldx11_t, x21, &ldx21_t, + theta, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t, work, &lwork, rwork, &lrwork, iwork, &info ); return (info < 0) ? (info - 1) : info; } @@ -146,8 +146,8 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, ldx21_t ); /* Call LAPACK function and adjust info */ LAPACK_zuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, - &q, x11, &ldx11, x21, &ldx21, - theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + &q, x11_t, &ldx11_t, x21_t, &ldx21_t, + theta, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t, &ldv1t_t, work, &lwork, rwork, &lrwork, iwork, &info ); if( info < 0 ) { info = info - 1; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zunmbr_work.c b/lapack-netlib/LAPACKE/src/lapacke_zunmbr_work.c index 3558974bc..13191a90c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zunmbr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zunmbr_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function zunmbr * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -74,9 +74,11 @@ lapack_int LAPACKE_zunmbr_work( int matrix_layout, char vect, char side, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - a_t = (lapack_complex_double*) - LAPACKE_malloc( sizeof(lapack_complex_double) * - lda_t * MAX(1,MIN(nq,k)) ); + if( LAPACKE_lsame( vect, 'q' ) ) { + a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,k) ); + } else { + a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,nq) ); + } if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zunmlq_work.c b/lapack-netlib/LAPACKE/src/lapacke_zunmlq_work.c index bc2e16ccf..95a997054 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zunmlq_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zunmlq_work.c @@ -28,7 +28,7 @@ ***************************************************************************** * Contents: Native middle-level C interface to LAPACK function zunmlq * Author: Intel Corporation -* Generated November 2015 +* Generated June 2016 *****************************************************************************/ #include "lapacke_utils.h" @@ -42,6 +42,9 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans, { lapack_int info = 0; lapack_int r; + lapack_int lda_t, ldc_t; + lapack_complex_double* a_t = NULL; + lapack_complex_double* c_t = NULL; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_zunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, @@ -51,10 +54,8 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans, } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { r = LAPACKE_lsame( side, 'l' ) ? m : n; - lapack_int lda_t = MAX(1,k); - lapack_int ldc_t = MAX(1,m); - lapack_complex_double* a_t = NULL; - lapack_complex_double* c_t = NULL; + lda_t = MAX(1,k); + ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -8; @@ -73,8 +74,13 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - a_t = (lapack_complex_double*) - LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,m) ); + if( LAPACKE_lsame( side, 'l' ) ) { + a_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,m) ); + } else { + a_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); + } if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; diff --git a/lapack-netlib/LAPACKE/utils/lapacke_cgb_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_cgb_nancheck.c index 9446b355a..400e806f2 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_cgb_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_cgb_nancheck.c @@ -46,14 +46,14 @@ lapack_logical LAPACKE_cgb_nancheck( int matrix_layout, lapack_int m, if( matrix_layout == LAPACK_COL_MAJOR ) { for( j = 0; j < n; j++ ) { - for( i = MAX( ku-j, 0 ); i < MIN3( ldab, m+ku-j, kl+ku+1 ); + for( i = MAX( ku-j, 0 ); i < MIN( m+ku-j, kl+ku+1 ); i++ ) { if( LAPACK_CISNAN( ab[i+(size_t)j*ldab] ) ) return (lapack_logical) 1; } } } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - for( j = 0; j < MIN( n, ldab ); j++ ) { + for( j = 0; j < n; j++ ) { for( i = MAX( ku-j, 0 ); i < MIN( m+ku-j, kl+ku+1 ); i++ ) { if( LAPACK_CISNAN( ab[(size_t)i*ldab+j] ) ) return (lapack_logical) 1; diff --git a/lapack-netlib/LAPACKE/utils/lapacke_dgb_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_dgb_nancheck.c index 5fa13e75d..e94d488d7 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_dgb_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_dgb_nancheck.c @@ -46,14 +46,14 @@ lapack_logical LAPACKE_dgb_nancheck( int matrix_layout, lapack_int m, if( matrix_layout == LAPACK_COL_MAJOR ) { for( j = 0; j < n; j++ ) { - for( i = MAX( ku-j, 0 ); i < MIN3( ldab, m+ku-j, kl+ku+1 ); + for( i = MAX( ku-j, 0 ); i < MIN( m+ku-j, kl+ku+1 ); i++ ) { if( LAPACK_DISNAN( ab[i+(size_t)j*ldab] ) ) return (lapack_logical) 1; } } } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - for( j = 0; j < MIN( n, ldab ); j++ ) { + for( j = 0; j < n; j++ ) { for( i = MAX( ku-j, 0 ); i < MIN( m+ku-j, kl+ku+1 ); i++ ) { if( LAPACK_DISNAN( ab[(size_t)i*ldab+j] ) ) return (lapack_logical) 1; diff --git a/lapack-netlib/LAPACKE/utils/lapacke_sgb_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_sgb_nancheck.c index dcebcf6b5..e20cb2421 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_sgb_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_sgb_nancheck.c @@ -46,14 +46,14 @@ lapack_logical LAPACKE_sgb_nancheck( int matrix_layout, lapack_int m, if( matrix_layout == LAPACK_COL_MAJOR ) { for( j = 0; j < n; j++ ) { - for( i = MAX( ku-j, 0 ); i < MIN3( ldab, m+ku-j, kl+ku+1 ); + for( i = MAX( ku-j, 0 ); i < MIN( m+ku-j, kl+ku+1 ); i++ ) { if( LAPACK_SISNAN( ab[i+(size_t)j*ldab] ) ) return (lapack_logical) 1; } } } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - for( j = 0; j < MIN( n, ldab ); j++ ) { + for( j = 0; j < n; j++ ) { for( i = MAX( ku-j, 0 ); i < MIN( m+ku-j, kl+ku+1 ); i++ ) { if( LAPACK_SISNAN( ab[(size_t)i*ldab+j] ) ) return (lapack_logical) 1; diff --git a/lapack-netlib/LAPACKE/utils/lapacke_zgb_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_zgb_nancheck.c index 019a73578..8f0ffc1d6 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_zgb_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_zgb_nancheck.c @@ -46,14 +46,14 @@ lapack_logical LAPACKE_zgb_nancheck( int matrix_layout, lapack_int m, if( matrix_layout == LAPACK_COL_MAJOR ) { for( j = 0; j < n; j++ ) { - for( i = MAX( ku-j, 0 ); i < MIN3( ldab, m+ku-j, kl+ku+1 ); + for( i = MAX( ku-j, 0 ); i < MIN( m+ku-j, kl+ku+1 ); i++ ) { if( LAPACK_ZISNAN( ab[i+(size_t)j*ldab] ) ) return (lapack_logical) 1; } } } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - for( j = 0; j < MIN( n, ldab ); j++ ) { + for( j = 0; j < n; j++ ) { for( i = MAX( ku-j, 0 ); i < MIN( m+ku-j, kl+ku+1 ); i++ ) { if( LAPACK_ZISNAN( ab[(size_t)i*ldab+j] ) ) return (lapack_logical) 1; diff --git a/lapack-netlib/LICENSE b/lapack-netlib/LICENSE index 8d713b6ae..eefcbdaee 100644 --- a/lapack-netlib/LICENSE +++ b/lapack-netlib/LICENSE @@ -1,9 +1,9 @@ -Copyright (c) 1992-2015 The University of Tennessee and The University +Copyright (c) 1992-2016 The University of Tennessee and The University of Tennessee Research Foundation. All rights reserved. -Copyright (c) 2000-2015 The University of California Berkeley. All +Copyright (c) 2000-2016 The University of California Berkeley. All rights reserved. -Copyright (c) 2006-2015 The University of Colorado Denver. All rights +Copyright (c) 2006-2016 The University of Colorado Denver. All rights reserved. $COPYRIGHT$ diff --git a/lapack-netlib/Makefile b/lapack-netlib/Makefile index 3b0b66083..252322b27 100644 --- a/lapack-netlib/Makefile +++ b/lapack-netlib/Makefile @@ -14,13 +14,16 @@ lib: lapacklib tmglib clean: cleanlib cleantesting cleanblas_testing cleancblas_testing lapack_install: - ( cd INSTALL; $(MAKE); ) + ( cd INSTALL; $(MAKE) ) +# MingW build fails if they are executed. +# ; ./testlsame; ./testslamch; ./testdlamch; \ +# ./testsecond; ./testdsecnd; ./testieee; ./testversion ) blaslib: ( cd BLAS/SRC; $(MAKE) ) cblaslib: - ( cd CBLAS/src; $(MAKE) ) + ( cd CBLAS; $(MAKE) ) lapacklib: lapack_install ( cd SRC; $(MAKE) ) @@ -116,7 +119,7 @@ cleanblas_testing: ( cd BLAS; rm -f xblat* ) cleancblas_testing: - ( cd CBLAS; $(MAKE) cleanexe ) + ( cd CBLAS/testing; $(MAKE) clean ) cleantesting: ( cd TESTING/LIN; $(MAKE) clean ) diff --git a/lapack-netlib/README b/lapack-netlib/README index 9f5562a5c..809fd70f8 100644 --- a/lapack-netlib/README +++ b/lapack-netlib/README @@ -22,6 +22,8 @@ VERSION 3.4.1 : April 2012 VERSION 3.4.2 : September 2012 VERSION 3.5.0 : November 2013 VERSION 3.6.0 : November 2015 +VERSION 3.6.1 : June 2016 + LAPACK is a library of Fortran 90 with subroutines for solving the most commonly occurring problems in numerical linear algebra. diff --git a/lapack-netlib/SRC/CMakeLists.txt b/lapack-netlib/SRC/CMakeLists.txt index 03441b942..4857f4747 100644 --- a/lapack-netlib/SRC/CMakeLists.txt +++ b/lapack-netlib/SRC/CMakeLists.txt @@ -141,7 +141,7 @@ set(SLASRC stbrfs.f stbtrs.f stgevc.f stgex2.f stgexc.f stgsen.f stgsja.f stgsna.f stgsy2.f stgsyl.f stpcon.f stprfs.f stptri.f stptrs.f - strcon.f strevc.f strexc.f strrfs.f strsen.f strsna.f strsyl.f + strcon.f strevc.f strevc3.f strexc.f strrfs.f strsen.f strsna.f strsyl.f strti2.f strtri.f strtrs.f stzrzf.f sstemr.f slansf.f spftrf.f spftri.f spftrs.f ssfrk.f stfsm.f stftri.f stfttp.f stfttr.f stpttf.f stpttr.f strttf.f strttp.f @@ -221,7 +221,7 @@ set(CLASRC ctbcon.f ctbrfs.f ctbtrs.f ctgevc.f ctgex2.f ctgexc.f ctgsen.f ctgsja.f ctgsna.f ctgsy2.f ctgsyl.f ctpcon.f ctprfs.f ctptri.f - ctptrs.f ctrcon.f ctrevc.f ctrexc.f ctrrfs.f ctrsen.f ctrsna.f + ctptrs.f ctrcon.f ctrevc.f ctrevc3.f ctrexc.f ctrrfs.f ctrsen.f ctrsna.f ctrsyl.f ctrti2.f ctrtri.f ctrtrs.f ctzrzf.f cung2l.f cung2r.f cungbr.f cunghr.f cungl2.f cunglq.f cungql.f cungqr.f cungr2.f cungrq.f cungtr.f cunm2l.f cunm2r.f cunmbr.f cunmhr.f cunml2.f cunm22.f @@ -302,7 +302,7 @@ set(DLASRC dtbrfs.f dtbtrs.f dtgevc.f dtgex2.f dtgexc.f dtgsen.f dtgsja.f dtgsna.f dtgsy2.f dtgsyl.f dtpcon.f dtprfs.f dtptri.f dtptrs.f - dtrcon.f dtrevc.f dtrexc.f dtrrfs.f dtrsen.f dtrsna.f dtrsyl.f + dtrcon.f dtrevc.f dtrevc3.f dtrexc.f dtrrfs.f dtrsen.f dtrsna.f dtrsyl.f dtrti2.f dtrtri.f dtrtrs.f dtzrzf.f dstemr.f dsgesv.f dsposv.f dlag2s.f slag2d.f dlat2s.f dlansf.f dpftrf.f dpftri.f dpftrs.f dsfrk.f dtfsm.f dtftri.f dtfttp.f @@ -383,7 +383,7 @@ set(ZLASRC ztbcon.f ztbrfs.f ztbtrs.f ztgevc.f ztgex2.f ztgexc.f ztgsen.f ztgsja.f ztgsna.f ztgsy2.f ztgsyl.f ztpcon.f ztprfs.f ztptri.f - ztptrs.f ztrcon.f ztrevc.f ztrexc.f ztrrfs.f ztrsen.f ztrsna.f + ztptrs.f ztrcon.f ztrevc.f ztrevc3.f ztrexc.f ztrrfs.f ztrsen.f ztrsna.f ztrsyl.f ztrti2.f ztrtri.f ztrtrs.f ztzrzf.f zung2l.f zung2r.f zungbr.f zunghr.f zungl2.f zunglq.f zungql.f zungqr.f zungr2.f zungrq.f zungtr.f zunm2l.f zunm2r.f zunmbr.f zunmhr.f zunml2.f zunm22.f diff --git a/lapack-netlib/SRC/Makefile b/lapack-netlib/SRC/Makefile index 22799769a..bb2d9562c 100644 --- a/lapack-netlib/SRC/Makefile +++ b/lapack-netlib/SRC/Makefile @@ -150,7 +150,7 @@ SLASRC = \ stbrfs.o stbtrs.o stgevc.o stgex2.o stgexc.o stgsen.o \ stgsja.o stgsna.o stgsy2.o stgsyl.o stpcon.o stprfs.o stptri.o \ stptrs.o \ - strcon.o strevc.o strexc.o strrfs.o strsen.o strsna.o strsyl.o \ + strcon.o strevc.o strevc3.o strexc.o strrfs.o strsen.o strsna.o strsyl.o \ strtrs.o stzrzf.o sstemr.o \ slansf.o spftrf.o spftri.o spftrs.o ssfrk.o stfsm.o stftri.o stfttp.o \ stfttr.o stpttf.o stpttr.o strttf.o strttp.o \ @@ -231,7 +231,7 @@ CLASRC = \ ctbcon.o ctbrfs.o ctbtrs.o ctgevc.o ctgex2.o \ ctgexc.o ctgsen.o ctgsja.o ctgsna.o ctgsy2.o ctgsyl.o ctpcon.o \ ctprfs.o ctptri.o \ - ctptrs.o ctrcon.o ctrevc.o ctrexc.o ctrrfs.o ctrsen.o ctrsna.o \ + ctptrs.o ctrcon.o ctrevc.o ctrevc3.o ctrexc.o ctrrfs.o ctrsen.o ctrsna.o \ ctrsyl.o ctrtrs.o ctzrzf.o cung2l.o cung2r.o \ cungbr.o cunghr.o cungl2.o cunglq.o cungql.o cungqr.o cungr2.o \ cungrq.o cungtr.o cunm2l.o cunm2r.o cunmbr.o cunmhr.o cunml2.o cunm22.o \ @@ -316,7 +316,7 @@ DLASRC = \ dtbcon.o dtbrfs.o dtbtrs.o dtgevc.o dtgex2.o dtgexc.o dtgsen.o \ dtgsja.o dtgsna.o dtgsy2.o dtgsyl.o dtpcon.o dtprfs.o dtptri.o \ dtptrs.o \ - dtrcon.o dtrevc.o dtrexc.o dtrrfs.o dtrsen.o dtrsna.o dtrsyl.o \ + dtrcon.o dtrevc.o dtrevc3.o dtrexc.o dtrrfs.o dtrsen.o dtrsna.o dtrsyl.o \ dtrtrs.o dtzrzf.o dstemr.o \ dsgesv.o dsposv.o dlag2s.o slag2d.o dlat2s.o \ dlansf.o dpftrf.o dpftri.o dpftrs.o dsfrk.o dtfsm.o dtftri.o dtfttp.o \ @@ -400,7 +400,7 @@ ZLASRC = \ ztbcon.o ztbrfs.o ztbtrs.o ztgevc.o ztgex2.o \ ztgexc.o ztgsen.o ztgsja.o ztgsna.o ztgsy2.o ztgsyl.o ztpcon.o \ ztprfs.o ztptri.o \ - ztptrs.o ztrcon.o ztrevc.o ztrexc.o ztrrfs.o ztrsen.o ztrsna.o \ + ztptrs.o ztrcon.o ztrevc.o ztrevc3.o ztrexc.o ztrrfs.o ztrsen.o ztrsna.o \ ztrsyl.o ztrtrs.o ztzrzf.o zung2l.o \ zung2r.o zungbr.o zunghr.o zungl2.o zunglq.o zungql.o zungqr.o zungr2.o \ zungrq.o zungtr.o zunm2l.o zunm2r.o zunmbr.o zunmhr.o zunml2.o zunm22.o \ diff --git a/lapack-netlib/SRC/cbbcsd.f b/lapack-netlib/SRC/cbbcsd.f index 2d619cde1..a2d1a1339 100644 --- a/lapack-netlib/SRC/cbbcsd.f +++ b/lapack-netlib/SRC/cbbcsd.f @@ -149,7 +149,7 @@ *> \param[in,out] U1 *> \verbatim *> U1 is COMPLEX array, dimension (LDU1,P) -*> On entry, an LDU1-by-P matrix. On exit, U1 is postmultiplied +*> On entry, a P-by-P matrix. On exit, U1 is postmultiplied *> by the left singular vector matrix common to [ B11 ; 0 ] and *> [ B12 0 0 ; 0 -I 0 0 ]. *> \endverbatim @@ -157,13 +157,13 @@ *> \param[in] LDU1 *> \verbatim *> LDU1 is INTEGER -*> The leading dimension of the array U1. +*> The leading dimension of the array U1, LDU1 >= MAX(1,P). *> \endverbatim *> *> \param[in,out] U2 *> \verbatim *> U2 is COMPLEX array, dimension (LDU2,M-P) -*> On entry, an LDU2-by-(M-P) matrix. On exit, U2 is +*> On entry, an (M-P)-by-(M-P) matrix. On exit, U2 is *> postmultiplied by the left singular vector matrix common to *> [ B21 ; 0 ] and [ B22 0 0 ; 0 0 I ]. *> \endverbatim @@ -171,13 +171,13 @@ *> \param[in] LDU2 *> \verbatim *> LDU2 is INTEGER -*> The leading dimension of the array U2. +*> The leading dimension of the array U2, LDU2 >= MAX(1,M-P). *> \endverbatim *> *> \param[in,out] V1T *> \verbatim *> V1T is COMPLEX array, dimension (LDV1T,Q) -*> On entry, a LDV1T-by-Q matrix. On exit, V1T is premultiplied +*> On entry, a Q-by-Q matrix. On exit, V1T is premultiplied *> by the conjugate transpose of the right singular vector *> matrix common to [ B11 ; 0 ] and [ B21 ; 0 ]. *> \endverbatim @@ -185,13 +185,13 @@ *> \param[in] LDV1T *> \verbatim *> LDV1T is INTEGER -*> The leading dimension of the array V1T. +*> The leading dimension of the array V1T, LDV1T >= MAX(1,Q). *> \endverbatim *> *> \param[in,out] V2T *> \verbatim *> V2T is COMPLEX array, dimenison (LDV2T,M-Q) -*> On entry, a LDV2T-by-(M-Q) matrix. On exit, V2T is +*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is *> premultiplied by the conjugate transpose of the right *> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and *> [ B22 0 0 ; 0 0 I ]. @@ -200,7 +200,7 @@ *> \param[in] LDV2T *> \verbatim *> LDV2T is INTEGER -*> The leading dimension of the array V2T. +*> The leading dimension of the array V2T, LDV2T >= MAX(1,M-Q). *> \endverbatim *> *> \param[out] B11D @@ -322,7 +322,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -332,10 +332,10 @@ $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, RWORK, LRWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS diff --git a/lapack-netlib/SRC/cgbequb.f b/lapack-netlib/SRC/cgbequb.f index 0e2875fe8..f93413be4 100644 --- a/lapack-netlib/SRC/cgbequb.f +++ b/lapack-netlib/SRC/cgbequb.f @@ -84,7 +84,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) +*> AB is COMPLEX array, dimension (LDAB,N) *> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. *> The j-th column of A is stored in the j-th column of the *> array AB as follows: @@ -153,7 +153,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexGBcomputational * @@ -161,10 +161,10 @@ SUBROUTINE CGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, $ AMAX, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, KL, KU, LDAB, M, N diff --git a/lapack-netlib/SRC/cgbrfsx.f b/lapack-netlib/SRC/cgbrfsx.f index fc7349691..31caebe61 100644 --- a/lapack-netlib/SRC/cgbrfsx.f +++ b/lapack-netlib/SRC/cgbrfsx.f @@ -440,7 +440,7 @@ $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.1) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -642,7 +642,7 @@ * * Perform refinement on each right-hand side * - IF ( REF_TYPE .NE. 0 ) THEN + IF ( REF_TYPE .NE. 0 .AND. INFO .EQ. 0 ) THEN PREC_TYPE = ILAPREC( 'D' ) diff --git a/lapack-netlib/SRC/cgeesx.f b/lapack-netlib/SRC/cgeesx.f index 81157717a..4d3c459a7 100644 --- a/lapack-netlib/SRC/cgeesx.f +++ b/lapack-netlib/SRC/cgeesx.f @@ -83,7 +83,7 @@ *> *> \param[in] SELECT *> \verbatim -*> SELECT is procedure) LOGICAL FUNCTION of one COMPLEX argument +*> SELECT is a LOGICAL FUNCTION of one COMPLEX argument *> SELECT must be declared EXTERNAL in the calling subroutine. *> If SORT = 'S', SELECT is used to select eigenvalues to order *> to the top left of the Schur form. @@ -230,7 +230,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexGEeigen * @@ -239,10 +239,10 @@ $ VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, $ BWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVS, SENSE, SORT diff --git a/lapack-netlib/SRC/cgeev.f b/lapack-netlib/SRC/cgeev.f index 0f48322a8..7d19c0228 100644 --- a/lapack-netlib/SRC/cgeev.f +++ b/lapack-netlib/SRC/cgeev.f @@ -26,8 +26,8 @@ * INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. -* REAL RWORK( * ) -* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), +* REAL RWORK( * ) +* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), * $ W( * ), WORK( * ) * .. * @@ -169,59 +169,62 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 +* +* @generated from zgeev.f, fortran z -> c, Tue Apr 19 01:47:44 2016 * *> \ingroup complexGEeigen * * ===================================================================== SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, $ WORK, LWORK, RWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVL, JOBVR INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. - REAL RWORK( * ) - COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + REAL RWORK( * ) + COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ W( * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL LQUERY, SCALEA, WANTVL, WANTVR CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU, - $ IWRK, K, MAXWRK, MINWRK, NOUT - REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM - COMPLEX TMP + $ IWRK, K, LWORK_TREVC, MAXWRK, MINWRK, NOUT + REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM + COMPLEX TMP * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEBAK, CGEBAL, CGEHRD, CHSEQR, CLACPY, CLASCL, - $ CSCAL, CSSCAL, CTREVC, CUNGHR, SLABAD, XERBLA + EXTERNAL SLABAD, XERBLA, CSSCAL, CGEBAK, CGEBAL, CGEHRD, + $ CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, CUNGHR * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL CLANGE, SCNRM2, SLAMCH - EXTERNAL LSAME, ILAENV, ISAMAX, CLANGE, SCNRM2, SLAMCH + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SCNRM2, CLANGE + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SCNRM2, CLANGE * .. * .. Intrinsic Functions .. - INTRINSIC AIMAG, CMPLX, CONJG, MAX, REAL, SQRT + INTRINSIC REAL, CMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * @@ -244,7 +247,6 @@ ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN INFO = -10 END IF - * * Compute workspace * (Note: Comments in the code beginning "Workspace:" describe the @@ -267,18 +269,28 @@ IF( WANTVL ) THEN MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'CUNGHR', $ ' ', N, 1, N, -1 ) ) + CALL CTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL CHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'CUNGHR', $ ' ', N, 1, N, -1 ) ) + CALL CTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL CHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) ELSE CALL CHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, HSWORK, MINWRK ) END IF WORK( 1 ) = MAXWRK @@ -413,12 +425,13 @@ IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (CWorkspace: need 2*N) +* (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need 2*N) * IRWORK = IBAL + N - CALL CTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), RWORK( IRWORK ), IERR ) + CALL CTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, + $ RWORK( IRWORK ), N, IERR ) END IF * IF( WANTVL ) THEN diff --git a/lapack-netlib/SRC/cgeevx.f b/lapack-netlib/SRC/cgeevx.f index 539a7b95f..7ad229e72 100644 --- a/lapack-netlib/SRC/cgeevx.f +++ b/lapack-netlib/SRC/cgeevx.f @@ -25,12 +25,12 @@ * .. Scalar Arguments .. * CHARACTER BALANC, JOBVL, JOBVR, SENSE * INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N -* REAL ABNRM +* REAL ABNRM * .. * .. Array Arguments .. -* REAL RCONDE( * ), RCONDV( * ), RWORK( * ), +* REAL RCONDE( * ), RCONDV( * ), RWORK( * ), * $ SCALE( * ) -* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), +* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), * $ W( * ), WORK( * ) * .. * @@ -134,7 +134,7 @@ *> A is COMPLEX array, dimension (LDA,N) *> On entry, the N-by-N matrix A. *> On exit, A has been overwritten. If JOBVL = 'V' or -*> JOBVR = 'V', A contains the Schur form of the balanced +*> JOBVR = 'V', A contains the Schur form of the balanced *> version of the matrix A. *> \endverbatim *> @@ -276,7 +276,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 +* +* @generated from zgeevx.f, fortran z -> c, Tue Apr 19 01:47:44 2016 * *> \ingroup complexGEeigen * @@ -284,56 +286,57 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, $ LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, $ RCONDV, WORK, LWORK, RWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER BALANC, JOBVL, JOBVR, SENSE INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N - REAL ABNRM + REAL ABNRM * .. * .. Array Arguments .. - REAL RCONDE( * ), RCONDV( * ), RWORK( * ), + REAL RCONDE( * ), RCONDV( * ), RWORK( * ), $ SCALE( * ) - COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ W( * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK, - $ MINWRK, NOUT - REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM - COMPLEX TMP + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT + REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM + COMPLEX TMP * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEBAK, CGEBAL, CGEHRD, CHSEQR, CLACPY, CLASCL, - $ CSCAL, CSSCAL, CTREVC, CTRSNA, CUNGHR, SLABAD, - $ SLASCL, XERBLA + EXTERNAL SLABAD, SLASCL, XERBLA, CSSCAL, CGEBAK, CGEBAL, + $ CGEHRD, CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, + $ CTRSNA, CUNGHR * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL CLANGE, SCNRM2, SLAMCH - EXTERNAL LSAME, ILAENV, ISAMAX, CLANGE, SCNRM2, SLAMCH + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SCNRM2, CLANGE + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SCNRM2, CLANGE * .. * .. Intrinsic Functions .. - INTRINSIC AIMAG, CMPLX, CONJG, MAX, REAL, SQRT + INTRINSIC REAL, CMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * @@ -387,9 +390,19 @@ MAXWRK = N + N*ILAENV( 1, 'CGEHRD', ' ', N, 1, N, 0 ) * IF( WANTVL ) THEN + CALL CTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, LWORK_TREVC ) CALL CHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN + CALL CTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, LWORK_TREVC ) CALL CHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR, $ WORK, -1, INFO ) ELSE @@ -401,7 +414,7 @@ $ WORK, -1, INFO ) END IF END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) * IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN MINWRK = 2*N @@ -559,19 +572,20 @@ $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * -* If INFO > 0 from CHSEQR, then quit +* If INFO .NE. 0 from CHSEQR, then quit * - IF( INFO.GT.0 ) + IF( INFO.NE.0 ) $ GO TO 50 * IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (CWorkspace: need 2*N) +* (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need N) * - CALL CTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), RWORK, IERR ) + CALL CTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, + $ RWORK, N, IERR ) END IF * * Compute condition numbers if desired diff --git a/lapack-netlib/SRC/cgejsv.f b/lapack-netlib/SRC/cgejsv.f index 4b3e90565..bee18fdf8 100644 --- a/lapack-netlib/SRC/cgejsv.f +++ b/lapack-netlib/SRC/cgejsv.f @@ -39,18 +39,19 @@ *> *> \verbatim *> -*> CGEJSV computes the singular value decomposition (SVD) of a real M-by-N +*> CGEJSV computes the singular value decomposition (SVD) of a complex M-by-N *> matrix [A], where M >= N. The SVD of [A] is written as *> *> [A] = [U] * [SIGMA] * [V]^*, *> *> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N -*> diagonal elements, [U] is an M-by-N (or M-by-M) orthonormal matrix, and -*> [V] is an N-by-N orthogonal matrix. The diagonal elements of [SIGMA] are +*> diagonal elements, [U] is an M-by-N (or M-by-M) unitary matrix, and +*> [V] is an N-by-N unitary matrix. The diagonal elements of [SIGMA] are *> the singular values of [A]. The columns of [U] and [V] are the left and *> the right singular vectors of [A], respectively. The matrices [U] and [V] *> are computed and stored in the arrays U and V, respectively. The diagonal *> of [SIGMA] is computed and stored in the array SVA. +*> \endverbatim *> *> Arguments: *> ========== @@ -221,7 +222,7 @@ *> *> \param[out] U *> \verbatim -*> U is COMPLEX array, dimension ( LDU, N ) +*> U is COMPLEX array, dimension ( LDU, N ) or ( LDU, M ) *> If JOBU = 'U', then U contains on exit the M-by-N matrix of *> the left singular vectors. *> If JOBU = 'F', then U contains on exit the M-by-M matrix of @@ -234,7 +235,7 @@ *> copied back to the V array. This 'W' option is just *> a reminder to the caller that in this case U is *> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced. +*> If JOBU = 'N' U is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDU @@ -256,7 +257,7 @@ *> copied back to the U array. This 'W' option is just *> a reminder to the caller that in this case V is *> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced. +*> If JOBV = 'N' V is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDV @@ -278,7 +279,7 @@ *> LWORK depends on the job: *> *> 1. If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and -*> 1.1 .. no scaled condition estimate required (JOBE.EQ.'N'): +*> 1.1 .. no scaled condition estimate required (JOBA.NE.'E'.AND.JOBA.NE.'G'): *> LWORK >= 2*N+1. This is the minimal requirement. *> ->> For optimal performance (blocked code) the optimal value *> is LWORK >= N + (N+1)*NB. Here NB is the optimal @@ -298,7 +299,7 @@ *> (JOBU.EQ.'N') *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance, LWORK >= max(N+(N+1)*NB, 3*N,2*N+N*NB), -*> where NB is the optimal block size for CGEQP3, CGEQRF, CGELQ, +*> where NB is the optimal block size for CGEQP3, CGEQRF, CGELQF, *> CUNMLQ. In general, the optimal length LWORK is computed as *> LWORK >= max(N+LWORK(CGEQP3), N+LWORK(CPOCON), N+LWORK(CGESVJ), *> N+LWORK(CGELQF), 2*N+LWORK(CGEQRF), N+LWORK(CUNMLQ)). @@ -317,8 +318,8 @@ *> the minimal requirement is LWORK >= 5*N+2*N*N. *> 4.2. if JOBV.EQ.'J' the minimal requirement is *> LWORK >= 4*N+N*N. -*> In both cases, the allocated CWORK can accomodate blocked runs -*> of CGEQP3, CGEQRF, CGELQF, SUNMQR, CUNMLQ. +*> In both cases, the allocated CWORK can accommodate blocked runs +*> of CGEQP3, CGEQRF, CGELQF, CUNMQR, CUNMLQ. *> \endverbatim *> *> \param[out] RWORK @@ -432,7 +433,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexGEsing * @@ -498,7 +499,7 @@ *> LAPACK Working note 170. *> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR *> factorization software - a case study. -*> ACM Trans. math. Softw. Vol. 35, No 2 (2008), pp. 1-28. +*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28. *> LAPACK Working note 176. *> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, *> QSVD, (H,K)-SVD computations. @@ -516,10 +517,10 @@ $ M, N, A, LDA, SVA, U, LDU, V, LDV, $ CWORK, LWORK, RWORK, LRWORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. IMPLICIT NONE @@ -556,13 +557,13 @@ * .. * .. External Functions .. REAL SLAMCH, SCNRM2 - INTEGER ISAMAX + INTEGER ISAMAX, ICAMAX LOGICAL LSAME - EXTERNAL ISAMAX, LSAME, SLAMCH, SCNRM2 + EXTERNAL ISAMAX, ICAMAX, LSAME, SLAMCH, SCNRM2 * .. * .. External Subroutines .. EXTERNAL CCOPY, CGELQF, CGEQP3, CGEQRF, CLACPY, CLASCL, - $ CLASET, CLASSQ, CLASWP, CUNGQR, CUNMLQ, + $ SLASCL, CLASET, CLASSQ, SLASSQ, CLASWP, CUNGQR, CUNMLQ, $ CUNMQR, CPOCON, SSCAL, CSSCAL, CSWAP, CTRSM, XERBLA * EXTERNAL CGESVJ @@ -636,7 +637,11 @@ * * Quick return for void matrix (Y3K safe) * #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) RETURN + IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN + IWORK(1:3) = 0 + RWORK(1:7) = 0 + RETURN + ENDIF * * Determine whether the matrix U should be M x N or M x M * @@ -803,7 +808,7 @@ 1950 CONTINUE ELSE DO 1904 p = 1, M - RWORK(M+N+p) = SCALEM*ABS( A(p,ISAMAX(N,A(p,1),LDA)) ) + RWORK(M+N+p) = SCALEM*ABS( A(p,ICAMAX(N,A(p,1),LDA)) ) AATMAX = AMAX1( AATMAX, RWORK(M+N+p) ) AATMIN = AMIN1( AATMIN, RWORK(M+N+p) ) 1904 CONTINUE @@ -824,7 +829,7 @@ * XSC = ZERO TEMP1 = ONE - CALL CLASSQ( N, SVA, 1, XSC, TEMP1 ) + CALL SLASSQ( N, SVA, 1, XSC, TEMP1 ) TEMP1 = ONE / TEMP1 * ENTRA = ZERO @@ -903,7 +908,7 @@ BIG1 = SQRT( BIG ) TEMP1 = SQRT( BIG / FLOAT(N) ) * - CALL CLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) + CALL SLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN AAQQ = ( AAQQ / AAPP ) * TEMP1 ELSE @@ -1221,7 +1226,7 @@ CALL CCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 ) CALL CLACGV( NR-p+1, V(p,p), 1 ) 8998 CONTINUE - CALL CLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL CLASET('Upper', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV) * CALL CGESVJ( 'Lower', 'U','N', NR, NR, V,LDV, SVA, NR, U, $ LDU, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO ) @@ -1517,9 +1522,9 @@ CALL CTRSM('L','U','C','N',NR,NR,CONE,CWORK(2*N+1), $ N,V,LDV) IF ( NR .LT. N ) THEN - CALL CLASET('A',N-NR,NR,ZERO,CZERO,V(NR+1,1),LDV) - CALL CLASET('A',NR,N-NR,ZERO,CZERO,V(1,NR+1),LDV) - CALL CLASET('A',N-NR,N-NR,ZERO,CONE,V(NR+1,NR+1),LDV) + CALL CLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV) + CALL CLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV) + CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) END IF CALL CUNMQR('L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR) @@ -1775,9 +1780,9 @@ NUMRANK = NINT(RWORK(2)) IF ( NR .LT. N ) THEN - CALL CLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) - CALL CLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL CLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) + CALL CLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV ) + CALL CLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV ) + CALL CLASET( 'A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV ) END IF CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), @@ -1832,7 +1837,7 @@ * Undo scaling, if necessary (and possible) * IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL CLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) + CALL SLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) USCAL1 = ONE USCAL2 = ONE END IF diff --git a/lapack-netlib/SRC/cgelss.f b/lapack-netlib/SRC/cgelss.f index 2d0905358..6cb4026a4 100644 --- a/lapack-netlib/SRC/cgelss.f +++ b/lapack-netlib/SRC/cgelss.f @@ -170,7 +170,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexGEsolve * @@ -178,10 +178,10 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK @@ -285,8 +285,8 @@ * Path 1 - overdetermined or exactly determined * * Compute space needed for CGEBRD - CALL CGEBRD( MM, N, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL CGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), DUM(1), + $ -1, INFO ) LWORK_CGEBRD=DUM(1) * Compute space needed for CUNMBR CALL CUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, DUM(1), @@ -315,8 +315,8 @@ $ -1, INFO ) LWORK_CGELQF=DUM(1) * Compute space needed for CGEBRD - CALL CGEBRD( M, M, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL CGEBRD( M, M, A, LDA, S, S, DUM(1), DUM(1), + $ DUM(1), -1, INFO ) LWORK_CGEBRD=DUM(1) * Compute space needed for CUNMBR CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, @@ -346,8 +346,8 @@ * Path 2 - underdetermined * * Compute space needed for CGEBRD - CALL CGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL CGEBRD( M, N, A, LDA, S, S, DUM(1), DUM(1), + $ DUM(1), -1, INFO ) LWORK_CGEBRD=DUM(1) * Compute space needed for CUNMBR CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, M, A, LDA, diff --git a/lapack-netlib/SRC/cgeqrt3.f b/lapack-netlib/SRC/cgeqrt3.f index a5b55c1d3..9bcb82d71 100644 --- a/lapack-netlib/SRC/cgeqrt3.f +++ b/lapack-netlib/SRC/cgeqrt3.f @@ -100,7 +100,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexGEcomputational * @@ -132,10 +132,10 @@ * ===================================================================== RECURSIVE SUBROUTINE CGEQRT3( M, N, A, LDA, T, LDT, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, LDT @@ -177,7 +177,7 @@ * * Compute Householder transform when N=1 * - CALL CLARFG( M, A, A( MIN( 2, M ), 1 ), 1, T ) + CALL CLARFG( M, A(1,1), A( MIN( 2, M ), 1 ), 1, T(1,1) ) * ELSE * diff --git a/lapack-netlib/SRC/cgesdd.f b/lapack-netlib/SRC/cgesdd.f index 7f16b63b6..986619c6c 100644 --- a/lapack-netlib/SRC/cgesdd.f +++ b/lapack-netlib/SRC/cgesdd.f @@ -135,8 +135,8 @@ *> \param[in] LDU *> \verbatim *> LDU is INTEGER -*> The leading dimension of the array U. LDU >= 1; if -*> JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M. +*> The leading dimension of the array U. LDU >= 1; +*> if JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M. *> \endverbatim *> *> \param[out] VT @@ -152,8 +152,8 @@ *> \param[in] LDVT *> \verbatim *> LDVT is INTEGER -*> The leading dimension of the array VT. LDVT >= 1; if -*> JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; +*> The leading dimension of the array VT. LDVT >= 1; +*> if JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; *> if JOBZ = 'S', LDVT >= min(M,N). *> \endverbatim *> @@ -167,24 +167,28 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 1. -*> if JOBZ = 'N', LWORK >= 2*min(M,N)+max(M,N). -*> if JOBZ = 'O', -*> LWORK >= 2*min(M,N)*min(M,N)+2*min(M,N)+max(M,N). -*> if JOBZ = 'S' or 'A', -*> LWORK >= min(M,N)*min(M,N)+2*min(M,N)+max(M,N). -*> For good performance, LWORK should generally be larger. -*> *> If LWORK = -1, a workspace query is assumed. The optimal *> size for the WORK array is calculated and stored in WORK(1), *> and no other work except argument checking is performed. +*> +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LWORK >= 2*mn + mx. +*> If JOBZ = 'O', LWORK >= 2*mn*mn + 2*mn + mx. +*> If JOBZ = 'S', LWORK >= mn*mn + 3*mn. +*> If JOBZ = 'A', LWORK >= mn*mn + 2*mn + mx. +*> These are not tight minimums in all cases; see comments inside code. +*> For good performance, LWORK should generally be larger; +*> a query is recommended. *> \endverbatim *> *> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (MAX(1,LRWORK)) -*> If JOBZ = 'N', LRWORK >= 7*min(M,N). -*> Otherwise, -*> LRWORK >= min(M,N)*max(5*min(M,N)+7,2*max(M,N)+2*min(M,N)+1) +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LRWORK >= 5*mn (LAPACK <= 3.6 needs 7*mn); +*> else if mx >> mn, LRWORK >= 5*mn*mn + 5*mn; +*> else LRWORK >= max( 5*mn*mn + 5*mn, +*> 2*mx*mn + 2*mn*mn + mn ). *> \endverbatim *> *> \param[out] IWORK @@ -208,7 +212,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexGEsing * @@ -221,11 +225,12 @@ * ===================================================================== SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, $ WORK, LWORK, RWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ @@ -241,8 +246,6 @@ * ===================================================================== * * .. Parameters .. - INTEGER LQUERV - PARAMETER ( LQUERV = -1 ) COMPLEX CZERO, CONE PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), $ CONE = ( 1.0E+0, 0.0E+0 ) ) @@ -250,16 +253,27 @@ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) * .. * .. Local Scalars .. - LOGICAL WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS + LOGICAL LQUERY, WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS INTEGER BLK, CHUNK, I, IE, IERR, IL, IR, IRU, IRVT, $ ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT, $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK, $ MNTHR1, MNTHR2, NRWORK, NWORK, WRKBL - REAL ANRM, BIGNUM, EPS, SMLNUM + INTEGER LWORK_CGEBRD_MN, LWORK_CGEBRD_MM, + $ LWORK_CGEBRD_NN, LWORK_CGELQF_MN, + $ LWORK_CGEQRF_MN, + $ LWORK_CUNGBR_P_MN, LWORK_CUNGBR_P_NN, + $ LWORK_CUNGBR_Q_MN, LWORK_CUNGBR_Q_MM, + $ LWORK_CUNGLQ_MN, LWORK_CUNGLQ_NN, + $ LWORK_CUNGQR_MM, LWORK_CUNGQR_MN, + $ LWORK_CUNMBR_PRC_MM, LWORK_CUNMBR_QLN_MM, + $ LWORK_CUNMBR_PRC_MN, LWORK_CUNMBR_QLN_MN, + $ LWORK_CUNMBR_PRC_NN, LWORK_CUNMBR_QLN_NN + REAL ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. INTEGER IDUM( 1 ) REAL DUM( 1 ) + COMPLEX CDUM( 1 ) * .. * .. External Subroutines .. EXTERNAL CGEBRD, CGELQF, CGEMM, CGEQRF, CLACP2, CLACPY, @@ -268,9 +282,8 @@ * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV - REAL CLANGE, SLAMCH - EXTERNAL CLANGE, SLAMCH, ILAENV, LSAME + REAL SLAMCH, CLANGE + EXTERNAL LSAME, SLAMCH, CLANGE * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -279,15 +292,16 @@ * * Test the input arguments * - INFO = 0 - MINMN = MIN( M, N ) - MNTHR1 = INT( MINMN*17.0 / 9.0 ) - MNTHR2 = INT( MINMN*5.0 / 3.0 ) - WNTQA = LSAME( JOBZ, 'A' ) - WNTQS = LSAME( JOBZ, 'S' ) + INFO = 0 + MINMN = MIN( M, N ) + MNTHR1 = INT( MINMN*17.0E0 / 9.0E0 ) + MNTHR2 = INT( MINMN*5.0E0 / 3.0E0 ) + WNTQA = LSAME( JOBZ, 'A' ) + WNTQS = LSAME( JOBZ, 'S' ) WNTQAS = WNTQA .OR. WNTQS - WNTQO = LSAME( JOBZ, 'O' ) - WNTQN = LSAME( JOBZ, 'N' ) + WNTQO = LSAME( JOBZ, 'O' ) + WNTQN = LSAME( JOBZ, 'N' ) + LQUERY = ( LWORK.EQ.-1 ) MINWRK = 1 MAXWRK = 1 * @@ -309,8 +323,8 @@ END IF * * Compute workspace -* (Note: Comments in the code beginning "Workspace:" describe the -* minimal amount of workspace needed at that point in the code, +* Note: Comments in the code beginning "Workspace:" describe the +* minimal amount of workspace allocated at that point in the code, * as well as the preferred amount for good performance. * CWorkspace refers to complex workspace, and RWorkspace to * real workspace. NB refers to the optimal block size for the @@ -320,233 +334,283 @@ IF( M.GE.N ) THEN * * There is no complex work space needed for bidiagonal SVD -* The real work space needed for bidiagonal SVD is BDSPAC -* for computing singular values and singular vectors; BDSPAN -* for computing singular values only. -* BDSPAC = 5*N*N + 7*N -* BDSPAN = MAX(7*N+4, 3*N+2+SMLSIZ*(SMLSIZ+8)) +* The real work space needed for bidiagonal SVD (sbdsdc) is +* BDSPAC = 3*N*N + 4*N for singular values and vectors; +* BDSPAC = 4*N for singular values only; +* not including e, RU, and RVT matrices. +* +* Compute space preferred for each routine + CALL CGEBRD( M, N, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGEBRD_MN = INT( CDUM(1) ) +* + CALL CGEBRD( N, N, CDUM(1), N, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGEBRD_NN = INT( CDUM(1) ) +* + CALL CGEQRF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGEQRF_MN = INT( CDUM(1) ) +* + CALL CUNGBR( 'P', N, N, N, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_P_NN = INT( CDUM(1) ) +* + CALL CUNGBR( 'Q', M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_Q_MM = INT( CDUM(1) ) +* + CALL CUNGBR( 'Q', M, N, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_Q_MN = INT( CDUM(1) ) +* + CALL CUNGQR( M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGQR_MM = INT( CDUM(1) ) +* + CALL CUNGQR( M, N, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGQR_MN = INT( CDUM(1) ) +* + CALL CUNMBR( 'P', 'R', 'C', N, N, N, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_CUNMBR_PRC_NN = INT( CDUM(1) ) +* + CALL CUNMBR( 'Q', 'L', 'N', M, M, N, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_CUNMBR_QLN_MM = INT( CDUM(1) ) +* + CALL CUNMBR( 'Q', 'L', 'N', M, N, N, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_CUNMBR_QLN_MN = INT( CDUM(1) ) +* + CALL CUNMBR( 'Q', 'L', 'N', N, N, N, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_CUNMBR_QLN_NN = INT( CDUM(1) ) * IF( M.GE.MNTHR1 ) THEN IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * - MAXWRK = N + N*ILAENV( 1, 'CGEQRF', ' ', M, N, -1, - $ -1 ) - MAXWRK = MAX( MAXWRK, 2*N+2*N* - $ ILAENV( 1, 'CGEBRD', ' ', N, N, -1, -1 ) ) + MAXWRK = N + LWORK_CGEQRF_MN + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CGEBRD_NN ) MINWRK = 3*N ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') +* Path 2 (M >> N, JOBZ='O') * - WRKBL = N + N*ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'CUNGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'CGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'PRC', N, N, N, -1 ) ) + WRKBL = N + LWORK_CGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_CUNGQR_MN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_PRC_NN ) MAXWRK = M*N + N*N + WRKBL MINWRK = 2*N*N + 3*N ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * - WRKBL = N + N*ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'CUNGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'CGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'PRC', N, N, N, -1 ) ) + WRKBL = N + LWORK_CGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_CUNGQR_MN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_PRC_NN ) MAXWRK = N*N + WRKBL MINWRK = N*N + 3*N ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * - WRKBL = N + N*ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'CUNGQR', ' ', M, - $ M, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'CGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'PRC', N, N, N, -1 ) ) + WRKBL = N + LWORK_CGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_CUNGQR_MM ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_PRC_NN ) MAXWRK = N*N + WRKBL - MINWRK = N*N + 2*N + M + MINWRK = N*N + MAX( 3*N, N + M ) END IF ELSE IF( M.GE.MNTHR2 ) THEN * -* Path 5 (M much larger than N, but not as much as MNTHR1) +* Path 5 (M >> N, but not as much as MNTHR1) * - MAXWRK = 2*N + ( M+N )*ILAENV( 1, 'CGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*N + LWORK_CGEBRD_MN MINWRK = 2*N + M IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'Q', M, N, N, -1 ) ) +* Path 5o (M >> N, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_Q_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + N*N ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'Q', M, N, N, -1 ) ) +* Path 5s (M >> N, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_Q_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+M* - $ ILAENV( 1, 'CUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5a (M >> N, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_Q_MM ) END IF ELSE * -* Path 6 (M at least N, but not much larger) +* Path 6 (M >= N, but not much larger) * - MAXWRK = 2*N + ( M+N )*ILAENV( 1, 'CGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*N + LWORK_CGEBRD_MN MINWRK = 2*N + M IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, N, N, -1 ) ) +* Path 6o (M >= N, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_PRC_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_QLN_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + N*N ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, N, N, -1 ) ) +* Path 6s (M >= N, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_QLN_MN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_PRC_NN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+M* - $ ILAENV( 1, 'CUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6a (M >= N, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_PRC_NN ) END IF END IF ELSE * * There is no complex work space needed for bidiagonal SVD -* The real work space needed for bidiagonal SVD is BDSPAC -* for computing singular values and singular vectors; BDSPAN -* for computing singular values only. -* BDSPAC = 5*M*M + 7*M -* BDSPAN = MAX(7*M+4, 3*M+2+SMLSIZ*(SMLSIZ+8)) +* The real work space needed for bidiagonal SVD (sbdsdc) is +* BDSPAC = 3*M*M + 4*M for singular values and vectors; +* BDSPAC = 4*M for singular values only; +* not including e, RU, and RVT matrices. +* +* Compute space preferred for each routine + CALL CGEBRD( M, N, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGEBRD_MN = INT( CDUM(1) ) +* + CALL CGEBRD( M, M, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGEBRD_MM = INT( CDUM(1) ) +* + CALL CGELQF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGELQF_MN = INT( CDUM(1) ) +* + CALL CUNGBR( 'P', M, N, M, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_P_MN = INT( CDUM(1) ) +* + CALL CUNGBR( 'P', N, N, M, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_P_NN = INT( CDUM(1) ) +* + CALL CUNGBR( 'Q', M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_Q_MM = INT( CDUM(1) ) +* + CALL CUNGLQ( M, N, M, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGLQ_MN = INT( CDUM(1) ) +* + CALL CUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGLQ_NN = INT( CDUM(1) ) +* + CALL CUNMBR( 'P', 'R', 'C', M, M, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_CUNMBR_PRC_MM = INT( CDUM(1) ) +* + CALL CUNMBR( 'P', 'R', 'C', M, N, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_CUNMBR_PRC_MN = INT( CDUM(1) ) +* + CALL CUNMBR( 'P', 'R', 'C', N, N, M, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_CUNMBR_PRC_NN = INT( CDUM(1) ) +* + CALL CUNMBR( 'Q', 'L', 'N', M, M, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_CUNMBR_QLN_MM = INT( CDUM(1) ) * IF( N.GE.MNTHR1 ) THEN IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * - MAXWRK = M + M*ILAENV( 1, 'CGELQF', ' ', M, N, -1, - $ -1 ) - MAXWRK = MAX( MAXWRK, 2*M+2*M* - $ ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) ) + MAXWRK = M + LWORK_CGELQF_MN + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CGEBRD_MM ) MINWRK = 3*M ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * - WRKBL = M + M*ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'CUNGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, M, M, -1 ) ) + WRKBL = M + LWORK_CGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_CUNGLQ_MN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_PRC_MM ) MAXWRK = M*N + M*M + WRKBL MINWRK = 2*M*M + 3*M ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') +* Path 3t (N >> M, JOBZ='S') * - WRKBL = M + M*ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'CUNGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, M, M, -1 ) ) + WRKBL = M + LWORK_CGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_CUNGLQ_MN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_PRC_MM ) MAXWRK = M*M + WRKBL MINWRK = M*M + 3*M ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * - WRKBL = M + M*ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'CUNGLQ', ' ', N, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, M, M, -1 ) ) + WRKBL = M + LWORK_CGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_CUNGLQ_NN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_PRC_MM ) MAXWRK = M*M + WRKBL - MINWRK = M*M + 2*M + N + MINWRK = M*M + MAX( 3*M, M + N ) END IF ELSE IF( N.GE.MNTHR2 ) THEN * -* Path 5t (N much larger than M, but not as much as MNTHR1) +* Path 5t (N >> M, but not as much as MNTHR1) * - MAXWRK = 2*M + ( M+N )*ILAENV( 1, 'CGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*M + LWORK_CGEBRD_MN MINWRK = 2*M + N IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'P', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5to (N >> M, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_P_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + M*M ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'P', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5ts (N >> M, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_P_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*M+N* - $ ILAENV( 1, 'CUNGBR', 'P', N, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5ta (N >> M, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_P_NN ) END IF ELSE * -* Path 6t (N greater than M, but not much larger) +* Path 6t (N > M, but not much larger) * - MAXWRK = 2*M + ( M+N )*ILAENV( 1, 'CGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*M + LWORK_CGEBRD_MN MINWRK = 2*M + N IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'PRC', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, M, N, -1 ) ) +* Path 6to (N > M, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_PRC_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + M*M ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'PRC', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6ts (N > M, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_PRC_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*M+N* - $ ILAENV( 1, 'CUNGBR', 'PRC', N, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6ta (N > M, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_PRC_NN ) END IF END IF END IF @@ -554,18 +618,20 @@ END IF IF( INFO.EQ.0 ) THEN WORK( 1 ) = MAXWRK - IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV ) - $ INFO = -13 + IF( LWORK.LT.MINWRK .AND. .NOT. LQUERY ) THEN + INFO = -12 + END IF END IF -* -* Quick returns * IF( INFO.NE.0 ) THEN CALL XERBLA( 'CGESDD', -INFO ) RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF - IF( LWORK.EQ.LQUERV ) - $ RETURN +* +* Quick return if possible +* IF( M.EQ.0 .OR. N.EQ.0 ) THEN RETURN END IF @@ -598,15 +664,16 @@ * IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: need 0) +* CWorkspace: need N [tau] + N [work] +* CWorkspace: prefer N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -621,8 +688,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -630,15 +698,15 @@ NRWORK = IE + N * * Perform bidiagonal SVD, compute singular values only -* (CWorkspace: 0) -* (RWorkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') +* Path 2 (M >> N, JOBZ='O') * N left singular vectors to be overwritten on A and * N right singular vectors to be computed in VT * @@ -648,20 +716,21 @@ * LDWRKU = N IR = IU + LDWRKU*N - IF( LWORK.GE.M*N+N*N+3*N ) THEN + IF( LWORK .GE. M*N + N*N + 3*N ) THEN * * WORK(IR) is M by N * LDWRKR = M ELSE - LDWRKR = ( LWORK-N*N-3*N ) / N + LDWRKR = ( LWORK - N*N - 3*N ) / N END IF ITAU = IR + LDWRKR*N NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need N*N+2*N, prefer M*N+N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -673,8 +742,9 @@ $ LDWRKR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CUNGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -684,8 +754,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -694,8 +765,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of R in WORK(IRU) and computing right singular vectors * of R in WORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = IE + N IRVT = IRU + N*N @@ -706,8 +777,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by the left singular vectors of R -* (CWorkspace: need 2*N*N+3*N, prefer M*N+N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), $ LDWRKU ) @@ -717,8 +789,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by the right singular vectors of R -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, @@ -727,8 +800,9 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IU), storing result in WORK(IR) and copying to A -* (CWorkspace: need 2*N*N, prefer N*N+M*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] +* CWorkspace: prefer N*N [U] + M*N [R] +* RWorkspace: need 0 * DO 10 I = 1, M, LDWRKR CHUNK = MIN( M-I+1, LDWRKR ) @@ -741,7 +815,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * N left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -754,8 +828,9 @@ NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -767,8 +842,9 @@ $ LDWRKR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CUNGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -778,8 +854,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -788,8 +865,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = IE + N IRVT = IRU + N*N @@ -800,8 +877,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, @@ -810,8 +888,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, @@ -820,8 +899,8 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in U -* (CWorkspace: need N*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] +* RWorkspace: need 0 * CALL CLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR ) CALL CGEMM( 'N', 'N', M, N, N, CONE, A, LDA, WORK( IR ), @@ -829,7 +908,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * M left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -842,16 +921,18 @@ NWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL CLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (CWorkspace: need N+M, prefer N+M*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N [tau] + M [work] +* CWorkspace: prefer N*N [U] + N [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CUNGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -866,8 +947,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -879,8 +961,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -888,8 +970,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by left singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), $ LDWRKU ) @@ -899,8 +982,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of R -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -909,8 +993,8 @@ * * Multiply Q in U by left singular vectors of R in * WORK(IU), storing result in A -* (CWorkspace: need N*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] +* RWorkspace: need 0 * CALL CGEMM( 'N', 'N', M, N, N, CONE, U, LDU, WORK( IU ), $ LDWRKU, CZERO, A, LDA ) @@ -925,7 +1009,7 @@ * * MNTHR2 <= M < MNTHR1 * -* Path 5 (M much larger than N, but not as much as MNTHR1) +* Path 5 (M >> N, but not as much as MNTHR1) * Reduce to bidiagonal form without QR decomposition, use * CUNGBR and matrix multiplication to compute singular vectors * @@ -936,19 +1020,21 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5n (M >> N, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IU = NWORK @@ -956,22 +1042,25 @@ IRVT = IRU + N*N NRWORK = IRVT + N*N * +* Path 5o (M >> N, JOBZ='O') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL CUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * * WORK( IU ) is M by N * @@ -980,15 +1069,15 @@ * * WORK(IU) is LDWRKU by N * - LDWRKU = ( LWORK-3*N ) / N + LDWRKU = ( LWORK - 3*N ) / N END IF NWORK = IU + LDWRKU*N * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -996,8 +1085,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in WORK(IU), copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL CLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, $ WORK( IU ), LDWRKU, RWORK( NRWORK ) ) @@ -1005,8 +1094,10 @@ * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need N*N, prefer M*N) -* (Rworkspace: need 3*N*N, prefer N*N+2*M*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] +* RWorkspace: need N [e] + N*N [RU] + 2*N*N [rwork] +* RWorkspace: prefer N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT DO 20 I = 1, M, LDWRKU @@ -1019,17 +1110,20 @@ * ELSE IF( WNTQS ) THEN * +* Path 5s (M >> N, JOBZ='S') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL CUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to U, generate Q -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'L', M, N, A, LDA, U, LDU ) CALL CUNGBR( 'Q', M, N, N, U, LDU, WORK( ITAUQ ), @@ -1038,8 +1132,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1050,8 +1144,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL CLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) @@ -1059,8 +1153,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need N*N+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT CALL CLACRM( M, N, U, LDU, RWORK( IRU ), N, A, LDA, @@ -1068,17 +1162,20 @@ CALL CLACPY( 'F', M, N, A, LDA, U, LDU ) ELSE * +* Path 5a (M >> N, JOBZ='A') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL CUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to U, generate Q -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'L', M, N, A, LDA, U, LDU ) CALL CUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), @@ -1087,8 +1184,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1099,8 +1196,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL CLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) @@ -1108,8 +1205,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT CALL CLACRM( M, N, U, LDU, RWORK( IRU ), N, A, LDA, @@ -1121,7 +1218,7 @@ * * M .LT. MNTHR2 * -* Path 6 (M at least N, but not much larger) +* Path 6 (M >= N, but not much larger) * Reduce to bidiagonal form without QR decomposition * Use CUNMBR to compute singular vectors * @@ -1132,26 +1229,28 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 6n (M >= N, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IU = NWORK IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * * WORK( IU ) is M by N * @@ -1160,15 +1259,16 @@ * * WORK( IU ) is LDWRKU by N * - LDWRKU = ( LWORK-3*N ) / N + LDWRKU = ( LWORK - 3*N ) / N END IF NWORK = IU + LDWRKU*N * +* Path 6o (M >= N, JOBZ='O') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -1176,21 +1276,24 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*N [U] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * -* Copy real matrix RWORK(IRU) to complex matrix WORK(IU) -* Overwrite WORK(IU) by left singular vectors of A, copying -* to A -* (Cworkspace: need M*N+2*N, prefer M*N+N+N*NB) -* (Rworkspace: need 0) +* Path 6o-fast +* Copy real matrix RWORK(IRU) to complex matrix WORK(IU) +* Overwrite WORK(IU) by left singular vectors of A, copying +* to A +* CWorkspace: need 2*N [tauq, taup] + M*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] * CALL CLASET( 'F', M, N, CZERO, CZERO, WORK( IU ), $ LDWRKU ) @@ -1202,17 +1305,21 @@ CALL CLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) ELSE * +* Path 6o-slow * Generate Q in A -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*N [U] + N*NB [work] +* RWorkspace: need 0 * CALL CUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need N*N, prefer M*N) -* (Rworkspace: need 3*N*N, prefer N*N+2*M*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] +* RWorkspace: need N [e] + N*N [RU] + 2*N*N [rwork] +* RWorkspace: prefer N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT DO 30 I = 1, M, LDWRKU @@ -1227,11 +1334,12 @@ * ELSE IF( WNTQS ) THEN * +* Path 6s (M >= N, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1242,8 +1350,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL CLASET( 'F', M, N, CZERO, CZERO, U, LDU ) CALL CLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) @@ -1253,8 +1362,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -1262,11 +1372,12 @@ $ LWORK-NWORK+1, IERR ) ELSE * +* Path 6a (M >= N, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1285,8 +1396,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL CLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -1295,8 +1407,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -1316,15 +1429,16 @@ * IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M [tau] + M [work] +* CWorkspace: prefer M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1339,8 +1453,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1348,15 +1463,15 @@ NRWORK = IE + M * * Perform bidiagonal SVD, compute singular values only -* (CWorkspace: 0) -* (RWorkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL SBDSDC( 'U', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'U', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * M right singular vectors to be overwritten on A and * M left singular vectors to be computed in U * @@ -1366,7 +1481,7 @@ * WORK(IVT) is M by M * IL = IVT + LDWKVT*M - IF( LWORK.GE.M*N+M*M+3*M ) THEN + IF( LWORK .GE. M*N + M*M + 3*M ) THEN * * WORK(IL) M by N * @@ -1377,14 +1492,15 @@ * WORK(IL) is M by CHUNK * LDWRKL = M - CHUNK = ( LWORK-M*M-3*M ) / M + CHUNK = ( LWORK - M*M - 3*M ) / M END IF ITAU = IL + LDWRKL*CHUNK NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1396,8 +1512,9 @@ $ WORK( IL+LDWRKL ), LDWRKL ) * * Generate Q in A -* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CUNGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1407,8 +1524,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, M, WORK( IL ), LDWRKL, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -1417,8 +1535,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1429,8 +1547,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by the left singular vectors of L -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, @@ -1439,8 +1558,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) * Overwrite WORK(IVT) by the right singular vectors of L -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1450,8 +1570,9 @@ * * Multiply right singular vectors of L in WORK(IL) by Q * in A, storing result in WORK(IL) and copying to A -* (CWorkspace: need 2*M*M, prefer M*M+M*N)) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] +* CWorkspace: prefer M*M [VT] + M*N [L] +* RWorkspace: need 0 * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) @@ -1464,9 +1585,9 @@ * ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') -* M right singular vectors to be computed in VT and -* M left singular vectors to be computed in U +* Path 3t (N >> M, JOBZ='S') +* M right singular vectors to be computed in VT and +* M left singular vectors to be computed in U * IL = 1 * @@ -1477,8 +1598,9 @@ NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1490,8 +1612,9 @@ $ WORK( IL+LDWRKL ), LDWRKL ) * * Generate Q in A -* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CUNGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1501,8 +1624,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, M, WORK( IL ), LDWRKL, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -1511,8 +1635,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1523,8 +1647,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, @@ -1533,8 +1658,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by left singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), LDWRKL, @@ -1543,8 +1669,8 @@ * * Copy VT to WORK(IL), multiply right singular vectors of L * in WORK(IL) by Q in A, storing result in VT -* (CWorkspace: need M*M) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] +* RWorkspace: need 0 * CALL CLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL ) CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IL ), LDWRKL, @@ -1552,7 +1678,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 9t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * N right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1565,16 +1691,18 @@ NWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL CLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (CWorkspace: need M+N, prefer M+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M [tau] + N [work] +* CWorkspace: prefer M*M [VT] + M [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1589,8 +1717,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1599,8 +1728,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1611,8 +1740,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of L -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, M, A, LDA, @@ -1621,8 +1751,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) * Overwrite WORK(IVT) by right singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1632,11 +1763,11 @@ * * Multiply right singular vectors of L in WORK(IVT) by * Q in VT, storing result in A -* (CWorkspace: need M*M) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] +* RWorkspace: need 0 * - CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), - $ LDWKVT, VT, LDVT, CZERO, A, LDA ) + CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), LDWKVT, + $ VT, LDVT, CZERO, A, LDA ) * * Copy right singular vectors of A from A to VT * @@ -1648,10 +1779,9 @@ * * MNTHR2 <= N < MNTHR1 * -* Path 5t (N much larger than M, but not as much as MNTHR1) +* Path 5t (N >> M, but not as much as MNTHR1) * Reduce to bidiagonal form without QR decomposition, use * CUNGBR and matrix multiplication to compute singular vectors -* * IE = 1 NRWORK = IE + M @@ -1660,8 +1790,9 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB) -* (RWorkspace: M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1669,11 +1800,12 @@ * IF( WNTQN ) THEN * +* Path 5tn (N >> M, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL SBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IRVT = NRWORK @@ -1681,23 +1813,26 @@ NRWORK = IRU + M*M IVT = NWORK * +* Path 5to (N >> M, JOBZ='O') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'L', M, M, A, LDA, U, LDU ) CALL CUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Generate P**H in A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * LDWKVT = M - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * * WORK( IVT ) is M by N * @@ -1707,15 +1842,15 @@ * * WORK( IVT ) is M by CHUNK * - CHUNK = ( LWORK-3*M ) / M + CHUNK = ( LWORK - 3*M ) / M NWORK = IVT + LDWKVT*CHUNK END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, @@ -1723,8 +1858,8 @@ * * Multiply Q in U by real matrix RWORK(IRVT) * storing the result in WORK(IVT), copying to U -* (Cworkspace: need 0) -* (Rworkspace: need 2*M*M) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL CLACRM( M, M, U, LDU, RWORK( IRU ), M, WORK( IVT ), $ LDWKVT, RWORK( NRWORK ) ) @@ -1732,8 +1867,10 @@ * * Multiply RWORK(IRVT) by P**H in A, storing the * result in WORK(IVT), copying to A -* (CWorkspace: need M*M, prefer M*N) -* (Rworkspace: need 2*M*M, prefer 2*M*N) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] +* RWorkspace: need M [e] + M*M [RVT] + 2*M*M [rwork] +* RWorkspace: prefer M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU DO 50 I = 1, N, CHUNK @@ -1745,17 +1882,20 @@ 50 CONTINUE ELSE IF( WNTQS ) THEN * +* Path 5ts (N >> M, JOBZ='S') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'L', M, M, A, LDA, U, LDU ) CALL CUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to VT, generate P**H -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'U', M, N, A, LDA, VT, LDVT ) CALL CUNGBR( 'P', M, N, M, VT, LDVT, WORK( ITAUP ), @@ -1764,8 +1904,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1776,8 +1916,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need 3*M*M) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL CLACRM( M, M, U, LDU, RWORK( IRU ), M, A, LDA, $ RWORK( NRWORK ) ) @@ -1785,8 +1925,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need M*M+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU CALL CLARCM( M, N, RWORK( IRVT ), M, VT, LDVT, A, LDA, @@ -1794,17 +1934,20 @@ CALL CLACPY( 'F', M, N, A, LDA, VT, LDVT ) ELSE * +* Path 5ta (N >> M, JOBZ='A') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'L', M, M, A, LDA, U, LDU ) CALL CUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to VT, generate P**H -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'U', M, N, A, LDA, VT, LDVT ) CALL CUNGBR( 'P', N, N, M, VT, LDVT, WORK( ITAUP ), @@ -1813,8 +1956,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1825,8 +1968,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need 3*M*M) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL CLACRM( M, M, U, LDU, RWORK( IRU ), M, A, LDA, $ RWORK( NRWORK ) ) @@ -1834,9 +1977,10 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need M*M+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * + NRWORK = IRU CALL CLARCM( M, N, RWORK( IRVT ), M, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) CALL CLACPY( 'F', M, N, A, LDA, VT, LDVT ) @@ -1846,7 +1990,7 @@ * * N .LT. MNTHR2 * -* Path 6t (N greater than M, but not much larger) +* Path 6t (N > M, but not much larger) * Reduce to bidiagonal form without LQ decomposition * Use CUNMBR to compute singular vectors * @@ -1857,24 +2001,27 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB) -* (RWorkspace: M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 6tn (N > M, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL SBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 6to (N > M, JOBZ='O') LDWKVT = M IVT = NWORK - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * * WORK( IVT ) is M by N * @@ -1885,15 +2032,15 @@ * * WORK( IVT ) is M by CHUNK * - CHUNK = ( LWORK-3*M ) / M + CHUNK = ( LWORK - 3*M ) / M NWORK = IVT + LDWKVT*CHUNK END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1904,21 +2051,24 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*M [VT] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * -* Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) -* Overwrite WORK(IVT) by right singular vectors of A, -* copying to A -* (Cworkspace: need M*N+2*M, prefer M*N+M+M*NB) -* (Rworkspace: need 0) +* Path 6to-fast +* Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) +* Overwrite WORK(IVT) by right singular vectors of A, +* copying to A +* CWorkspace: need 2*M [tauq, taup] + M*N [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1928,17 +2078,21 @@ CALL CLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) ELSE * +* Path 6to-slow * Generate P**H in A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*M [VT] + M*NB [work] +* RWorkspace: need 0 * CALL CUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need M*M, prefer M*N) -* (Rworkspace: need 3*M*M, prefer M*M+2*M*N) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] +* RWorkspace: need M [e] + M*M [RVT] + 2*M*M [rwork] +* RWorkspace: prefer M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU DO 60 I = 1, N, CHUNK @@ -1952,11 +2106,12 @@ END IF ELSE IF( WNTQS ) THEN * +* Path 6ts (N > M, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1967,8 +2122,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -1977,8 +2133,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL CLASET( 'F', M, N, CZERO, CZERO, VT, LDVT ) CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) @@ -1987,11 +2144,12 @@ $ LWORK-NWORK+1, IERR ) ELSE * +* Path 6ta (N > M, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -2003,8 +2161,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -2017,8 +2176,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + N*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, M, A, LDA, diff --git a/lapack-netlib/SRC/cgesvd.f b/lapack-netlib/SRC/cgesvd.f index 3c1f825db..d147dee53 100644 --- a/lapack-netlib/SRC/cgesvd.f +++ b/lapack-netlib/SRC/cgesvd.f @@ -214,7 +214,7 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, $ WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -322,23 +322,23 @@ MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 ) * Compute space needed for CGEQRF CALL CGEQRF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGEQRF=CDUM(1) + LWORK_CGEQRF = INT( CDUM(1) ) * Compute space needed for CUNGQR CALL CUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_CUNGQR_N=CDUM(1) + LWORK_CUNGQR_N = INT( CDUM(1) ) CALL CUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_CUNGQR_M=CDUM(1) + LWORK_CUNGQR_M = INT( CDUM(1) ) * Compute space needed for CGEBRD CALL CGEBRD( N, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGEBRD=CDUM(1) + LWORK_CGEBRD = INT( CDUM(1) ) * Compute space needed for CUNGBR CALL CUNGBR( 'P', N, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_P=CDUM(1) + LWORK_CUNGBR_P = INT( CDUM(1) ) CALL CUNGBR( 'Q', N, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_Q=CDUM(1) + LWORK_CUNGBR_Q = INT( CDUM(1) ) * MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 ) IF( M.GE.MNTHR ) THEN @@ -446,24 +446,24 @@ * CALL CGEBRD( M, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGEBRD=CDUM(1) + LWORK_CGEBRD = INT( CDUM(1) ) MAXWRK = 2*N + LWORK_CGEBRD IF( WNTUS .OR. WNTUO ) THEN CALL CUNGBR( 'Q', M, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_Q=CDUM(1) + LWORK_CUNGBR_Q = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*N+LWORK_CUNGBR_Q ) END IF IF( WNTUA ) THEN CALL CUNGBR( 'Q', M, M, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_Q=CDUM(1) + LWORK_CUNGBR_Q = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*N+LWORK_CUNGBR_Q ) END IF IF( .NOT.WNTVN ) THEN MAXWRK = MAX( MAXWRK, 2*N+LWORK_CUNGBR_P ) - MINWRK = 2*N + M END IF + MINWRK = 2*N + M END IF ELSE IF( MINMN.GT.0 ) THEN * @@ -472,25 +472,25 @@ MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 ) * Compute space needed for CGELQF CALL CGELQF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGELQF=CDUM(1) + LWORK_CGELQF = INT( CDUM(1) ) * Compute space needed for CUNGLQ CALL CUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), -1, $ IERR ) - LWORK_CUNGLQ_N=CDUM(1) + LWORK_CUNGLQ_N = INT( CDUM(1) ) CALL CUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_CUNGLQ_M=CDUM(1) + LWORK_CUNGLQ_M = INT( CDUM(1) ) * Compute space needed for CGEBRD CALL CGEBRD( M, M, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGEBRD=CDUM(1) + LWORK_CGEBRD = INT( CDUM(1) ) * Compute space needed for CUNGBR P CALL CUNGBR( 'P', M, M, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_P=CDUM(1) + LWORK_CUNGBR_P = INT( CDUM(1) ) * Compute space needed for CUNGBR Q CALL CUNGBR( 'Q', M, M, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_Q=CDUM(1) + LWORK_CUNGBR_Q = INT( CDUM(1) ) IF( N.GE.MNTHR ) THEN IF( WNTVN ) THEN * @@ -596,25 +596,25 @@ * CALL CGEBRD( M, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGEBRD=CDUM(1) + LWORK_CGEBRD = INT( CDUM(1) ) MAXWRK = 2*M + LWORK_CGEBRD IF( WNTVS .OR. WNTVO ) THEN * Compute space needed for CUNGBR P CALL CUNGBR( 'P', M, N, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_P=CDUM(1) + LWORK_CUNGBR_P = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*M+LWORK_CUNGBR_P ) END IF IF( WNTVA ) THEN CALL CUNGBR( 'P', N, N, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_P=CDUM(1) + LWORK_CUNGBR_P = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*M+LWORK_CUNGBR_P ) END IF IF( .NOT.WNTUN ) THEN MAXWRK = MAX( MAXWRK, 2*M+LWORK_CUNGBR_Q ) - MINWRK = 2*M + N END IF + MINWRK = 2*M + N END IF END IF MAXWRK = MAX( MINWRK, MAXWRK ) @@ -681,8 +681,10 @@ * * Zero out below R * - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ), + $ LDA ) + END IF IE = 1 ITAUQ = 1 ITAUP = ITAUQ + N @@ -1145,8 +1147,10 @@ * * Zero out below R in A * - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1322,8 +1326,10 @@ * * Zero out below R in A * - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1650,8 +1656,10 @@ * * Zero out below R in A * - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1831,8 +1839,10 @@ * * Zero out below R in A * - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) diff --git a/lapack-netlib/SRC/cgesvdx.f b/lapack-netlib/SRC/cgesvdx.f index 235426ad4..1e32637c6 100644 --- a/lapack-netlib/SRC/cgesvdx.f +++ b/lapack-netlib/SRC/cgesvdx.f @@ -124,13 +124,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL -*> VL >=0. +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -138,13 +140,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -170,7 +176,7 @@ *> vectors, stored columnwise) as specified by RANGE; if *> JOBU = 'N', U is not referenced. *> Note: The user must ensure that UCOL >= NS; if RANGE = 'V', -*> the exact value of NS is not known ILQFin advance and an upper +*> the exact value of NS is not known in advance and an upper *> bound must be used. *> \endverbatim *> @@ -255,7 +261,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexGEsing * @@ -264,10 +270,10 @@ $ IL, IU, NS, S, U, LDU, VT, LDVT, WORK, $ LWORK, RWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU, JOBVT, RANGE @@ -294,8 +300,8 @@ CHARACTER JOBZ, RNGTGK LOGICAL ALLS, INDS, LQUERY, VALS, WANTU, WANTVT INTEGER I, ID, IE, IERR, ILQF, ILTGK, IQRF, ISCL, - $ ITAU, ITAUP, ITAUQ, ITEMP, ITGKZ, IUTGK, - $ J, K, MAXWRK, MINMN, MINWRK, MNTHR + $ ITAU, ITAUP, ITAUQ, ITEMP, ITEMPR, ITGKZ, + $ IUTGK, J, K, MAXWRK, MINMN, MINWRK, MNTHR REAL ABSTOL, ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. @@ -367,8 +373,14 @@ IF( INFO.EQ.0 ) THEN IF( WANTU .AND. LDU.LT.M ) THEN INFO = -15 - ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN - INFO = -16 + ELSE IF( WANTVT ) THEN + IF( INDS ) THEN + IF( LDVT.LT.IU-IL+1 ) THEN + INFO = -17 + END IF + ELSE IF( LDVT.LT.MINMN ) THEN + INFO = -17 + END IF END IF END IF END IF @@ -390,18 +402,24 @@ * * Path 1 (M much larger than N) * - MAXWRK = N + N* - $ ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, N*N + N + 2*N* - $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - MINWRK = N*(N+4) + MINWRK = N*(N+5) + MAXWRK = N + N*ILAENV(1,'CGEQRF',' ',M,N,-1,-1) + MAXWRK = MAX(MAXWRK, + $ N*N+2*N+2*N*ILAENV(1,'CGEBRD',' ',N,N,-1,-1)) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ N*N+2*N+N*ILAENV(1,'CUNMQR','LN',N,N,N,-1)) + END IF ELSE * * Path 2 (M at least N, but not much larger) * - MAXWRK = 2*N + ( M+N )* - $ ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) - MINWRK = 2*N + M + MINWRK = 3*N + M + MAXWRK = 2*N + (M+N)*ILAENV(1,'CGEBRD',' ',M,N,-1,-1) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ 2*N+N*ILAENV(1,'CUNMQR','LN',N,N,N,-1)) + END IF END IF ELSE MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 ) @@ -409,18 +427,25 @@ * * Path 1t (N much larger than M) * - MAXWRK = M + M* - $ ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, M*M + M + 2*M* - $ ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) ) - MINWRK = M*(M+4) + MINWRK = M*(M+5) + MAXWRK = M + M*ILAENV(1,'CGELQF',' ',M,N,-1,-1) + MAXWRK = MAX(MAXWRK, + $ M*M+2*M+2*M*ILAENV(1,'CGEBRD',' ',M,M,-1,-1)) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ M*M+2*M+M*ILAENV(1,'CUNMQR','LN',M,M,M,-1)) + END IF ELSE * * Path 2t (N greater than M, but not much larger) * - MAXWRK = M*(M*2+19) + ( M+N )* - $ ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) - MINWRK = 2*M + N +* + MINWRK = 3*M + N + MAXWRK = 2*M + (M+N)*ILAENV(1,'CGEBRD',' ',M,N,-1,-1) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ 2*M+M*ILAENV(1,'CUNMQR','LN',M,M,M,-1)) + END IF END IF END IF END IF @@ -447,8 +472,6 @@ * * Set singular values indices accord to RANGE='A'. * - ALLS = LSAME( RANGE, 'A' ) - INDS = LSAME( RANGE, 'I' ) IF( ALLS ) THEN RNGTGK = 'I' ILTGK = 1 @@ -518,14 +541,14 @@ CALL CGEBRD( N, N, WORK( IQRF ), N, RWORK( ID ), $ RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), $ WORK( ITEMP ), LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + N*(N*2+1) + ITEMPR = ITGKZ + N*(N*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*N*N+14*N) * CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), N*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), N*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -539,7 +562,7 @@ END DO K = K + N END DO - CALL CLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU ) + CALL CLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU) * * Call CUNMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -594,14 +617,14 @@ CALL CGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + N*(N*2+1) + ITEMPR = ITGKZ + N*(N*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*N*N+14*N) * CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), N*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), N*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -615,7 +638,7 @@ END DO K = K + N END DO - CALL CLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU ) + CALL CLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU) * * Call CUNMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -681,14 +704,14 @@ CALL CGEBRD( M, M, WORK( ILQF ), M, RWORK( ID ), $ RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), $ WORK( ITEMP ), LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + M*(M*2+1) + ITEMPR = ITGKZ + M*(M*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*M*M+14*M) * CALL SBDSVDX( 'U', JOBZ, RNGTGK, M, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), M*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -722,7 +745,7 @@ END DO K = K + M END DO - CALL CLASET( 'A', M, N-M, CZERO, CZERO, + CALL CLASET( 'A', NS, N-M, CZERO, CZERO, $ VT( 1,M+1 ), LDVT ) * * Call CUNMBR to compute (VB**T)*(PB**T) @@ -758,14 +781,14 @@ CALL CGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + M*(M*2+1) + ITEMPR = ITGKZ + M*(M*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*M*M+14*M) * CALL SBDSVDX( 'L', JOBZ, RNGTGK, M, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), M*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -799,7 +822,7 @@ END DO K = K + M END DO - CALL CLASET( 'A', M, N-M, CZERO, CZERO, + CALL CLASET( 'A', NS, N-M, CZERO, CZERO, $ VT( 1,M+1 ), LDVT ) * * Call CUNMBR to compute VB**T * PB**T diff --git a/lapack-netlib/SRC/cgesvj.f b/lapack-netlib/SRC/cgesvj.f index 69d77048b..28f3eb305 100644 --- a/lapack-netlib/SRC/cgesvj.f +++ b/lapack-netlib/SRC/cgesvj.f @@ -205,6 +205,7 @@ *> \endverbatim *> *> \param[in,out] CWORK +*> \verbatim *> CWORK is COMPLEX array, dimension M+N. *> Used as work space. *> \endverbatim @@ -213,8 +214,10 @@ *> \verbatim *> LWORK is INTEGER *> Length of CWORK, LWORK >= M+N. +*> \endverbatim *> *> \param[in,out] RWORK +*> \verbatim *> RWORK is REAL array, dimension max(6,M+N). *> On entry, *> If JOBU .EQ. 'C' : @@ -244,6 +247,7 @@ *> \endverbatim *> *> \param[in] LRWORK +*> \verbatim *> LRWORK is INTEGER *> Length of RWORK, LRWORK >= MAX(6,N). *> \endverbatim @@ -266,7 +270,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexGEcomputational * @@ -326,10 +330,10 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ LDV, CWORK, LWORK, RWORK, LRWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * IMPLICIT NONE * .. Scalar Arguments .. @@ -387,7 +391,7 @@ * from BLAS EXTERNAL CCOPY, CROT, CSSCAL, CSWAP * from LAPACK - EXTERNAL CLASCL, CLASET, CLASSQ, XERBLA + EXTERNAL CLASCL, CLASET, CLASSQ, SLASCL, XERBLA EXTERNAL CGSVJ0, CGSVJ1 * .. * .. Executable Statements .. @@ -889,7 +893,6 @@ END IF END IF * - OMPQ = AAPQ / ABS(AAPQ) * AAPQ = AAPQ * CONJG( CWORK(p) ) * CWORK(q) AAPQ1 = -ABS(AAPQ) MXAAPQ = AMAX1( MXAAPQ, -AAPQ1 ) @@ -909,6 +912,7 @@ * IF( ROTOK ) THEN * + OMPQ = AAPQ / ABS(AAPQ) AQOAP = AAQQ / AAPP APOAQ = AAPP / AAQQ THETA = -HALF*ABS( AQOAP-APOAQ )/AAPQ1 @@ -1110,7 +1114,6 @@ END IF END IF * - OMPQ = AAPQ / ABS(AAPQ) * AAPQ = AAPQ * CONJG(CWORK(p))*CWORK(q) AAPQ1 = -ABS(AAPQ) MXAAPQ = AMAX1( MXAAPQ, -AAPQ1 ) @@ -1125,6 +1128,7 @@ * IF( ROTOK ) THEN * + OMPQ = AAPQ / ABS(AAPQ) AQOAP = AAQQ / AAPP APOAQ = AAPP / AAQQ THETA = -HALF*ABS( AQOAP-APOAQ )/ AAPQ1 diff --git a/lapack-netlib/SRC/cgetc2.f b/lapack-netlib/SRC/cgetc2.f index 99eb69d92..021ec6724 100644 --- a/lapack-netlib/SRC/cgetc2.f +++ b/lapack-netlib/SRC/cgetc2.f @@ -98,7 +98,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complexGEauxiliary * @@ -111,10 +111,10 @@ * ===================================================================== SUBROUTINE CGETC2( N, A, LDA, IPIV, JPIV, INFO ) * -* -- LAPACK auxiliary routine (version 3.5.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, N diff --git a/lapack-netlib/SRC/cgetrf2.f b/lapack-netlib/SRC/cgetrf2.f index 9e985d0e2..d761806eb 100644 --- a/lapack-netlib/SRC/cgetrf2.f +++ b/lapack-netlib/SRC/cgetrf2.f @@ -37,7 +37,7 @@ *> the matrix into four submatrices: *> *> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2 -*> A = [ -----|----- ] with n1 = min(m,n) +*> A = [ -----|----- ] with n1 = min(m,n)/2 *> [ A21 | A22 ] n2 = n-n1 *> *> [ A11 ] @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexGEcomputational * * ===================================================================== RECURSIVE SUBROUTINE CGETRF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/cgges3.f b/lapack-netlib/SRC/cgges3.f index 9103ccf1c..876a26df9 100644 --- a/lapack-netlib/SRC/cgges3.f +++ b/lapack-netlib/SRC/cgges3.f @@ -269,7 +269,7 @@ $ LDB, SDIM, ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, $ WORK, LWORK, RWORK, BWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -394,7 +394,7 @@ LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) CALL CHGEQZ( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, -1, - $ WORK, IERR ) + $ RWORK, IERR ) LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) ) IF( WANTST ) THEN CALL CTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, diff --git a/lapack-netlib/SRC/cggev3.f b/lapack-netlib/SRC/cggev3.f index decdae509..f34b8f2c4 100644 --- a/lapack-netlib/SRC/cggev3.f +++ b/lapack-netlib/SRC/cggev3.f @@ -216,7 +216,7 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, $ VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 diff --git a/lapack-netlib/SRC/cgghd3.f b/lapack-netlib/SRC/cgghd3.f index 112b41a17..a9468a24b 100644 --- a/lapack-netlib/SRC/cgghd3.f +++ b/lapack-netlib/SRC/cgghd3.f @@ -231,7 +231,7 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -282,7 +282,7 @@ * INFO = 0 NB = ILAENV( 1, 'CGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = 6*N*NB + LWKOPT = MAX( 6*N*NB, 1 ) WORK( 1 ) = CMPLX( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) diff --git a/lapack-netlib/SRC/cggsvp3.f b/lapack-netlib/SRC/cggsvp3.f index 36fe9913b..feee3644f 100644 --- a/lapack-netlib/SRC/cggsvp3.f +++ b/lapack-netlib/SRC/cggsvp3.f @@ -278,7 +278,7 @@ $ TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, $ IWORK, RWORK, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * August 2015 @@ -308,7 +308,6 @@ * .. Local Scalars .. LOGICAL FORWRD, WANTQ, WANTU, WANTV, LQUERY INTEGER I, J, LWKOPT - COMPLEX T * .. * .. External Functions .. LOGICAL LSAME diff --git a/lapack-netlib/SRC/cgsvj0.f b/lapack-netlib/SRC/cgsvj0.f index 79ffde623..66074bdb1 100644 --- a/lapack-netlib/SRC/cgsvj0.f +++ b/lapack-netlib/SRC/cgsvj0.f @@ -1,4 +1,4 @@ -*> \brief \b CGSVJ0 pre-processor for the routine sgesvj. +*> \brief \b CGSVJ0 pre-processor for the routine cgesvj. * * =========== DOCUMENTATION =========== * @@ -193,7 +193,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -218,10 +218,10 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ SFMIN, TOL, NSWEEP, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * IMPLICIT NONE * .. Scalar Arguments .. diff --git a/lapack-netlib/SRC/cgsvj1.f b/lapack-netlib/SRC/cgsvj1.f index f4b1fc156..ca71a4eae 100644 --- a/lapack-netlib/SRC/cgsvj1.f +++ b/lapack-netlib/SRC/cgsvj1.f @@ -1,4 +1,4 @@ -*> \brief \b CGSVJ1 pre-processor for the routine sgesvj, applies Jacobi rotations targeting only particular pivots. +*> \brief \b CGSVJ1 pre-processor for the routine cgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== * @@ -105,7 +105,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is REAL array, dimension (LDA,N) +*> A is COMPLEX array, dimension (LDA,N) *> On entry, M-by-N matrix A, such that A*diag(D) represents *> the input matrix. *> On exit, @@ -124,7 +124,7 @@ *> *> \param[in,out] D *> \verbatim -*> D is REAL array, dimension (N) +*> D is COMPLEX array, dimension (N) *> The array D accumulates the scaling factors from the fast scaled *> Jacobi rotations. *> On entry, A*diag(D) represents the input matrix. @@ -154,7 +154,7 @@ *> *> \param[in,out] V *> \verbatim -*> V is REAL array, dimension (LDV,N) +*> V is COMPLEX array, dimension (LDV,N) *> If JOBV .EQ. 'V' then N rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a @@ -223,7 +223,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -236,10 +236,10 @@ SUBROUTINE CGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. REAL EPS, SFMIN, TOL diff --git a/lapack-netlib/SRC/chbevx.f b/lapack-netlib/SRC/chbevx.f index d9a22e350..47dd8069e 100644 --- a/lapack-netlib/SRC/chbevx.f +++ b/lapack-netlib/SRC/chbevx.f @@ -123,12 +123,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -136,13 +139,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -251,7 +258,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexOTHEReigen * @@ -260,10 +267,10 @@ $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/chbgvd.f b/lapack-netlib/SRC/chbgvd.f index e57bd9375..64dd1f6de 100644 --- a/lapack-netlib/SRC/chbgvd.f +++ b/lapack-netlib/SRC/chbgvd.f @@ -238,7 +238,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHEReigen * @@ -252,10 +252,10 @@ $ Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO @@ -372,7 +372,7 @@ LLWK2 = LWORK - INDWK2 + 2 LLRWK = LRWORK - INDWRK + 2 CALL CHBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ, - $ WORK, RWORK( INDWRK ), IINFO ) + $ WORK, RWORK, IINFO ) * * Reduce Hermitian band matrix to tridiagonal form. * diff --git a/lapack-netlib/SRC/chbgvx.f b/lapack-netlib/SRC/chbgvx.f index 5e28cc88f..43ae794d5 100644 --- a/lapack-netlib/SRC/chbgvx.f +++ b/lapack-netlib/SRC/chbgvx.f @@ -153,13 +153,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -167,14 +171,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -277,7 +286,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHEReigen * @@ -291,10 +300,10 @@ $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, $ LDZ, WORK, RWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/cheevr.f b/lapack-netlib/SRC/cheevr.f index 18dfe4313..9b8ffb4e3 100644 --- a/lapack-netlib/SRC/cheevr.f +++ b/lapack-netlib/SRC/cheevr.f @@ -155,12 +155,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -168,13 +171,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -329,7 +336,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexHEeigen * @@ -348,10 +355,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/cheevx.f b/lapack-netlib/SRC/cheevx.f index 12f69ccc9..f41479bd1 100644 --- a/lapack-netlib/SRC/cheevx.f +++ b/lapack-netlib/SRC/cheevx.f @@ -99,12 +99,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -112,13 +115,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -243,7 +250,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexHEeigen * @@ -252,10 +259,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/chegvx.f b/lapack-netlib/SRC/chegvx.f index 33a4e5f4a..52fb983d2 100644 --- a/lapack-netlib/SRC/chegvx.f +++ b/lapack-netlib/SRC/chegvx.f @@ -132,13 +132,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -146,14 +150,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -284,7 +293,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexHEeigen * @@ -298,10 +307,10 @@ $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, $ LWORK, RWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/chetrf_rook.f b/lapack-netlib/SRC/chetrf_rook.f index 98c8dbd26..0217150d1 100644 --- a/lapack-netlib/SRC/chetrf_rook.f +++ b/lapack-netlib/SRC/chetrf_rook.f @@ -150,7 +150,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complexHEcomputational * @@ -199,7 +199,7 @@ *> *> \verbatim *> -*> November 2013, Igor Kozachenko, +*> June 2016, Igor Kozachenko, *> Computer Science Division, *> University of California, Berkeley *> @@ -212,10 +212,10 @@ * ===================================================================== SUBROUTINE CHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -265,7 +265,7 @@ * Determine the block size * NB = ILAENV( 1, 'CHETRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/chgeqz.f b/lapack-netlib/SRC/chgeqz.f index 024354e66..15aaaa44d 100644 --- a/lapack-netlib/SRC/chgeqz.f +++ b/lapack-netlib/SRC/chgeqz.f @@ -190,12 +190,12 @@ *> \param[in,out] Q *> \verbatim *> Q is COMPLEX array, dimension (LDQ, N) -*> On entry, if COMPZ = 'V', the unitary matrix Q1 used in the +*> On entry, if COMPQ = 'V', the unitary matrix Q1 used in the *> reduction of (A,B) to generalized Hessenberg form. -*> On exit, if COMPZ = 'I', the unitary matrix of left Schur -*> vectors of (H,T), and if COMPZ = 'V', the unitary matrix of +*> On exit, if COMPQ = 'I', the unitary matrix of left Schur +*> vectors of (H,T), and if COMPQ = 'V', the unitary matrix of *> left Schur vectors of (A,B). -*> Not referenced if COMPZ = 'N'. +*> Not referenced if COMPQ = 'N'. *> \endverbatim *> *> \param[in] LDQ @@ -284,7 +284,7 @@ $ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, $ RWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 diff --git a/lapack-netlib/SRC/chpevx.f b/lapack-netlib/SRC/chpevx.f index e7bd2c4f4..e6bf245e0 100644 --- a/lapack-netlib/SRC/chpevx.f +++ b/lapack-netlib/SRC/chpevx.f @@ -97,12 +97,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -110,13 +113,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -224,7 +231,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexOTHEReigen * @@ -233,10 +240,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/chpgvx.f b/lapack-netlib/SRC/chpgvx.f index ee100984c..cc4b296bc 100644 --- a/lapack-netlib/SRC/chpgvx.f +++ b/lapack-netlib/SRC/chpgvx.f @@ -118,13 +118,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,14 +136,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -254,7 +263,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHEReigen * @@ -268,10 +277,10 @@ $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/cla_gbamv.f b/lapack-netlib/SRC/cla_gbamv.f index b74156dbc..074ca90a3 100644 --- a/lapack-netlib/SRC/cla_gbamv.f +++ b/lapack-netlib/SRC/cla_gbamv.f @@ -107,7 +107,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is REAL array, dimension (LDAB,n) +*> AB is COMPLEX array, dimension (LDAB,n) *> Before entry, the leading m by n part of the array AB must *> contain the matrix of coefficients. *> Unchanged on exit. @@ -124,7 +124,7 @@ *> *> \param[in] X *> \verbatim -*> X is REAL array, dimension +*> X is COMPLEX array, dimension *> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' *> and at least *> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. @@ -178,7 +178,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexGBcomputational * @@ -186,10 +186,10 @@ SUBROUTINE CLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X, $ INCX, BETA, Y, INCY ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. REAL ALPHA, BETA diff --git a/lapack-netlib/SRC/cla_herpvgrw.f b/lapack-netlib/SRC/cla_herpvgrw.f index dc05aedc9..9326299c7 100644 --- a/lapack-netlib/SRC/cla_herpvgrw.f +++ b/lapack-netlib/SRC/cla_herpvgrw.f @@ -104,7 +104,7 @@ *> *> \param[in] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (2*N) +*> WORK is REAL array, dimension (2*N) *> \endverbatim * * Authors: @@ -115,7 +115,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexHEcomputational * @@ -123,10 +123,10 @@ REAL FUNCTION CLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, $ WORK ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER*1 UPLO diff --git a/lapack-netlib/SRC/cla_lin_berr.f b/lapack-netlib/SRC/cla_lin_berr.f index 94db81439..4ac5abec8 100644 --- a/lapack-netlib/SRC/cla_lin_berr.f +++ b/lapack-netlib/SRC/cla_lin_berr.f @@ -67,7 +67,7 @@ *> *> \param[in] RES *> \verbatim -*> RES is REAL array, dimension (N,NRHS) +*> RES is COMPLEX array, dimension (N,NRHS) *> The residual matrix, i.e., the matrix R in the relative backward *> error formula above. *> \endverbatim @@ -82,7 +82,7 @@ *> *> \param[out] BERR *> \verbatim -*> BERR is COMPLEX array, dimension (NRHS) +*> BERR is REAL array, dimension (NRHS) *> The componentwise relative backward error from the formula above. *> \endverbatim * @@ -94,17 +94,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * * ===================================================================== SUBROUTINE CLA_LIN_BERR ( N, NZ, NRHS, RES, AYB, BERR ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. INTEGER N, NZ, NRHS diff --git a/lapack-netlib/SRC/cla_porcond_c.f b/lapack-netlib/SRC/cla_porcond_c.f index 8e2b98371..01e07a148 100644 --- a/lapack-netlib/SRC/cla_porcond_c.f +++ b/lapack-netlib/SRC/cla_porcond_c.f @@ -38,7 +38,7 @@ *> \verbatim *> *> CLA_PORCOND_C Computes the infinity norm condition number of -*> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector +*> op(A) * inv(diag(C)) where C is a REAL vector *> \endverbatim * * Arguments: @@ -122,7 +122,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexPOcomputational * @@ -130,10 +130,10 @@ REAL FUNCTION CLA_PORCOND_C( UPLO, N, A, LDA, AF, LDAF, C, CAPPLY, $ INFO, WORK, RWORK ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/cla_porpvgrw.f b/lapack-netlib/SRC/cla_porpvgrw.f index 607752ada..d60cfe622 100644 --- a/lapack-netlib/SRC/cla_porpvgrw.f +++ b/lapack-netlib/SRC/cla_porpvgrw.f @@ -87,7 +87,7 @@ *> *> \param[in] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (2*N) +*> WORK is REAL array, dimension (2*N) *> \endverbatim * * Authors: @@ -98,17 +98,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexPOcomputational * * ===================================================================== REAL FUNCTION CLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, WORK ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER*1 UPLO diff --git a/lapack-netlib/SRC/claed7.f b/lapack-netlib/SRC/claed7.f index c1441393c..a42ee6817 100644 --- a/lapack-netlib/SRC/claed7.f +++ b/lapack-netlib/SRC/claed7.f @@ -57,7 +57,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine SLAED2. *> @@ -239,7 +239,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -249,10 +249,10 @@ $ GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER CURLVL, CURPBM, CUTPNT, INFO, LDQ, N, QSIZ, diff --git a/lapack-netlib/SRC/claqr3.f b/lapack-netlib/SRC/claqr3.f index 53e0e3c42..f3ee410ba 100644 --- a/lapack-netlib/SRC/claqr3.f +++ b/lapack-netlib/SRC/claqr3.f @@ -137,7 +137,7 @@ *> Z is COMPLEX array, dimension (LDZ,N) *> IF WANTZ is .TRUE., then on output, the unitary *> similarity transformation mentioned above has been -*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> accumulated into Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ is .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -251,7 +251,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * @@ -266,10 +266,10 @@ $ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, $ NV, WV, LDWV, WORK, LWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, diff --git a/lapack-netlib/SRC/claqr5.f b/lapack-netlib/SRC/claqr5.f index fc412c4da..22e55def5 100644 --- a/lapack-netlib/SRC/claqr5.f +++ b/lapack-netlib/SRC/claqr5.f @@ -142,10 +142,10 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is COMPLEX array of size (LDZ,IHI) +*> Z is COMPLEX array of size (LDZ,IHIZ) *> If WANTZ = .TRUE., then the QR Sweep unitary *> similarity transformation is accumulated into -*> Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ = .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -228,7 +228,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * @@ -251,10 +251,10 @@ $ H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV, $ WV, LDWV, NH, WH, LDWH ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, diff --git a/lapack-netlib/SRC/clarcm.f b/lapack-netlib/SRC/clarcm.f index 30a920437..63038ec2d 100644 --- a/lapack-netlib/SRC/clarcm.f +++ b/lapack-netlib/SRC/clarcm.f @@ -72,7 +72,7 @@ *> *> \param[in] B *> \verbatim -*> B is REAL array, dimension (LDB, N) +*> B is COMPLEX array, dimension (LDB, N) *> B contains the M by N matrix B. *> \endverbatim *> @@ -107,17 +107,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * * ===================================================================== SUBROUTINE CLARCM( M, N, A, LDA, B, LDB, C, LDC, RWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB, LDC, M, N diff --git a/lapack-netlib/SRC/clarrv.f b/lapack-netlib/SRC/clarrv.f index ecedfa4d2..31f374cb8 100644 --- a/lapack-netlib/SRC/clarrv.f +++ b/lapack-netlib/SRC/clarrv.f @@ -59,12 +59,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> Lower bound of the interval that contains the desired +*> eigenvalues. VL < VU. Needed to compute gaps on the left or right +*> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> Lower and upper bounds of the interval that contains the desired +*> Upper bound of the interval that contains the desired *> eigenvalues. VL < VU. Needed to compute gaps on the left or right *> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim @@ -81,7 +84,7 @@ *> L is REAL array, dimension (N) *> On entry, the (N-1) subdiagonal elements of the unit *> bidiagonal matrix L are in elements 1 to N-1 of L -*> (if the matrix is not splitted.) At the end of each block +*> (if the matrix is not split.) At the end of each block *> is stored the corresponding shift as given by SLARRE. *> On exit, L is overwritten. *> \endverbatim @@ -236,7 +239,7 @@ *> INFO is INTEGER *> = 0: successful exit *> -*> > 0: A problem occured in CLARRV. +*> > 0: A problem occurred in CLARRV. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -263,7 +266,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * @@ -283,10 +286,10 @@ $ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER DOL, DOU, INFO, LDZ, M, N diff --git a/lapack-netlib/SRC/clarscl2.f b/lapack-netlib/SRC/clarscl2.f index ada9535c3..77876771f 100644 --- a/lapack-netlib/SRC/clarscl2.f +++ b/lapack-netlib/SRC/clarscl2.f @@ -73,7 +73,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -84,17 +84,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * * ===================================================================== SUBROUTINE CLARSCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/clascl.f b/lapack-netlib/SRC/clascl.f index a5ab897ba..776d6cd32 100644 --- a/lapack-netlib/SRC/clascl.f +++ b/lapack-netlib/SRC/clascl.f @@ -114,7 +114,11 @@ *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). +*> The leading dimension of the array A. +*> If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M); +*> TYPE = 'B', LDA >= KL+1; +*> TYPE = 'Q', LDA >= KU+1; +*> TYPE = 'Z', LDA >= 2*KL+KU+1. *> \endverbatim *> *> \param[out] INFO @@ -132,17 +136,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * * ===================================================================== SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER TYPE diff --git a/lapack-netlib/SRC/clascl2.f b/lapack-netlib/SRC/clascl2.f index f45f85e18..01fbe6980 100644 --- a/lapack-netlib/SRC/clascl2.f +++ b/lapack-netlib/SRC/clascl2.f @@ -73,7 +73,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -84,17 +84,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * * ===================================================================== SUBROUTINE CLASCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/clatdf.f b/lapack-netlib/SRC/clatdf.f index 11f0dfd9b..ff56cdeb8 100644 --- a/lapack-netlib/SRC/clatdf.f +++ b/lapack-netlib/SRC/clatdf.f @@ -58,7 +58,7 @@ *> Zx = +-e - f with the sign giving the greater value of *> 2-norm(x). About 5 times as expensive as Default. *> IJOB .ne. 2: Local look ahead strategy where -*> all entries of the r.h.s. b is choosen as either +1 or +*> all entries of the r.h.s. b is chosen as either +1 or *> -1. Default. *> \endverbatim *> @@ -70,7 +70,7 @@ *> *> \param[in] Z *> \verbatim -*> Z is REAL array, dimension (LDZ, N) +*> Z is COMPLEX array, dimension (LDZ, N) *> On entry, the LU part of the factorization of the n-by-n *> matrix Z computed by CGETC2: Z = P * L * U * Q *> \endverbatim @@ -83,7 +83,7 @@ *> *> \param[in,out] RHS *> \verbatim -*> RHS is REAL array, dimension (N). +*> RHS is COMPLEX array, dimension (N). *> On entry, RHS contains contributions from other subsystems. *> On exit, RHS contains the solution of the subsystem with *> entries according to the value of IJOB (see above). @@ -134,7 +134,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * @@ -169,10 +169,10 @@ SUBROUTINE CLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, $ JPIV ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IJOB, LDZ, N diff --git a/lapack-netlib/SRC/cpotrf2.f b/lapack-netlib/SRC/cpotrf2.f index 6ab06a637..dfd06fa9e 100644 --- a/lapack-netlib/SRC/cpotrf2.f +++ b/lapack-netlib/SRC/cpotrf2.f @@ -62,7 +62,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is DOUBLE PRECISION array, dimension (LDA,N) +*> A is COMPLEX array, dimension (LDA,N) *> On entry, the symmetric matrix A. If UPLO = 'U', the leading *> N-by-N upper triangular part of A contains the upper *> triangular part of the matrix A, and the strictly lower @@ -99,17 +99,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexPOcomputational * * ===================================================================== RECURSIVE SUBROUTINE CPOTRF2( UPLO, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/cpttrs.f b/lapack-netlib/SRC/cpttrs.f index 4214dd11d..68f650e02 100644 --- a/lapack-netlib/SRC/cpttrs.f +++ b/lapack-netlib/SRC/cpttrs.f @@ -87,7 +87,7 @@ *> *> \param[in,out] B *> \verbatim -*> B is REAL array, dimension (LDB,NRHS) +*> B is COMPLEX array, dimension (LDB,NRHS) *> On entry, the right hand side vectors B for the system of *> linear equations. *> On exit, the solution vectors, X. @@ -114,17 +114,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexPTcomputational * * ===================================================================== SUBROUTINE CPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/cptts2.f b/lapack-netlib/SRC/cptts2.f index 379ca4956..c545b8fec 100644 --- a/lapack-netlib/SRC/cptts2.f +++ b/lapack-netlib/SRC/cptts2.f @@ -86,7 +86,7 @@ *> *> \param[in,out] B *> \verbatim -*> B is REAL array, dimension (LDB,NRHS) +*> B is COMPLEX array, dimension (LDB,NRHS) *> On entry, the right hand side vectors B for the system of *> linear equations. *> On exit, the solution vectors, X. @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexPTcomputational * * ===================================================================== SUBROUTINE CPTTS2( IUPLO, N, NRHS, D, E, B, LDB ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IUPLO, LDB, N, NRHS diff --git a/lapack-netlib/SRC/cstegr.f b/lapack-netlib/SRC/cstegr.f index 6e1eae055..aaecf36dd 100644 --- a/lapack-netlib/SRC/cstegr.f +++ b/lapack-netlib/SRC/cstegr.f @@ -48,7 +48,7 @@ *> either an interval (VL,VU] or a range of indices IL:IU for the desired *> eigenvalues. *> -*> CSTEGR is a compatability wrapper around the improved CSTEMR routine. +*> CSTEGR is a compatibility wrapper around the improved CSTEMR routine. *> See SSTEMR for further details. *> *> One important change is that the ABSTOL parameter no longer provides any @@ -105,13 +105,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -119,14 +123,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -240,7 +249,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -256,10 +265,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/cstemr.f b/lapack-netlib/SRC/cstemr.f index 29734964b..90f050ad7 100644 --- a/lapack-netlib/SRC/cstemr.f +++ b/lapack-netlib/SRC/cstemr.f @@ -153,13 +153,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -167,14 +171,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -311,7 +320,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -329,10 +338,10 @@ $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/csytrf_rook.f b/lapack-netlib/SRC/csytrf_rook.f index fab048162..139569f9b 100644 --- a/lapack-netlib/SRC/csytrf_rook.f +++ b/lapack-netlib/SRC/csytrf_rook.f @@ -146,7 +146,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexSYcomputational * @@ -195,7 +195,7 @@ *> *> \verbatim *> -*> November 2015, Igor Kozachenko, +*> June 2016, Igor Kozachenko, *> Computer Science Division, *> University of California, Berkeley *> @@ -208,10 +208,10 @@ * ===================================================================== SUBROUTINE CSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -261,7 +261,7 @@ * Determine the block size * NB = ILAENV( 1, 'CSYTRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/ctgsen.f b/lapack-netlib/SRC/ctgsen.f index d2ba8de8a..3de430bf1 100644 --- a/lapack-netlib/SRC/ctgsen.f +++ b/lapack-netlib/SRC/ctgsen.f @@ -290,7 +290,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -433,10 +433,10 @@ $ ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, $ WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL WANTQ, WANTZ @@ -515,6 +515,7 @@ * subspaces. * M = 0 + IF( .NOT.LQUERY .OR. IJOB.NE.0 ) THEN DO 10 K = 1, N ALPHA( K ) = A( K, K ) BETA( K ) = B( K, K ) @@ -526,6 +527,7 @@ $ M = M + 1 END IF 10 CONTINUE + END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN LWMIN = MAX( 1, 2*M*(N-M) ) diff --git a/lapack-netlib/SRC/ctrevc3.f b/lapack-netlib/SRC/ctrevc3.f new file mode 100644 index 000000000..00d3b9464 --- /dev/null +++ b/lapack-netlib/SRC/ctrevc3.f @@ -0,0 +1,630 @@ +*> \brief \b CTREVC3 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download CTREVC3 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, +* VR, LDVR, MM, M, WORK, LWORK, RWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER HOWMNY, SIDE +* INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. +* LOGICAL SELECT( * ) +* REAL RWORK( * ) +* COMPLEX T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), +* $ WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CTREVC3 computes some or all of the right and/or left eigenvectors of +*> a complex upper triangular matrix T. +*> Matrices of this type are produced by the Schur factorization of +*> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. +*> +*> The right eigenvector x and the left eigenvector y of T corresponding +*> to an eigenvalue w are defined by: +*> +*> T*x = w*x, (y**H)*T = w*(y**H) +*> +*> where y**H denotes the conjugate transpose of the vector y. +*> The eigenvalues are not input to this routine, but are read directly +*> from the diagonal of T. +*> +*> This routine returns the matrices X and/or Y of right and left +*> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an +*> input matrix. If Q is the unitary factor that reduces a matrix A to +*> Schur form T, then Q*X and Q*Y are the matrices of right and left +*> eigenvectors of A. +*> +*> This uses a Level 3 BLAS version of the back transformation. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'R': compute right eigenvectors only; +*> = 'L': compute left eigenvectors only; +*> = 'B': compute both right and left eigenvectors. +*> \endverbatim +*> +*> \param[in] HOWMNY +*> \verbatim +*> HOWMNY is CHARACTER*1 +*> = 'A': compute all right and/or left eigenvectors; +*> = 'B': compute all right and/or left eigenvectors, +*> backtransformed using the matrices supplied in +*> VR and/or VL; +*> = 'S': compute selected right and/or left eigenvectors, +*> as indicated by the logical array SELECT. +*> \endverbatim +*> +*> \param[in] SELECT +*> \verbatim +*> SELECT is LOGICAL array, dimension (N) +*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be +*> computed. +*> The eigenvector corresponding to the j-th eigenvalue is +*> computed if SELECT(j) = .TRUE.. +*> Not referenced if HOWMNY = 'A' or 'B'. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the matrix T. N >= 0. +*> \endverbatim +*> +*> \param[in,out] T +*> \verbatim +*> T is COMPLEX array, dimension (LDT,N) +*> The upper triangular matrix T. T is modified, but restored +*> on exit. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= max(1,N). +*> \endverbatim +*> +*> \param[in,out] VL +*> \verbatim +*> VL is COMPLEX array, dimension (LDVL,MM) +*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must +*> contain an N-by-N matrix Q (usually the unitary matrix Q of +*> Schur vectors returned by CHSEQR). +*> On exit, if SIDE = 'L' or 'B', VL contains: +*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*Y; +*> if HOWMNY = 'S', the left eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VL, in the same order as their +*> eigenvalues. +*> Not referenced if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDVL +*> \verbatim +*> LDVL is INTEGER +*> The leading dimension of the array VL. +*> LDVL >= 1, and if SIDE = 'L' or 'B', LDVL >= N. +*> \endverbatim +*> +*> \param[in,out] VR +*> \verbatim +*> VR is COMPLEX array, dimension (LDVR,MM) +*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must +*> contain an N-by-N matrix Q (usually the unitary matrix Q of +*> Schur vectors returned by CHSEQR). +*> On exit, if SIDE = 'R' or 'B', VR contains: +*> if HOWMNY = 'A', the matrix X of right eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*X; +*> if HOWMNY = 'S', the right eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VR, in the same order as their +*> eigenvalues. +*> Not referenced if SIDE = 'L'. +*> \endverbatim +*> +*> \param[in] LDVR +*> \verbatim +*> LDVR is INTEGER +*> The leading dimension of the array VR. +*> LDVR >= 1, and if SIDE = 'R' or 'B', LDVR >= N. +*> \endverbatim +*> +*> \param[in] MM +*> \verbatim +*> MM is INTEGER +*> The number of columns in the arrays VL and/or VR. MM >= M. +*> \endverbatim +*> +*> \param[out] M +*> \verbatim +*> M is INTEGER +*> The number of columns in the arrays VL and/or VR actually +*> used to store the eigenvectors. +*> If HOWMNY = 'A' or 'B', M is set to N. +*> Each selected eigenvector occupies one column. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of array WORK. LWORK >= max(1,2*N). +*> For optimum performance, LWORK >= N + 2*N*NB, 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] RWORK +*> \verbatim +*> RWORK is REAL array, dimension (LRWORK) +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER +*> The dimension of array RWORK. LRWORK >= max(1,N). +*> +*> If LRWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal size of the RWORK array, returns +*> this value as the first entry of the RWORK array, and no error +*> message related to LRWORK 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. +* +*> \date November 2011 +* +* @generated from ztrevc3.f, fortran z -> c, Tue Apr 19 01:47:44 2016 +* +*> \ingroup complexOTHERcomputational +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The algorithm used in this program is basically backward (forward) +*> substitution, with scaling to make the the code robust against +*> possible overflow. +*> +*> Each eigenvector is normalized so that the element of largest +*> magnitude has magnitude 1; here the magnitude of a complex number +*> (x,y) is taken to be |x| + |y|. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + $ LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2011 +* +* .. Scalar Arguments .. + CHARACTER HOWMNY, SIDE + INTEGER INFO, LDT, LDVL, LDVR, LWORK, LRWORK, M, MM, N +* .. +* .. Array Arguments .. + LOGICAL SELECT( * ) + REAL RWORK( * ) + COMPLEX T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), + $ WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) + COMPLEX CZERO, CONE + PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), + $ CONE = ( 1.0E+0, 0.0E+0 ) ) + INTEGER NBMIN, NBMAX + PARAMETER ( NBMIN = 8, NBMAX = 128 ) +* .. +* .. Local Scalars .. + LOGICAL ALLV, BOTHV, LEFTV, LQUERY, OVER, RIGHTV, SOMEV + INTEGER I, II, IS, J, K, KI, IV, MAXWRK, NB + REAL OVFL, REMAX, SCALE, SMIN, SMLNUM, ULP, UNFL + COMPLEX CDUM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV, ICAMAX + REAL SLAMCH, SCASUM + EXTERNAL LSAME, ILAENV, ICAMAX, SLAMCH, SCASUM +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, CCOPY, CSSCAL, CGEMV, CLATRS +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, REAL, CMPLX, CONJG, AIMAG, MAX +* .. +* .. Statement Functions .. + REAL CABS1 +* .. +* .. Statement Function definitions .. + CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) ) +* .. +* .. Executable Statements .. +* +* Decode and test the input parameters +* + BOTHV = LSAME( SIDE, 'B' ) + RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV + LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV +* + ALLV = LSAME( HOWMNY, 'A' ) + OVER = LSAME( HOWMNY, 'B' ) + SOMEV = LSAME( HOWMNY, 'S' ) +* +* Set M to the number of columns required to store the selected +* eigenvectors. +* + IF( SOMEV ) THEN + M = 0 + DO 10 J = 1, N + IF( SELECT( J ) ) + $ M = M + 1 + 10 CONTINUE + ELSE + M = N + END IF +* + INFO = 0 + NB = ILAENV( 1, 'CTREVC', SIDE // HOWMNY, N, -1, -1, -1 ) + MAXWRK = N + 2*N*NB + WORK(1) = MAXWRK + RWORK(1) = N + LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 ) + IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN + INFO = -1 + ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDT.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN + INFO = -8 + ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN + INFO = -10 + ELSE IF( MM.LT.M ) THEN + INFO = -11 + ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + INFO = -14 + ELSE IF ( LRWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN + INFO = -16 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'CTREVC3', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible. +* + IF( N.EQ.0 ) + $ RETURN +* +* Use blocked version of back-transformation if sufficient workspace. +* Zero-out the workspace to avoid potential NaN propagation. +* + IF( OVER .AND. LWORK .GE. N + 2*N*NBMIN ) THEN + NB = (LWORK - N) / (2*N) + NB = MIN( NB, NBMAX ) + CALL CLASET( 'F', N, 1+2*NB, CZERO, CZERO, WORK, N ) + ELSE + NB = 1 + END IF +* +* Set the constants to control overflow. +* + UNFL = SLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL SLABAD( UNFL, OVFL ) + ULP = SLAMCH( 'Precision' ) + SMLNUM = UNFL*( N / ULP ) +* +* Store the diagonal elements of T in working array WORK. +* + DO 20 I = 1, N + WORK( I ) = T( I, I ) + 20 CONTINUE +* +* Compute 1-norm of each column of strictly upper triangular +* part of T to control overflow in triangular solver. +* + RWORK( 1 ) = ZERO + DO 30 J = 2, N + RWORK( J ) = SCASUM( J-1, T( 1, J ), 1 ) + 30 CONTINUE +* + IF( RIGHTV ) THEN +* +* ============================================================ +* Compute right eigenvectors. +* +* IV is index of column in current block. +* Non-blocked version always uses IV=NB=1; +* blocked version starts with IV=NB, goes down to 1. +* (Note the "0-th" column is used to store the original diagonal.) + IV = NB + IS = M + DO 80 KI = N, 1, -1 + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 80 + END IF + SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM ) +* +* -------------------------------------------------------- +* Complex right eigenvector +* + WORK( KI + IV*N ) = CONE +* +* Form right-hand side. +* + DO 40 K = 1, KI - 1 + WORK( K + IV*N ) = -T( K, KI ) + 40 CONTINUE +* +* Solve upper triangular system: +* [ T(1:KI-1,1:KI-1) - T(KI,KI) ]*X = SCALE*WORK. +* + DO 50 K = 1, KI - 1 + T( K, K ) = T( K, K ) - T( KI, KI ) + IF( CABS1( T( K, K ) ).LT.SMIN ) + $ T( K, K ) = SMIN + 50 CONTINUE +* + IF( KI.GT.1 ) THEN + CALL CLATRS( 'Upper', 'No transpose', 'Non-unit', 'Y', + $ KI-1, T, LDT, WORK( 1 + IV*N ), SCALE, + $ RWORK, INFO ) + WORK( KI + IV*N ) = SCALE + END IF +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL CCOPY( KI, WORK( 1 + IV*N ), 1, VR( 1, IS ), 1 ) +* + II = ICAMAX( KI, VR( 1, IS ), 1 ) + REMAX = ONE / CABS1( VR( II, IS ) ) + CALL CSSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 60 K = KI + 1, N + VR( K, IS ) = CZERO + 60 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.1 ) + $ CALL CGEMV( 'N', N, KI-1, CONE, VR, LDVR, + $ WORK( 1 + IV*N ), 1, CMPLX( SCALE ), + $ VR( 1, KI ), 1 ) +* + II = ICAMAX( N, VR( 1, KI ), 1 ) + REMAX = ONE / CABS1( VR( II, KI ) ) + CALL CSSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + IV*N ) = CZERO + END DO +* +* Columns IV:NB of work are valid vectors. +* When the number of vectors stored reaches NB, +* or if this was last vector, do the GEMM + IF( (IV.EQ.1) .OR. (KI.EQ.1) ) THEN + CALL CGEMM( 'N', 'N', N, NB-IV+1, KI+NB-IV, CONE, + $ VR, LDVR, + $ WORK( 1 + (IV)*N ), N, + $ CZERO, + $ WORK( 1 + (NB+IV)*N ), N ) +* normalize vectors + DO K = IV, NB + II = ICAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / CABS1( WORK( II + (NB+K)*N ) ) + CALL CSSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL CLACPY( 'F', N, NB-IV+1, + $ WORK( 1 + (NB+IV)*N ), N, + $ VR( 1, KI ), LDVR ) + IV = NB + ELSE + IV = IV - 1 + END IF + END IF +* +* Restore the original diagonal elements of T. +* + DO 70 K = 1, KI - 1 + T( K, K ) = WORK( K ) + 70 CONTINUE +* + IS = IS - 1 + 80 CONTINUE + END IF +* + IF( LEFTV ) THEN +* +* ============================================================ +* Compute left eigenvectors. +* +* IV is index of column in current block. +* Non-blocked version always uses IV=1; +* blocked version starts with IV=1, goes up to NB. +* (Note the "0-th" column is used to store the original diagonal.) + IV = 1 + IS = 1 + DO 130 KI = 1, N +* + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 130 + END IF + SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM ) +* +* -------------------------------------------------------- +* Complex left eigenvector +* + WORK( KI + IV*N ) = CONE +* +* Form right-hand side. +* + DO 90 K = KI + 1, N + WORK( K + IV*N ) = -CONJG( T( KI, K ) ) + 90 CONTINUE +* +* Solve conjugate-transposed triangular system: +* [ T(KI+1:N,KI+1:N) - T(KI,KI) ]**H * X = SCALE*WORK. +* + DO 100 K = KI + 1, N + T( K, K ) = T( K, K ) - T( KI, KI ) + IF( CABS1( T( K, K ) ).LT.SMIN ) + $ T( K, K ) = SMIN + 100 CONTINUE +* + IF( KI.LT.N ) THEN + CALL CLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', + $ 'Y', N-KI, T( KI+1, KI+1 ), LDT, + $ WORK( KI+1 + IV*N ), SCALE, RWORK, INFO ) + WORK( KI + IV*N ) = SCALE + END IF +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL CCOPY( N-KI+1, WORK( KI + IV*N ), 1, VL(KI,IS), 1 ) +* + II = ICAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 + REMAX = ONE / CABS1( VL( II, IS ) ) + CALL CSSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) +* + DO 110 K = 1, KI - 1 + VL( K, IS ) = CZERO + 110 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N ) + $ CALL CGEMV( 'N', N, N-KI, CONE, VL( 1, KI+1 ), LDVL, + $ WORK( KI+1 + IV*N ), 1, CMPLX( SCALE ), + $ VL( 1, KI ), 1 ) +* + II = ICAMAX( N, VL( 1, KI ), 1 ) + REMAX = ONE / CABS1( VL( II, KI ) ) + CALL CSSCAL( N, REMAX, VL( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + IV*N ) = CZERO + END DO +* +* Columns 1:IV of work are valid vectors. +* When the number of vectors stored reaches NB, +* or if this was last vector, do the GEMM + IF( (IV.EQ.NB) .OR. (KI.EQ.N) ) THEN + CALL CGEMM( 'N', 'N', N, IV, N-KI+IV, ONE, + $ VL( 1, KI-IV+1 ), LDVL, + $ WORK( KI-IV+1 + (1)*N ), N, + $ CZERO, + $ WORK( 1 + (NB+1)*N ), N ) +* normalize vectors + DO K = 1, IV + II = ICAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / CABS1( WORK( II + (NB+K)*N ) ) + CALL CSSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL CLACPY( 'F', N, IV, + $ WORK( 1 + (NB+1)*N ), N, + $ VL( 1, KI-IV+1 ), LDVL ) + IV = 1 + ELSE + IV = IV + 1 + END IF + END IF +* +* Restore the original diagonal elements of T. +* + DO 120 K = KI + 1, N + T( K, K ) = WORK( K ) + 120 CONTINUE +* + IS = IS + 1 + 130 CONTINUE + END IF +* + RETURN +* +* End of CTREVC3 +* + END diff --git a/lapack-netlib/SRC/ctrttf.f b/lapack-netlib/SRC/ctrttf.f index b1086b6fe..95a24ea68 100644 --- a/lapack-netlib/SRC/ctrttf.f +++ b/lapack-netlib/SRC/ctrttf.f @@ -81,7 +81,7 @@ *> *> \param[out] ARF *> \verbatim -*> ARF is COMPLEX*16 array, dimension ( N*(N+1)/2 ), +*> ARF is COMPLEX array, dimension ( N*(N+1)/2 ), *> On exit, the upper or lower triangular matrix A stored in *> RFP format. For a further discussion see Notes below. *> \endverbatim @@ -101,7 +101,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -216,10 +216,10 @@ * ===================================================================== SUBROUTINE CTRTTF( TRANSR, UPLO, N, A, LDA, ARF, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER TRANSR, UPLO diff --git a/lapack-netlib/SRC/cunbdb1.f b/lapack-netlib/SRC/cunbdb1.f index fea26b21a..7d36547da 100644 --- a/lapack-netlib/SRC/cunbdb1.f +++ b/lapack-netlib/SRC/cunbdb1.f @@ -202,7 +202,7 @@ SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -307,9 +307,8 @@ CALL CLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I, X21(I,I+1), LDX21 ) - C = SQRT( SCNRM2( P-I, X11(I+1,I+1), 1, X11(I+1,I+1), - $ 1 )**2 + SCNRM2( M-P-I, X21(I+1,I+1), 1, X21(I+1,I+1), - $ 1 )**2 ) + C = SQRT( SCNRM2( P-I, X11(I+1,I+1), 1 )**2 + $ + SCNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) PHI(I) = ATAN2( S, C ) CALL CUNBDB5( P-I, M-P-I, Q-I-1, X11(I+1,I+1), 1, $ X21(I+1,I+1), 1, X11(I+1,I+2), LDX11, diff --git a/lapack-netlib/SRC/cunbdb2.f b/lapack-netlib/SRC/cunbdb2.f index cec00f93c..6571befde 100644 --- a/lapack-netlib/SRC/cunbdb2.f +++ b/lapack-netlib/SRC/cunbdb2.f @@ -202,7 +202,7 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -296,8 +296,8 @@ CALL CLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X21(I,I), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I+1, X11(I,I), LDX11 ) - S = SQRT( SCNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + SCNRM2( M-P-I+1, X21(I,I), 1, X21(I,I), 1 )**2 ) + S = SQRT( SCNRM2( P-I, X11(I+1,I), 1 )**2 + $ + SCNRM2( M-P-I+1, X21(I,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL CUNBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1, diff --git a/lapack-netlib/SRC/cunbdb3.f b/lapack-netlib/SRC/cunbdb3.f index 5451ef003..05eab91be 100644 --- a/lapack-netlib/SRC/cunbdb3.f +++ b/lapack-netlib/SRC/cunbdb3.f @@ -202,7 +202,7 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -296,8 +296,8 @@ CALL CLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I+1, X21(I,I), LDX21 ) - C = SQRT( SCNRM2( P-I+1, X11(I,I), 1, X11(I,I), - $ 1 )**2 + SCNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), 1 )**2 ) + C = SQRT( SCNRM2( P-I+1, X11(I,I), 1 )**2 + $ + SCNRM2( M-P-I, X21(I+1,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL CUNBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1, diff --git a/lapack-netlib/SRC/cunbdb4.f b/lapack-netlib/SRC/cunbdb4.f index bc948a30f..ce3a86605 100644 --- a/lapack-netlib/SRC/cunbdb4.f +++ b/lapack-netlib/SRC/cunbdb4.f @@ -213,7 +213,7 @@ $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -344,9 +344,8 @@ $ X21(I+1,I), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I+1, X21(I,I), LDX21 ) IF( I .LT. M-Q ) THEN - S = SQRT( SCNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + SCNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), - $ 1 )**2 ) + S = SQRT( SCNRM2( P-I, X11(I+1,I), 1 )**2 + $ + SCNRM2( M-P-I, X21(I+1,I), 1 )**2 ) PHI(I) = ATAN2( S, C ) END IF * diff --git a/lapack-netlib/SRC/cuncsd.f b/lapack-netlib/SRC/cuncsd.f index ca3922da4..09c9b305a 100644 --- a/lapack-netlib/SRC/cuncsd.f +++ b/lapack-netlib/SRC/cuncsd.f @@ -308,7 +308,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -320,10 +320,10 @@ $ LDV2T, WORK, LWORK, RWORK, LRWORK, $ IWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, SIGNS, TRANS @@ -371,7 +371,7 @@ EXTERNAL LSAME * .. * .. Intrinsic Functions - INTRINSIC COS, INT, MAX, MIN, SIN + INTRINSIC INT, MAX, MIN * .. * .. Executable Statements .. * @@ -488,12 +488,12 @@ ITAUQ1 = ITAUP2 + MAX( 1, M - P ) ITAUQ2 = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ2 + MAX( 1, M - Q ) - CALL CUNGQR( M-Q, M-Q, M-Q, 0, MAX(1,M-Q), U1, WORK, -1, + CALL CUNGQR( M-Q, M-Q, M-Q, U1, MAX(1,M-Q), U1, WORK, -1, $ CHILDINFO ) LORGQRWORKOPT = INT( WORK(1) ) LORGQRWORKMIN = MAX( 1, M - Q ) IORGLQ = ITAUQ2 + MAX( 1, M - Q ) - CALL CUNGLQ( M-Q, M-Q, M-Q, 0, MAX(1,M-Q), U1, WORK, -1, + CALL CUNGLQ( M-Q, M-Q, M-Q, U1, MAX(1,M-Q), U1, WORK, -1, $ CHILDINFO ) LORGLQWORKOPT = INT( WORK(1) ) LORGLQWORKMIN = MAX( 1, M - Q ) diff --git a/lapack-netlib/SRC/cuncsd2by1.f b/lapack-netlib/SRC/cuncsd2by1.f index 1b2b0fb2a..54b774b88 100644 --- a/lapack-netlib/SRC/cuncsd2by1.f +++ b/lapack-netlib/SRC/cuncsd2by1.f @@ -244,7 +244,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date July 2012 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -254,10 +254,10 @@ $ LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* July 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T @@ -288,6 +288,10 @@ $ LWORKMIN, LWORKOPT, R LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. +* .. Local Arrays .. + REAL DUM( 1 ) + COMPLEX CDUM( 1, 1 ) +* .. * .. External Subroutines .. EXTERNAL CBBCSD, CCOPY, CLACPY, CLAPMR, CLAPMT, CUNBDB1, $ CUNBDB2, CUNBDB3, CUNBDB4, CUNGLQ, CUNGQR, @@ -320,11 +324,11 @@ INFO = -8 ELSE IF( LDX21 .LT. MAX( 1, M-P ) ) THEN INFO = -10 - ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN + ELSE IF( WANTU1 .AND. LDU1 .LT. MAX( 1, P ) ) THEN INFO = -13 - ELSE IF( WANTU2 .AND. LDU2 .LT. M - P ) THEN + ELSE IF( WANTU2 .AND. LDU2 .LT. MAX( 1, M - P ) ) THEN INFO = -15 - ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN + ELSE IF( WANTV1T .AND. LDV1T .LT. MAX( 1, Q ) ) THEN INFO = -17 END IF * @@ -380,99 +384,119 @@ IORBDB = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ1 + MAX( 1, Q ) IORGLQ = ITAUQ1 + MAX( 1, Q ) + LORGQRMIN = 1 + LORGQROPT = 1 + LORGLQMIN = 1 + LORGLQOPT = 1 IF( R .EQ. Q ) THEN - CALL CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK, -1, CHILDINFO ) + CALL CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM, CDUM, CDUM, CDUM, WORK, -1, + $ CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL CUNGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL CUNGQR( P, P, Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL CUNGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + ENDIF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL CUNGQR( M-P, M-P, Q, U2, LDU2, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL CUNGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, + $ CDUM, WORK(1), -1, CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q-1 ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL CUNGLQ( MAX(0,Q-1), MAX(0,Q-1), MAX(0,Q-1), V1T, LDV1T, - $ 0, WORK(1), -1, CHILDINFO ) - LORGLQMIN = MAX( 1, Q-1 ) - LORGLQOPT = INT( WORK(1) ) CALL CBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, 0, 0, - $ 0, 0, 0, 0, 0, 0, RWORK(1), -1, CHILDINFO ) + $ DUM(1), U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM, + $ 1, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE IF( R .EQ. P ) THEN - CALL CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P-1 .GE. M-P ) THEN - CALL CUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, 0, WORK(1), + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL CUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, CDUM, WORK(1), $ -1, CHILDINFO ) - LORGQRMIN = MAX( 1, P-1 ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL CUNGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, - $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL CUNGQR( M-P, M-P, Q, U2, LDU2, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL CUNGLQ( Q, Q, R, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL CUNGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL CBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ 0, V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, 0, 0, - $ 0, 0, 0, 0, 0, 0, RWORK(1), -1, CHILDINFO ) + $ DUM, V1T, LDV1T, CDUM, 1, U1, LDU1, U2, LDU2, + $ DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE IF( R .EQ. M-P ) THEN - CALL CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P-1 ) THEN - CALL CUNGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL CUNGQR( P, P, Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL CUNGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, 0, - $ WORK(1), -1, CHILDINFO ) - LORGQRMIN = MAX( 1, M-P-1 ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL CUNGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, CDUM, + $ WORK(1), -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL CUNGLQ( Q, Q, R, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL CUNGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL CBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, 0, 0, 1, V1T, LDV1T, U2, LDU2, U1, LDU1, - $ 0, 0, 0, 0, 0, 0, 0, 0, RWORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM, CDUM, 1, V1T, LDV1T, U2, LDU2, U1, + $ LDU1, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE - CALL CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, 0, WORK(1), -1, CHILDINFO ) + CALL CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO + $ ) LORBDB = M + INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL CUNGQR( P, P, M-Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL CUNGQR( P, P, M-Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL CUNGQR( M-P, M-P, M-Q, U2, LDU2, 0, WORK(1), -1, - $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL CUNGQR( M-P, M-P, M-Q, U2, LDU2, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL CUNGLQ( Q, Q, Q, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL CUNGLQ( Q, Q, Q, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL CBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, 0, U2, LDU2, U1, LDU1, 0, 1, V1T, LDV1T, - $ 0, 0, 0, 0, 0, 0, 0, 0, RWORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM, U2, LDU2, U1, LDU1, CDUM, 1, V1T, + $ LDV1T, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) END IF LRWORKMIN = IBBCSD+LBBCSD-1 @@ -538,8 +562,8 @@ * Simultaneously diagonalize X11 and X21. * CALL CBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, - $ RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), + $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM, + $ 1, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -592,8 +616,8 @@ * Simultaneously diagonalize X11 and X21. * CALL CBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ RWORK(IPHI), V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, - $ RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), + $ RWORK(IPHI), V1T, LDV1T, CDUM, 1, U1, LDU1, U2, + $ LDU2, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -647,7 +671,7 @@ * Simultaneously diagonalize X11 and X21. * CALL CBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, RWORK(IPHI), 0, 1, V1T, LDV1T, U2, LDU2, + $ THETA, RWORK(IPHI), CDUM, 1, V1T, LDV1T, U2, LDU2, $ U1, LDU1, RWORK(IB11D), RWORK(IB11E), $ RWORK(IB12D), RWORK(IB12E), RWORK(IB21D), $ RWORK(IB21E), RWORK(IB22D), RWORK(IB22E), @@ -716,11 +740,11 @@ * Simultaneously diagonalize X11 and X21. * CALL CBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, RWORK(IPHI), U2, LDU2, U1, LDU1, 0, 1, V1T, - $ LDV1T, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), - $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), - $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, RWORK(IPHI), U2, LDU2, U1, LDU1, CDUM, 1, + $ V1T, LDV1T, RWORK(IB11D), RWORK(IB11E), + $ RWORK(IB12D), RWORK(IB12E), RWORK(IB21D), + $ RWORK(IB21E), RWORK(IB22D), RWORK(IB22E), + $ RWORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions diff --git a/lapack-netlib/SRC/dbbcsd.f b/lapack-netlib/SRC/dbbcsd.f index 2c54d1c5d..962071cf7 100644 --- a/lapack-netlib/SRC/dbbcsd.f +++ b/lapack-netlib/SRC/dbbcsd.f @@ -149,7 +149,7 @@ *> \param[in,out] U1 *> \verbatim *> U1 is DOUBLE PRECISION array, dimension (LDU1,P) -*> On entry, an LDU1-by-P matrix. On exit, U1 is postmultiplied +*> On entry, a P-by-P matrix. On exit, U1 is postmultiplied *> by the left singular vector matrix common to [ B11 ; 0 ] and *> [ B12 0 0 ; 0 -I 0 0 ]. *> \endverbatim @@ -157,13 +157,13 @@ *> \param[in] LDU1 *> \verbatim *> LDU1 is INTEGER -*> The leading dimension of the array U1. +*> The leading dimension of the array U1, LDU1 >= MAX(1,P). *> \endverbatim *> *> \param[in,out] U2 *> \verbatim *> U2 is DOUBLE PRECISION array, dimension (LDU2,M-P) -*> On entry, an LDU2-by-(M-P) matrix. On exit, U2 is +*> On entry, an (M-P)-by-(M-P) matrix. On exit, U2 is *> postmultiplied by the left singular vector matrix common to *> [ B21 ; 0 ] and [ B22 0 0 ; 0 0 I ]. *> \endverbatim @@ -171,13 +171,13 @@ *> \param[in] LDU2 *> \verbatim *> LDU2 is INTEGER -*> The leading dimension of the array U2. +*> The leading dimension of the array U2, LDU2 >= MAX(1,M-P). *> \endverbatim *> *> \param[in,out] V1T *> \verbatim *> V1T is DOUBLE PRECISION array, dimension (LDV1T,Q) -*> On entry, a LDV1T-by-Q matrix. On exit, V1T is premultiplied +*> On entry, a Q-by-Q matrix. On exit, V1T is premultiplied *> by the transpose of the right singular vector *> matrix common to [ B11 ; 0 ] and [ B21 ; 0 ]. *> \endverbatim @@ -185,13 +185,13 @@ *> \param[in] LDV1T *> \verbatim *> LDV1T is INTEGER -*> The leading dimension of the array V1T. +*> The leading dimension of the array V1T, LDV1T >= MAX(1,Q). *> \endverbatim *> *> \param[in,out] V2T *> \verbatim *> V2T is DOUBLE PRECISION array, dimenison (LDV2T,M-Q) -*> On entry, a LDV2T-by-(M-Q) matrix. On exit, V2T is +*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is *> premultiplied by the transpose of the right *> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and *> [ B22 0 0 ; 0 0 I ]. @@ -200,7 +200,7 @@ *> \param[in] LDV2T *> \verbatim *> LDV2T is INTEGER -*> The leading dimension of the array V2T. +*> The leading dimension of the array V2T, LDV2T >= MAX(1,M-Q). *> \endverbatim *> *> \param[out] B11D @@ -322,7 +322,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * @@ -332,10 +332,10 @@ $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS diff --git a/lapack-netlib/SRC/dbdsdc.f b/lapack-netlib/SRC/dbdsdc.f index 2c572f12c..a5af1b0fa 100644 --- a/lapack-netlib/SRC/dbdsdc.f +++ b/lapack-netlib/SRC/dbdsdc.f @@ -191,7 +191,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -205,10 +205,10 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, $ WORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER COMPQ, UPLO @@ -311,7 +311,7 @@ WSTART = 1 QSTART = 3 IF( ICOMPQ.EQ.1 ) THEN - CALL DCOPY( N, D, 1, Q( 1 ), 1 ) + CALL DCOPY( N, D, 1, Q( 1 ), 1 ) CALL DCOPY( N-1, E, 1, Q( N+1 ), 1 ) END IF IF( IUPLO.EQ.2 ) THEN @@ -335,8 +335,11 @@ * If ICOMPQ = 0, use DLASDQ to compute the singular values. * IF( ICOMPQ.EQ.0 ) THEN +* Ignore WSTART, instead using WORK( 1 ), since the two vectors +* for CS and -SN above are added only if ICOMPQ == 2, +* and adding them exceeds documented WORK size of 4*n. CALL DLASDQ( 'U', 0, N, 0, 0, 0, D, E, VT, LDVT, U, LDU, U, - $ LDU, WORK( WSTART ), INFO ) + $ LDU, WORK( 1 ), INFO ) GO TO 40 END IF * @@ -412,24 +415,24 @@ DO 30 I = 1, NM1 IF( ( ABS( E( I ) ).LT.EPS ) .OR. ( I.EQ.NM1 ) ) THEN * -* Subproblem found. First determine its size and then -* apply divide and conquer on it. +* Subproblem found. First determine its size and then +* apply divide and conquer on it. * IF( I.LT.NM1 ) THEN * -* A subproblem with E(I) small for I < NM1. +* A subproblem with E(I) small for I < NM1. * NSIZE = I - START + 1 ELSE IF( ABS( E( I ) ).GE.EPS ) THEN * -* A subproblem with E(NM1) not too small but I = NM1. +* A subproblem with E(NM1) not too small but I = NM1. * NSIZE = N - START + 1 ELSE * -* A subproblem with E(NM1) small. This implies an -* 1-by-1 subproblem at D(N). Solve this 1-by-1 problem -* first. +* A subproblem with E(NM1) small. This implies an +* 1-by-1 subproblem at D(N). Solve this 1-by-1 problem +* first. * NSIZE = I - START + 1 IF( ICOMPQ.EQ.2 ) THEN diff --git a/lapack-netlib/SRC/dbdsvdx.f b/lapack-netlib/SRC/dbdsvdx.f index 7ceb9392c..89a8aab41 100644 --- a/lapack-netlib/SRC/dbdsvdx.f +++ b/lapack-netlib/SRC/dbdsvdx.f @@ -80,7 +80,7 @@ *> = 'L': B is lower bidiagonal. *> \endverbatim *> -*> \param[in] JOBXZ +*> \param[in] JOBZ *> \verbatim *> JOBZ is CHARACTER*1 *> = 'N': Compute singular values only; @@ -117,14 +117,16 @@ *> *> \param[in] VL *> \verbatim -*> VL is DOUBLE PRECISION -*> VL >=0. +*> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,13 +134,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -190,7 +196,10 @@ *> If JOBZ = 'V', then if INFO = 0, the first NS elements of *> IWORK are zero. If INFO > 0, then IWORK contains the indices *> of the eigenvectors that failed to converge in DSTEVX. +*> \endverbatim *> +*> \param[out] INFO +*> \verbatim *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value @@ -209,7 +218,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -217,7 +226,7 @@ SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, $ NS, S, Z, LDZ, WORK, IWORK, INFO) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -371,7 +380,6 @@ IF( ABS( E( I ) ).LE.THRESH ) E( I ) = ZERO END DO IF( ABS( D( N ) ).LE.THRESH ) D( N ) = ZERO - E( N ) = ZERO * * Pointers for arrays used by DSTEVX. * @@ -398,7 +406,7 @@ * of the active submatrix. * RNGVX = 'I' - CALL DLASET( 'F', N*2, N+1, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL DLASET( 'F', N*2, N+1, ZERO, ZERO, Z, LDZ ) ELSE IF( VALSV ) THEN * * Find singular values in a half-open interval. We aim @@ -418,7 +426,7 @@ IF( NS.EQ.0 ) THEN RETURN ELSE - CALL DLASET( 'F', N*2, NS, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL DLASET( 'F', N*2, NS, ZERO, ZERO, Z, LDZ ) END IF ELSE IF( INDSV ) THEN * @@ -455,7 +463,7 @@ * IF( VLTGK.EQ.VUTGK ) VLTGK = VLTGK - TOL * - CALL DLASET( 'F', N*2, IU-IL+1, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL DLASET( 'F', N*2, IU-IL+1, ZERO, ZERO, Z, LDZ) END IF * * Initialize variables and pointers for S, Z, and WORK. @@ -709,9 +717,11 @@ NRU = 0 NRV = 0 END IF !** NTGK.GT.0 **! - IF( IROWZ.LT.N*2 ) Z( 1:IROWZ-1, ICOLZ ) = ZERO + IF( IROWZ.LT.N*2 .AND. WANTZ ) THEN + Z( 1:IROWZ-1, ICOLZ ) = ZERO + END IF END DO !** IDPTR loop **! - IF( SPLIT ) THEN + IF( SPLIT .AND. WANTZ ) THEN * * Bring back eigenvector corresponding * to eigenvalue equal to zero. @@ -744,7 +754,7 @@ IF( K.NE.NS+1-I ) THEN S( K ) = S( NS+1-I ) S( NS+1-I ) = SMIN - CALL DSWAP( N*2, Z( 1,K ), 1, Z( 1,NS+1-I ), 1 ) + IF( WANTZ ) CALL DSWAP( N*2, Z( 1,K ), 1, Z( 1,NS+1-I ), 1 ) END IF END DO * @@ -754,7 +764,7 @@ K = IU - IL + 1 IF( K.LT.NS ) THEN S( K+1:NS ) = ZERO - Z( 1:N*2,K+1:NS ) = ZERO + IF( WANTZ ) Z( 1:N*2,K+1:NS ) = ZERO NS = K END IF END IF @@ -762,6 +772,7 @@ * Reorder Z: U = Z( 1:N,1:NS ), V = Z( N+1:N*2,1:NS ). * If B is a lower diagonal, swap U and V. * + IF( WANTZ ) THEN DO I = 1, NS CALL DCOPY( N*2, Z( 1,I ), 1, WORK, 1 ) IF( LOWER ) THEN @@ -772,6 +783,7 @@ CALL DCOPY( N, WORK( 1 ), 2, Z( N+1,I ), 1 ) END IF END DO + END IF * RETURN * diff --git a/lapack-netlib/SRC/dgbrfsx.f b/lapack-netlib/SRC/dgbrfsx.f index c96c62338..e50ef67b2 100644 --- a/lapack-netlib/SRC/dgbrfsx.f +++ b/lapack-netlib/SRC/dgbrfsx.f @@ -440,7 +440,7 @@ $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.1) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -646,7 +646,7 @@ * * Perform refinement on each right-hand side * - IF (REF_TYPE .NE. 0) THEN + IF ( REF_TYPE .NE. 0 .AND. INFO .EQ. 0 ) THEN PREC_TYPE = ILAPREC( 'E' ) diff --git a/lapack-netlib/SRC/dgeesx.f b/lapack-netlib/SRC/dgeesx.f index 2a3e963fd..67e084877 100644 --- a/lapack-netlib/SRC/dgeesx.f +++ b/lapack-netlib/SRC/dgeesx.f @@ -90,7 +90,7 @@ *> *> \param[in] SELECT *> \verbatim -*> SELECT is procedure) LOGICAL FUNCTION of two DOUBLE PRECISION arguments +*> SELECT is a LOGICAL FUNCTION of two DOUBLE PRECISION arguments *> SELECT must be declared EXTERNAL in the calling subroutine. *> If SORT = 'S', SELECT is used to select eigenvalues to sort *> to the top left of the Schur form. @@ -272,7 +272,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleGEeigen * @@ -281,10 +281,10 @@ $ WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, $ IWORK, LIWORK, BWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVS, SENSE, SORT diff --git a/lapack-netlib/SRC/dgeev.f b/lapack-netlib/SRC/dgeev.f index 328eaa39c..eb043d95a 100644 --- a/lapack-netlib/SRC/dgeev.f +++ b/lapack-netlib/SRC/dgeev.f @@ -181,18 +181,21 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 +* +* @precisions fortran d -> s * *> \ingroup doubleGEeigen * * ===================================================================== SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, $ LDVR, WORK, LWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVL, JOBVR @@ -213,7 +216,7 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K, - $ MAXWRK, MINWRK, NOUT + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. @@ -223,7 +226,7 @@ * .. * .. External Subroutines .. EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY, - $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC, + $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC3, $ XERBLA * .. * .. External Functions .. @@ -279,24 +282,34 @@ MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1, $ 'DORGHR', ' ', N, 1, N, -1 ) ) CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) + CALL DTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, N, NOUT, + $ WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) MAXWRK = MAX( MAXWRK, 4*N ) ELSE IF( WANTVR ) THEN MINWRK = 4*N MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1, $ 'DORGHR', ' ', N, 1, N, -1 ) ) CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) + CALL DTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, N, NOUT, + $ WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) MAXWRK = MAX( MAXWRK, 4*N ) ELSE MINWRK = 3*N CALL DHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) END IF MAXWRK = MAX( MAXWRK, MINWRK ) @@ -426,10 +439,10 @@ IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (Workspace: need 4*N) +* (Workspace: need 4*N, prefer N + N + 2*N*NB) * - CALL DTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), IERR ) + CALL DTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * IF( WANTVL ) THEN diff --git a/lapack-netlib/SRC/dgeevx.f b/lapack-netlib/SRC/dgeevx.f index 81f30f936..3067f346d 100644 --- a/lapack-netlib/SRC/dgeevx.f +++ b/lapack-netlib/SRC/dgeevx.f @@ -294,7 +294,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 +* +* @precisions fortran d -> s * *> \ingroup doubleGEeigen * @@ -302,11 +304,12 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, $ VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, $ RCONDE, RCONDV, WORK, LWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER BALANC, JOBVL, JOBVR, SENSE @@ -330,8 +333,8 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK, - $ MINWRK, NOUT + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. @@ -341,7 +344,7 @@ * .. * .. External Subroutines .. EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY, - $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC, + $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC3, $ DTRSNA, XERBLA * .. * .. External Functions .. @@ -366,8 +369,8 @@ WNTSNE = LSAME( SENSE, 'E' ) WNTSNV = LSAME( SENSE, 'V' ) WNTSNB = LSAME( SENSE, 'B' ) - IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, - $ 'S' ) .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) + IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) + $ .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) $ THEN INFO = -1 ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN @@ -406,9 +409,19 @@ MAXWRK = N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 ) * IF( WANTVL ) THEN + CALL DTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN + CALL DTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR, $ WORK, -1, INFO ) ELSE @@ -420,7 +433,7 @@ $ LDVR, WORK, -1, INFO ) END IF END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) * IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN MINWRK = 2*N @@ -572,18 +585,18 @@ $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * -* If INFO > 0 from DHSEQR, then quit +* If INFO .NE. 0 from DHSEQR, then quit * - IF( INFO.GT.0 ) + IF( INFO.NE.0 ) $ GO TO 50 * IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (Workspace: need 3*N) +* (Workspace: need 3*N, prefer N + 2*N*NB) * - CALL DTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), IERR ) + CALL DTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * * Compute condition numbers if desired diff --git a/lapack-netlib/SRC/dgejsv.f b/lapack-netlib/SRC/dgejsv.f index 4b26a1d68..fc91ab51d 100644 --- a/lapack-netlib/SRC/dgejsv.f +++ b/lapack-netlib/SRC/dgejsv.f @@ -52,7 +52,8 @@ *> are computed and stored in the arrays U and V, respectively. The diagonal *> of [SIGMA] is computed and stored in the array SVA. *> DGEJSV can sometimes compute tiny singular values and their singular vectors much -*> more accurately than other SVD routines, see below under Further Details.*> \endverbatim +*> more accurately than other SVD routines, see below under Further Details. +*> \endverbatim * * Arguments: * ========== @@ -236,7 +237,7 @@ *> copied back to the V array. This 'W' option is just *> a reminder to the caller that in this case U is *> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced. +*> If JOBU = 'N' U is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDU @@ -258,7 +259,7 @@ *> copied back to the U array. This 'W' option is just *> a reminder to the caller that in this case V is *> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced. +*> If JOBV = 'N' V is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDV @@ -332,10 +333,10 @@ *> If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'), *> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). *> -> For optimal performance, LWORK >= max(2*M+N,3*N+(N+1)*NB,7), -*> where NB is the optimal block size for DGEQP3, DGEQRF, DGELQ, +*> where NB is the optimal block size for DGEQP3, DGEQRF, DGELQF, *> DORMLQ. In general, the optimal length LWORK is computed as *> LWORK >= max(2*M+N,N+LWORK(DGEQP3), N+LWORK(DPOCON), -*> N+LWORK(DGELQ), 2*N+LWORK(DGEQRF), N+LWORK(DORMLQ)). +*> N+LWORK(DGELQF), 2*N+LWORK(DGEQRF), N+LWORK(DORMLQ)). *> *> If SIGMA and the left singular vectors are needed *> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). @@ -390,7 +391,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleGEsing * @@ -475,10 +476,10 @@ $ M, N, A, LDA, SVA, U, LDU, V, LDV, $ WORK, LWORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. IMPLICIT NONE @@ -589,7 +590,11 @@ * * Quick return for void matrix (Y3K safe) * #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) RETURN + IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN + IWORK(1:3) = 0 + WORK(1:7) = 0 + RETURN + ENDIF * * Determine whether the matrix U should be M x N or M x M * @@ -715,6 +720,7 @@ IWORK(1) = 0 IWORK(2) = 0 END IF + IWORK(3) = 0 IF ( ERREST ) WORK(3) = ONE IF ( LSVEC .AND. RSVEC ) THEN WORK(4) = ONE diff --git a/lapack-netlib/SRC/dgeqrt3.f b/lapack-netlib/SRC/dgeqrt3.f index c5f57a29f..42453dbf1 100644 --- a/lapack-netlib/SRC/dgeqrt3.f +++ b/lapack-netlib/SRC/dgeqrt3.f @@ -100,7 +100,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleGEcomputational * @@ -132,10 +132,10 @@ * ===================================================================== RECURSIVE SUBROUTINE DGEQRT3( M, N, A, LDA, T, LDT, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, LDT @@ -177,7 +177,7 @@ * * Compute Householder transform when N=1 * - CALL DLARFG( M, A, A( MIN( 2, M ), 1 ), 1, T ) + CALL DLARFG( M, A(1,1), A( MIN( 2, M ), 1 ), 1, T(1,1) ) * ELSE * diff --git a/lapack-netlib/SRC/dgesdd.f b/lapack-netlib/SRC/dgesdd.f index 54e2652e4..02beb3be5 100644 --- a/lapack-netlib/SRC/dgesdd.f +++ b/lapack-netlib/SRC/dgesdd.f @@ -18,8 +18,8 @@ * Definition: * =========== * -* SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, -* LWORK, IWORK, INFO ) +* SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, +* WORK, LWORK, IWORK, INFO ) * * .. Scalar Arguments .. * CHARACTER JOBZ @@ -154,8 +154,8 @@ *> \param[in] LDVT *> \verbatim *> LDVT is INTEGER -*> The leading dimension of the array VT. LDVT >= 1; if -*> JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; +*> The leading dimension of the array VT. LDVT >= 1; +*> if JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; *> if JOBZ = 'S', LDVT >= min(M,N). *> \endverbatim *> @@ -169,16 +169,18 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 1. -*> If JOBZ = 'N', -*> LWORK >= 3*min(M,N) + max(max(M,N),7*min(M,N)). -*> If JOBZ = 'O', -*> LWORK >= 3*min(M,N) + -*> max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)). -*> If JOBZ = 'S' or 'A' -*> LWORK >= min(M,N)*(7+4*min(M,N)) -*> For good performance, LWORK should generally be larger. -*> If LWORK = -1 but other input arguments are legal, WORK(1) -*> returns the optimal LWORK. +*> If LWORK = -1, a workspace query is assumed. The optimal +*> size for the WORK array is calculated and stored in WORK(1), +*> and no other work except argument checking is performed. +*> +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LWORK >= 3*mn + max( mx, 7*mn ). +*> If JOBZ = 'O', LWORK >= 3*mn + max( mx, 5*mn*mn + 4*mn ). +*> If JOBZ = 'S', LWORK >= 4*mn*mn + 7*mn. +*> If JOBZ = 'A', LWORK >= 4*mn*mn + 6*mn + mx. +*> These are not tight minimums in all cases; see comments inside code. +*> For good performance, LWORK should generally be larger; +*> a query is recommended. *> \endverbatim *> *> \param[out] IWORK @@ -202,7 +204,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleGEsing * @@ -212,14 +214,16 @@ *> Ming Gu and Huan Ren, Computer Science Division, University of *> California at Berkeley, USA *> +*> @precisions fortran d -> s * ===================================================================== - SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, - $ LWORK, IWORK, INFO ) + SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, + $ WORK, LWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ @@ -243,6 +247,15 @@ $ IR, ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT, $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK, $ MNTHR, NWORK, WRKBL + INTEGER LWORK_DGEBRD_MN, LWORK_DGEBRD_MM, + $ LWORK_DGEBRD_NN, LWORK_DGELQF_MN, + $ LWORK_DGEQRF_MN, + $ LWORK_DORGBR_P_MM, LWORK_DORGBR_Q_NN, + $ LWORK_DORGLQ_MN, LWORK_DORGLQ_NN, + $ LWORK_DORGQR_MM, LWORK_DORGQR_MN, + $ LWORK_DORMBR_PRT_MM, LWORK_DORMBR_QLN_MM, + $ LWORK_DORMBR_PRT_MN, LWORK_DORMBR_QLN_MN, + $ LWORK_DORMBR_PRT_NN, LWORK_DORMBR_QLN_NN DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. @@ -256,9 +269,8 @@ * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL DLAMCH, DLANGE, ILAENV, LSAME + EXTERNAL DLAMCH, DLANGE, LSAME * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -267,13 +279,13 @@ * * Test the input arguments * - INFO = 0 - MINMN = MIN( M, N ) - WNTQA = LSAME( JOBZ, 'A' ) - WNTQS = LSAME( JOBZ, 'S' ) + INFO = 0 + MINMN = MIN( M, N ) + WNTQA = LSAME( JOBZ, 'A' ) + WNTQS = LSAME( JOBZ, 'S' ) WNTQAS = WNTQA .OR. WNTQS - WNTQO = LSAME( JOBZ, 'O' ) - WNTQN = LSAME( JOBZ, 'N' ) + WNTQO = LSAME( JOBZ, 'O' ) + WNTQN = LSAME( JOBZ, 'N' ) LQUERY = ( LWORK.EQ.-1 ) * IF( .NOT.( WNTQA .OR. WNTQS .OR. WNTQO .OR. WNTQN ) ) THEN @@ -294,115 +306,140 @@ END IF * * Compute workspace -* (Note: Comments in the code beginning "Workspace:" describe the -* minimal amount of workspace needed at that point in the code, +* Note: Comments in the code beginning "Workspace:" describe the +* minimal amount of workspace allocated at that point in the code, * as well as the preferred amount for good performance. * NB refers to the optimal block size for the immediately -* following subroutine, as returned by ILAENV.) +* following subroutine, as returned by ILAENV. * IF( INFO.EQ.0 ) THEN MINWRK = 1 MAXWRK = 1 + BDSPAC = 0 + MNTHR = INT( MINMN*11.0D0 / 6.0D0 ) IF( M.GE.N .AND. MINMN.GT.0 ) THEN * * Compute space needed for DBDSDC * - MNTHR = INT( MINMN*11.0D0 / 6.0D0 ) IF( WNTQN ) THEN +* dbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) +* keep 7*N for backwards compatability. BDSPAC = 7*N ELSE BDSPAC = 3*N*N + 4*N END IF +* +* Compute space preferred for each routine + CALL DGEBRD( M, N, DUM(1), M, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_DGEBRD_MN = INT( DUM(1) ) +* + CALL DGEBRD( N, N, DUM(1), N, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_DGEBRD_NN = INT( DUM(1) ) +* + CALL DGEQRF( M, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_DGEQRF_MN = INT( DUM(1) ) +* + CALL DORGBR( 'Q', N, N, N, DUM(1), N, DUM(1), DUM(1), -1, + $ IERR ) + LWORK_DORGBR_Q_NN = INT( DUM(1) ) +* + CALL DORGQR( M, M, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_DORGQR_MM = INT( DUM(1) ) +* + CALL DORGQR( M, N, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_DORGQR_MN = INT( DUM(1) ) +* + CALL DORMBR( 'P', 'R', 'T', N, N, N, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_DORMBR_PRT_NN = INT( DUM(1) ) +* + CALL DORMBR( 'Q', 'L', 'N', N, N, N, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_DORMBR_QLN_NN = INT( DUM(1) ) +* + CALL DORMBR( 'Q', 'L', 'N', M, N, N, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_DORMBR_QLN_MN = INT( DUM(1) ) +* + CALL DORMBR( 'Q', 'L', 'N', M, M, N, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_DORMBR_QLN_MM = INT( DUM(1) ) +* IF( M.GE.MNTHR ) THEN IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * - WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, - $ -1 ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+N ) + WRKBL = N + LWORK_DGEQRF_MN + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD_NN ) + MAXWRK = MAX( WRKBL, BDSPAC + N ) MINWRK = BDSPAC + N ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') +* Path 2 (M >> N, JOBZ='O') * - WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) + WRKBL = N + LWORK_DGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + 2*N*N MINWRK = BDSPAC + 2*N*N + 3*N ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * - WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) + WRKBL = N + LWORK_DGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + N*N MINWRK = BDSPAC + N*N + 3*N ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * - WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'DORGQR', ' ', M, - $ M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) + WRKBL = N + LWORK_DGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_MM ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + N*N - MINWRK = BDSPAC + N*N + 2*N + M + MINWRK = N*N + MAX( 3*N + BDSPAC, N + M ) END IF ELSE * -* Path 5 (M at least N, but not much larger) +* Path 5 (M >= N, but not much larger) * - WRKBL = 3*N + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N, -1, - $ -1 ) + WRKBL = 3*N + LWORK_DGEBRD_MN IF( WNTQN ) THEN - MAXWRK = MAX( WRKBL, BDSPAC+3*N ) +* Path 5n (M >= N, jobz='N') + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) ELSE IF( WNTQO ) THEN - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'QLN', M, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) +* Path 5o (M >= N, jobz='O') + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_MN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + M*N - MINWRK = 3*N + MAX( M, N*N+BDSPAC ) + MINWRK = 3*N + MAX( M, N*N + BDSPAC ) ELSE IF( WNTQS ) THEN - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'QLN', M, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*N ) +* Path 5s (M >= N, jobz='S') + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) ELSE IF( WNTQA ) THEN - WRKBL = MAX( WRKBL, 3*N+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, BDSPAC+3*N ) +* Path 5a (M >= N, jobz='A') + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) END IF END IF @@ -410,106 +447,129 @@ * * Compute space needed for DBDSDC * - MNTHR = INT( MINMN*11.0D0 / 6.0D0 ) IF( WNTQN ) THEN +* dbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) +* keep 7*N for backwards compatability. BDSPAC = 7*M ELSE BDSPAC = 3*M*M + 4*M END IF +* +* Compute space preferred for each routine + CALL DGEBRD( M, N, DUM(1), M, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_DGEBRD_MN = INT( DUM(1) ) +* + CALL DGEBRD( M, M, A, M, S, DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_DGEBRD_MM = INT( DUM(1) ) +* + CALL DGELQF( M, N, A, M, DUM(1), DUM(1), -1, IERR ) + LWORK_DGELQF_MN = INT( DUM(1) ) +* + CALL DORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR ) + LWORK_DORGLQ_NN = INT( DUM(1) ) +* + CALL DORGLQ( M, N, M, A, M, DUM(1), DUM(1), -1, IERR ) + LWORK_DORGLQ_MN = INT( DUM(1) ) +* + CALL DORGBR( 'P', M, M, M, A, N, DUM(1), DUM(1), -1, IERR ) + LWORK_DORGBR_P_MM = INT( DUM(1) ) +* + CALL DORMBR( 'P', 'R', 'T', M, M, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_DORMBR_PRT_MM = INT( DUM(1) ) +* + CALL DORMBR( 'P', 'R', 'T', M, N, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_DORMBR_PRT_MN = INT( DUM(1) ) +* + CALL DORMBR( 'P', 'R', 'T', N, N, M, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_DORMBR_PRT_NN = INT( DUM(1) ) +* + CALL DORMBR( 'Q', 'L', 'N', M, M, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_DORMBR_QLN_MM = INT( DUM(1) ) +* IF( N.GE.MNTHR ) THEN IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * - WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, - $ -1 ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+M ) + WRKBL = M + LWORK_DGELQF_MN + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD_MM ) + MAXWRK = MAX( WRKBL, BDSPAC + M ) MINWRK = BDSPAC + M ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * - WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) + WRKBL = M + LWORK_DGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_MN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + 2*M*M MINWRK = BDSPAC + 2*M*M + 3*M ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') +* Path 3t (N >> M, JOBZ='S') * - WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) + WRKBL = M + LWORK_DGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_MN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*M MINWRK = BDSPAC + M*M + 3*M ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * - WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'DORGLQ', ' ', N, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) + WRKBL = M + LWORK_DGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_NN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*M - MINWRK = BDSPAC + M*M + 3*M + MINWRK = M*M + MAX( 3*M + BDSPAC, M + N ) END IF ELSE * -* Path 5t (N greater than M, but not much larger) +* Path 5t (N > M, but not much larger) * - WRKBL = 3*M + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N, -1, - $ -1 ) + WRKBL = 3*M + LWORK_DGEBRD_MN IF( WNTQN ) THEN - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5tn (N > M, jobz='N') + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) ELSE IF( WNTQO ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', M, N, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) +* Path 5to (N > M, jobz='O') + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_MN ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*N - MINWRK = 3*M + MAX( N, M*M+BDSPAC ) + MINWRK = 3*M + MAX( N, M*M + BDSPAC ) ELSE IF( WNTQS ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', M, N, M, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5ts (N > M, jobz='S') + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_MN ) + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) ELSE IF( WNTQA ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, M, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5ta (N > M, jobz='A') + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) END IF END IF END IF + MAXWRK = MAX( MAXWRK, MINWRK ) WORK( 1 ) = MAXWRK * @@ -559,17 +619,18 @@ * IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need 2*N, prefer N+N*NB) +* Workspace: need N [tau] + N [work] +* Workspace: prefer N [tau] + N*NB [work] * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Zero out below R * @@ -580,7 +641,8 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* Workspace: need 3*N [e, tauq, taup] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + 2*N*NB [work] * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -588,14 +650,14 @@ NWORK = IE + N * * Perform bidiagonal SVD, computing singular values only -* (Workspace: need N+BDSPAC) +* Workspace: need N [e] + BDSPAC * CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ = 'O') +* Path 2 (M >> N, JOBZ = 'O') * N left singular vectors to be overwritten on A and * N right singular vectors to be computed in VT * @@ -603,42 +665,45 @@ * * WORK(IR) is LDWRKR by N * - IF( LWORK.GE.LDA*N+N*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. LDA*N + N*N + 3*N + BDSPAC ) THEN LDWRKR = LDA ELSE - LDWRKR = ( LWORK-N*N-3*N-BDSPAC ) / N + LDWRKR = ( LWORK - N*N - 3*N - BDSPAC ) / N END IF ITAU = IR + LDWRKR*N NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy R to WORK(IR), zeroing out below it * CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ), + CALL DLASET( 'L', N - 1, N - 1, ZERO, ZERO, WORK(IR+1), $ LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + N ITAUP = ITAUQ + N NWORK = ITAUP + N * -* Bidiagonalize R in VT, copying result to WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Bidiagonalize R in WORK(IR) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * WORK(IU) is N by N * @@ -648,7 +713,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -656,21 +721,23 @@ * * Overwrite WORK(IU) by left singular vectors of R * and VT by right singular vectors of R -* (Workspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IU ), N, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of R in * WORK(IU), storing result in WORK(IR) and copying to A -* (Workspace: need 2*N*N, prefer N*N+M*N) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] +* Workspace: prefer M*N [R] + 3*N [e, tauq, taup] + N*N [U] * DO 10 I = 1, M, LDWRKR - CHUNK = MIN( M-I+1, LDWRKR ) + CHUNK = MIN( M - I + 1, LDWRKR ) CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), $ LDA, WORK( IU ), N, ZERO, WORK( IR ), $ LDWRKR ) @@ -680,7 +747,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * N left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -693,38 +760,41 @@ NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy R to WORK(IR), zeroing out below it * CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ), + CALL DLASET( 'L', N - 1, N - 1, ZERO, ZERO, WORK(IR+1), $ LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + N ITAUP = ITAUQ + N NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagoal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -732,19 +802,20 @@ * * Overwrite U by left singular vectors of R and VT * by right singular vectors of R -* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * CALL DORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in U -* (Workspace: need N*N) +* Workspace: need N*N [R] * CALL DLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR ) CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA, WORK( IR ), @@ -752,7 +823,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * M left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -765,16 +836,18 @@ NWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* Workspace: need N*N [U] + N [tau] + N [work] +* Workspace: prefer N*N [U] + N [tau] + N*NB [work] * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* Workspace: need N*N [U] + N [tau] + M [work] +* Workspace: prefer N*N [U] + N [tau] + M*NB [work] CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Produce R in A, zeroing out other entries * @@ -785,7 +858,8 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [U] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -794,7 +868,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -802,18 +876,19 @@ * * Overwrite WORK(IU) by left singular vectors of R and VT * by right singular vectors of R -* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [U] + 3*N [e, tauq, taup] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', N, N, N, A, LDA, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in U by left singular vectors of R in * WORK(IU), storing result in A -* (Workspace: need N*N) +* Workspace: need N*N [U] * CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU, WORK( IU ), $ LDWRKU, ZERO, A, LDA ) @@ -828,7 +903,7 @@ * * M .LT. MNTHR * -* Path 5 (M at least N, but not much larger) +* Path 5 (M >= N, but not much larger) * Reduce to bidiagonal form without QR decomposition * IE = 1 @@ -837,21 +912,24 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) +* Workspace: need 3*N [e, tauq, taup] + M [work] +* Workspace: prefer 3*N [e, tauq, taup] + (M+N)*NB [work] * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5n (M >= N, JOBZ='N') * Perform bidiagonal SVD, only computing singular values -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 5o (M >= N, JOBZ='O') IU = NWORK - IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*N + BDSPAC ) THEN * * WORK( IU ) is M by N * @@ -859,6 +937,8 @@ NWORK = IU + LDWRKU*N CALL DLASET( 'F', M, N, ZERO, ZERO, WORK( IU ), $ LDWRKU ) +* IR is unused; silence compile warnings + IR = -1 ELSE * * WORK( IU ) is N by N @@ -869,53 +949,59 @@ * WORK(IR) is LDWRKR by N * IR = NWORK - LDWRKR = ( LWORK-N*N-3*N ) / N + LDWRKR = ( LWORK - N*N - 3*N ) / N END IF NWORK = IU + LDWRKU*N * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), $ LDWRKU, VT, LDVT, DUM, IDUM, WORK( NWORK ), $ IWORK, INFO ) * * Overwrite VT by right singular vectors of A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL DORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * - IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*N + BDSPAC ) THEN * +* Path 5o-fast * Overwrite WORK(IU) by left singular vectors of A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + M*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + M*N [U] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Copy left singular vectors of A from WORK(IU) to A * CALL DLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) ELSE * +* Path 5o-slow * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of * bidiagonal matrix in WORK(IU), storing result in * WORK(IR) and copying to A -* (Workspace: need 2*N*N, prefer N*N+M*N) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + NB*N [R] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + M*N [R] * DO 20 I = 1, M, LDWRKR - CHUNK = MIN( M-I+1, LDWRKR ) + CHUNK = MIN( M - I + 1, LDWRKR ) CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), $ LDA, WORK( IU ), LDWRKU, ZERO, $ WORK( IR ), LDWRKR ) @@ -926,10 +1012,11 @@ * ELSE IF( WNTQS ) THEN * +* Path 5s (M >= N, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL DLASET( 'F', M, N, ZERO, ZERO, U, LDU ) CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, @@ -938,20 +1025,22 @@ * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 3*N, prefer 2*N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) ELSE IF( WNTQA ) THEN * +* Path 5a (M >= N, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL DLASET( 'F', M, M, ZERO, ZERO, U, LDU ) CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, @@ -961,20 +1050,21 @@ * Set the right corner of U to identity matrix * IF( M.GT.N ) THEN - CALL DLASET( 'F', M-N, M-N, ZERO, ONE, U( N+1, N+1 ), + CALL DLASET( 'F', M - N, M - N, ZERO, ONE, U(N+1,N+1), $ LDU ) END IF * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need N*N+2*N+M, prefer N*N+2*N+M*NB) +* Workspace: need 3*N [e, tauq, taup] + M [work] +* Workspace: prefer 3*N [e, tauq, taup] + M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', N, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) END IF * END IF @@ -989,17 +1079,18 @@ * IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M, prefer M+M*NB) +* Workspace: need M [tau] + M [work] +* Workspace: prefer M [tau] + M*NB [work] * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Zero out above L * @@ -1010,7 +1101,8 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* Workspace: need 3*M [e, tauq, taup] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + 2*M*NB [work] * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1018,68 +1110,69 @@ NWORK = IE + M * * Perform bidiagonal SVD, computing singular values only -* (Workspace: need M+BDSPAC) +* Workspace: need M [e] + BDSPAC * CALL DBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * M right singular vectors to be overwritten on A and * M left singular vectors to be computed in U * IVT = 1 * -* IVT is M by M +* WORK(IVT) is M by M +* WORK(IL) is M by M; it is later resized to M by chunk for gemm * IL = IVT + M*M - IF( LWORK.GE.M*N+M*M+3*M+BDSPAC ) THEN -* -* WORK(IL) is M by N -* + IF( LWORK .GE. M*N + M*M + 3*M + BDSPAC ) THEN LDWRKL = M CHUNK = N ELSE LDWRKL = M - CHUNK = ( LWORK-M*M ) / M + CHUNK = ( LWORK - M*M ) / M END IF ITAU = IL + LDWRKL*M NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing about above it * CALL DLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL ) - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, - $ WORK( IL+LDWRKL ), LDWRKL ) + CALL DLASET( 'U', M - 1, M - 1, ZERO, ZERO, + $ WORK( IL + LDWRKL ), LDWRKL ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + M ITAUP = ITAUQ + M NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL DGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U, and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M+M*M+BDSPAC) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), M, DUM, IDUM, WORK( NWORK ), @@ -1087,21 +1180,24 @@ * * Overwrite U by left singular vectors of L and WORK(IVT) * by right singular vectors of L -* (Workspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUP ), WORK( IVT ), M, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IVT) by Q * in A, storing result in WORK(IL) and copying to A -* (Workspace: need 2*M*M, prefer M*M+M*N) +* Workspace: need M*M [VT] + M*M [L] +* Workspace: prefer M*M [VT] + M*N [L] +* At this point, L is resized as M by chunk. * DO 30 I = 1, N, CHUNK - BLK = MIN( N-I+1, CHUNK ) + BLK = MIN( N - I + 1, CHUNK ) CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), M, $ A( 1, I ), LDA, ZERO, WORK( IL ), LDWRKL ) CALL DLACPY( 'F', M, BLK, WORK( IL ), LDWRKL, @@ -1110,7 +1206,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') +* Path 3t (N >> M, JOBZ='S') * M right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1123,38 +1219,41 @@ NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [L] + M [tau] + M*NB [work] * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing out above it * CALL DLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL ) - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, - $ WORK( IL+LDWRKL ), LDWRKL ) + CALL DLASET( 'U', M - 1, M - 1, ZERO, ZERO, + $ WORK( IL + LDWRKL ), LDWRKL ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [L] + M [tau] + M*NB [work] * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + M ITAUP = ITAUQ + M NWORK = ITAUP + M * -* Bidiagonalize L in WORK(IU), copying result to U -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Bidiagonalize L in WORK(IU). +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [L] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL DGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, VT, $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -1162,18 +1261,19 @@ * * Overwrite U by left singular vectors of L and VT * by right singular vectors of L -* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB) +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [L] + 3*M [e, tauq, taup] + M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IL) by * Q in A, storing result in VT -* (Workspace: need M*M) +* Workspace: need M*M [L] * CALL DLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL ) CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IL ), LDWRKL, @@ -1181,7 +1281,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * N right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1194,17 +1294,19 @@ NWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M [tau] + M*NB [work] * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M [tau] + N [work] +* Workspace: prefer M*M [VT] + M [tau] + N*NB [work] * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Produce L in A, zeroing out other entries * @@ -1215,7 +1317,8 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1224,7 +1327,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M+M*M+BDSPAC) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), LDWKVT, DUM, IDUM, @@ -1232,18 +1335,19 @@ * * Overwrite U by left singular vectors of L and WORK(IVT) * by right singular vectors of L -* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup]+ M [work] +* Workspace: prefer M*M [VT] + 3*M [e, tauq, taup]+ M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, M, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', M, M, M, A, LDA, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IVT) by * Q in VT, storing result in A -* (Workspace: need M*M) +* Workspace: need M*M [VT] * CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IVT ), LDWKVT, $ VT, LDVT, ZERO, A, LDA ) @@ -1258,7 +1362,7 @@ * * N .LT. MNTHR * -* Path 5t (N greater than M, but not much larger) +* Path 5t (N > M, but not much larger) * Reduce to bidiagonal form without LQ decomposition * IE = 1 @@ -1267,28 +1371,33 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) +* Workspace: need 3*M [e, tauq, taup] + N [work] +* Workspace: prefer 3*M [e, tauq, taup] + (M+N)*NB [work] * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5tn (N > M, JOBZ='N') * Perform bidiagonal SVD, only computing singular values -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'L', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 5to (N > M, JOBZ='O') LDWKVT = M IVT = NWORK - IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*M + BDSPAC ) THEN * * WORK( IVT ) is M by N * CALL DLASET( 'F', M, N, ZERO, ZERO, WORK( IVT ), $ LDWKVT ) NWORK = IVT + LDWKVT*N +* IL is unused; silence compile warnings + IL = -1 ELSE * * WORK( IVT ) is M by M @@ -1298,52 +1407,58 @@ * * WORK(IL) is M by CHUNK * - CHUNK = ( LWORK-M*M-3*M ) / M + CHUNK = ( LWORK - M*M - 3*M ) / M END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M*M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + BDSPAC * CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), LDWKVT, DUM, IDUM, $ WORK( NWORK ), IWORK, INFO ) * * Overwrite U by left singular vectors of A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * - IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*M + BDSPAC ) THEN * +* Path 5to-fast * Overwrite WORK(IVT) by left singular vectors of A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*N [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*N [VT] + M*NB [work] * CALL DORMBR( 'P', 'R', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Copy right singular vectors of A from WORK(IVT) to A * CALL DLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) ELSE * +* Path 5to-slow * Generate P**T in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*NB [work] * CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply Q in A by right singular vectors of * bidiagonal matrix in WORK(IVT), storing result in * WORK(IL) and copying to A -* (Workspace: need 2*M*M, prefer M*M+M*N) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M*NB [L] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*N [L] * DO 40 I = 1, N, CHUNK - BLK = MIN( N-I+1, CHUNK ) + BLK = MIN( N - I + 1, CHUNK ) CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), $ LDWKVT, A( 1, I ), LDA, ZERO, $ WORK( IL ), M ) @@ -1353,10 +1468,11 @@ END IF ELSE IF( WNTQS ) THEN * +* Path 5ts (N > M, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL DLASET( 'F', M, N, ZERO, ZERO, VT, LDVT ) CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT, @@ -1365,20 +1481,22 @@ * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 3*M, prefer 2*M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) ELSE IF( WNTQA ) THEN * +* Path 5ta (N > M, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL DLASET( 'F', N, N, ZERO, ZERO, VT, LDVT ) CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT, @@ -1388,20 +1506,21 @@ * Set the right corner of VT to identity matrix * IF( N.GT.M ) THEN - CALL DLASET( 'F', N-M, N-M, ZERO, ONE, VT( M+1, M+1 ), + CALL DLASET( 'F', N-M, N-M, ZERO, ONE, VT(M+1,M+1), $ LDVT ) END IF * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 2*M+N, prefer 2*M+N*NB) +* Workspace: need 3*M [e, tauq, taup] + N [work] +* Workspace: prefer 3*M [e, tauq, taup] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', N, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) END IF * END IF diff --git a/lapack-netlib/SRC/dgesvd.f b/lapack-netlib/SRC/dgesvd.f index 898570b66..0c40673a4 100644 --- a/lapack-netlib/SRC/dgesvd.f +++ b/lapack-netlib/SRC/dgesvd.f @@ -175,7 +175,7 @@ *> LWORK >= MAX(1,5*MIN(M,N)) for the paths (see comments inside code): *> - PATH 1 (M much larger than N, JOBU='N') *> - PATH 1t (N much larger than M, JOBVT='N') -*> LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) for the other paths +*> LWORK >= MAX(1,3*MIN(M,N) + MAX(M,N),5*MIN(M,N)) for the other paths *> For good performance, LWORK should generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -211,7 +211,7 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, $ VT, LDVT, WORK, LWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.1) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -314,24 +314,24 @@ BDSPAC = 5*N * Compute space needed for DGEQRF CALL DGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_DGEQRF=DUM(1) + LWORK_DGEQRF = INT( DUM(1) ) * Compute space needed for DORGQR CALL DORGQR( M, N, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_DORGQR_N=DUM(1) + LWORK_DORGQR_N = INT( DUM(1) ) CALL DORGQR( M, M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_DORGQR_M=DUM(1) + LWORK_DORGQR_M = INT( DUM(1) ) * Compute space needed for DGEBRD CALL DGEBRD( N, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) * Compute space needed for DORGBR P CALL DORGBR( 'P', N, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_P=DUM(1) + LWORK_DORGBR_P = INT( DUM(1) ) * Compute space needed for DORGBR Q CALL DORGBR( 'Q', N, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_Q=DUM(1) + LWORK_DORGBR_Q = INT( DUM(1) ) * IF( M.GE.MNTHR ) THEN IF( WNTUN ) THEN @@ -339,9 +339,9 @@ * Path 1 (M much larger than N, JOBU='N') * MAXWRK = N + LWORK_DGEQRF - MAXWRK = MAX( MAXWRK, 3*N+LWORK_DGEBRD ) + MAXWRK = MAX( MAXWRK, 3*N + LWORK_DGEBRD ) IF( WNTVO .OR. WNTVAS ) - $ MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_P ) + $ MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR_P ) MAXWRK = MAX( MAXWRK, BDSPAC ) MINWRK = MAX( 4*N, BDSPAC ) ELSE IF( WNTUO .AND. WNTVN ) THEN @@ -349,97 +349,97 @@ * Path 2 (M much larger than N, JOBU='O', JOBVT='N') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_N ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) - MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N ) - MINWRK = MAX( 3*N+M, BDSPAC ) + MAXWRK = MAX( N*N + WRKBL, N*N + M*N + N ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUO .AND. WNTVAS ) THEN * * Path 3 (M much larger than N, JOBU='O', JOBVT='S' or * 'A') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_N ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) - MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N ) - MINWRK = MAX( 3*N+M, BDSPAC ) + MAXWRK = MAX( N*N + WRKBL, N*N + M*N + N ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUS .AND. WNTVN ) THEN * * Path 4 (M much larger than N, JOBU='S', JOBVT='N') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_N ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUS .AND. WNTVO ) THEN * * Path 5 (M much larger than N, JOBU='S', JOBVT='O') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_N ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = 2*N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUS .AND. WNTVAS ) THEN * * Path 6 (M much larger than N, JOBU='S', JOBVT='S' or * 'A') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_N ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUA .AND. WNTVN ) THEN * * Path 7 (M much larger than N, JOBU='A', JOBVT='N') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_M ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUA .AND. WNTVO ) THEN * * Path 8 (M much larger than N, JOBU='A', JOBVT='O') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_M ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = 2*N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUA .AND. WNTVAS ) THEN * * Path 9 (M much larger than N, JOBU='A', JOBVT='S' or * 'A') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_M ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) END IF ELSE * @@ -447,25 +447,25 @@ * CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) MAXWRK = 3*N + LWORK_DGEBRD IF( WNTUS .OR. WNTUO ) THEN CALL DORGBR( 'Q', M, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_Q=DUM(1) - MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_Q ) + LWORK_DORGBR_Q = INT( DUM(1) ) + MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR_Q ) END IF IF( WNTUA ) THEN CALL DORGBR( 'Q', M, M, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_Q=DUM(1) - MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_Q ) + LWORK_DORGBR_Q = INT( DUM(1) ) + MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR_Q ) END IF IF( .NOT.WNTVN ) THEN - MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_P ) + MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR_P ) END IF MAXWRK = MAX( MAXWRK, BDSPAC ) - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) END IF ELSE IF( MINMN.GT.0 ) THEN * @@ -475,33 +475,33 @@ BDSPAC = 5*M * Compute space needed for DGELQF CALL DGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_DGELQF=DUM(1) + LWORK_DGELQF = INT( DUM(1) ) * Compute space needed for DORGLQ CALL DORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR ) - LWORK_DORGLQ_N=DUM(1) + LWORK_DORGLQ_N = INT( DUM(1) ) CALL DORGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_DORGLQ_M=DUM(1) + LWORK_DORGLQ_M = INT( DUM(1) ) * Compute space needed for DGEBRD CALL DGEBRD( M, M, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) * Compute space needed for DORGBR P CALL DORGBR( 'P', M, M, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_P=DUM(1) + LWORK_DORGBR_P = INT( DUM(1) ) * Compute space needed for DORGBR Q CALL DORGBR( 'Q', M, M, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_Q=DUM(1) + LWORK_DORGBR_Q = INT( DUM(1) ) IF( N.GE.MNTHR ) THEN IF( WNTVN ) THEN * * Path 1t(N much larger than M, JOBVT='N') * MAXWRK = M + LWORK_DGELQF - MAXWRK = MAX( MAXWRK, 3*M+LWORK_DGEBRD ) + MAXWRK = MAX( MAXWRK, 3*M + LWORK_DGEBRD ) IF( WNTUO .OR. WNTUAS ) - $ MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_Q ) + $ MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR_Q ) MAXWRK = MAX( MAXWRK, BDSPAC ) MINWRK = MAX( 4*M, BDSPAC ) ELSE IF( WNTVO .AND. WNTUN ) THEN @@ -509,97 +509,97 @@ * Path 2t(N much larger than M, JOBU='N', JOBVT='O') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_M ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) - MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M ) - MINWRK = MAX( 3*M+N, BDSPAC ) + MAXWRK = MAX( M*M + WRKBL, M*M + M*N + M ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVO .AND. WNTUAS ) THEN * * Path 3t(N much larger than M, JOBU='S' or 'A', * JOBVT='O') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_M ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) - MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M ) - MINWRK = MAX( 3*M+N, BDSPAC ) + MAXWRK = MAX( M*M + WRKBL, M*M + M*N + M ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVS .AND. WNTUN ) THEN * * Path 4t(N much larger than M, JOBU='N', JOBVT='S') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_M ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVS .AND. WNTUO ) THEN * * Path 5t(N much larger than M, JOBU='O', JOBVT='S') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_M ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = 2*M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVS .AND. WNTUAS ) THEN * * Path 6t(N much larger than M, JOBU='S' or 'A', * JOBVT='S') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_M ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVA .AND. WNTUN ) THEN * * Path 7t(N much larger than M, JOBU='N', JOBVT='A') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_N ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVA .AND. WNTUO ) THEN * * Path 8t(N much larger than M, JOBU='O', JOBVT='A') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_N ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = 2*M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVA .AND. WNTUAS ) THEN * * Path 9t(N much larger than M, JOBU='S' or 'A', * JOBVT='A') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_N ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) END IF ELSE * @@ -607,26 +607,26 @@ * CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) MAXWRK = 3*M + LWORK_DGEBRD IF( WNTVS .OR. WNTVO ) THEN * Compute space needed for DORGBR P CALL DORGBR( 'P', M, N, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_P=DUM(1) - MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_P ) + LWORK_DORGBR_P = INT( DUM(1) ) + MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR_P ) END IF IF( WNTVA ) THEN CALL DORGBR( 'P', N, N, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_P=DUM(1) - MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_P ) + LWORK_DORGBR_P = INT( DUM(1) ) + MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR_P ) END IF IF( .NOT.WNTUN ) THEN - MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_Q ) + MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR_Q ) END IF MAXWRK = MAX( MAXWRK, BDSPAC ) - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) END IF END IF MAXWRK = MAX( MAXWRK, MINWRK ) @@ -685,21 +685,24 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Zero out below R * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) + END IF IE = 1 ITAUQ = IE + N ITAUP = ITAUQ + N IWORK = ITAUP + N * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, @@ -708,7 +711,7 @@ IF( WNTVO .OR. WNTVAS ) THEN * * If right singular vectors desired, generate P'. -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -739,13 +742,13 @@ * Sufficient workspace for a fast algorithm * IR = 1 - IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN + IF( LWORK.GE.MAX( WRKBL, LDA*N + N ) + LDA*N ) THEN * * WORK(IU) is LDA by N, WORK(IR) is LDA by N * LDWRKU = LDA LDWRKR = LDA - ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN + ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N + N ) + N*N ) THEN * * WORK(IU) is LDA by N, WORK(IR) is N by N * @@ -762,7 +765,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -774,7 +777,7 @@ $ LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -784,14 +787,14 @@ IWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left vectors bidiagonalizing R -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), @@ -800,7 +803,7 @@ * * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IR) -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, 1, $ WORK( IR ), LDWRKR, DUM, 1, @@ -809,7 +812,7 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in WORK(IU) and copying to A -* (Workspace: need N*N+2*N, prefer N*N+M*N+N) +* (Workspace: need N*N + 2*N, prefer N*N + M*N + N) * DO 10 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) @@ -830,14 +833,14 @@ IWORK = ITAUP + N * * Bidiagonalize A -* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) +* (Workspace: need 3*N + M, prefer 3*N + (M + N)*NB) * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left vectors bidiagonalizing A -* (Workspace: need 4*N, prefer 3*N+N*NB) +* (Workspace: need 4*N, prefer 3*N + N*NB) * CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -863,13 +866,13 @@ * Sufficient workspace for a fast algorithm * IR = 1 - IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN + IF( LWORK.GE.MAX( WRKBL, LDA*N + N ) + LDA*N ) THEN * * WORK(IU) is LDA by N and WORK(IR) is LDA by N * LDWRKU = LDA LDWRKR = LDA - ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN + ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N + N ) + N*N ) THEN * * WORK(IU) is LDA by N and WORK(IR) is N by N * @@ -886,7 +889,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -899,7 +902,7 @@ $ VT( 2, 1 ), LDVT ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -909,7 +912,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in VT, copying result to WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -917,14 +920,14 @@ CALL DLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR ) * * Generate left vectors bidiagonalizing R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right vectors bidiagonalizing R in VT -* (Workspace: need N*N+4*N-1, prefer N*N+3*N+(N-1)*NB) +* (Workspace: need N*N + 4*N-1, prefer N*N + 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -933,7 +936,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IR) and computing right * singular vectors of R in VT -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, LDVT, $ WORK( IR ), LDWRKR, DUM, 1, @@ -942,7 +945,7 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in WORK(IU) and copying to A -* (Workspace: need N*N+2*N, prefer N*N+M*N+N) +* (Workspace: need N*N + 2*N, prefer N*N + M*N + N) * DO 20 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) @@ -961,7 +964,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -974,7 +977,7 @@ $ VT( 2, 1 ), LDVT ) * * Generate Q in A -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -984,21 +987,21 @@ IWORK = ITAUP + N * * Bidiagonalize R in VT -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply Q in A by left vectors bidiagonalizing R -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT, $ WORK( ITAUQ ), A, LDA, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right vectors bidiagonalizing R in VT -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1042,7 +1045,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1055,7 +1058,7 @@ $ WORK( IR+1 ), LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1065,7 +1068,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, $ WORK( IE ), WORK( ITAUQ ), @@ -1073,7 +1076,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate left vectors bidiagonalizing R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), @@ -1082,7 +1085,7 @@ * * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IR) -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, $ 1, WORK( IR ), LDWRKR, DUM, 1, @@ -1103,14 +1106,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1121,18 +1124,20 @@ * * Zero out below R in A * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply Q in U by left vectors bidiagonalizing R -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), @@ -1167,7 +1172,7 @@ LDWRKU = LDA IR = IU + LDWRKU*N LDWRKR = LDA - ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN + ELSE IF( LWORK.GE.WRKBL+( LDA + N )*N ) THEN * * WORK(IU) is LDA by N and WORK(IR) is N by N * @@ -1186,7 +1191,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) +* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1199,7 +1204,7 @@ $ WORK( IU+1 ), LDWRKU ) * * Generate Q in A -* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) +* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1210,7 +1215,7 @@ * * Bidiagonalize R in WORK(IU), copying result to * WORK(IR) -* (Workspace: need 2*N*N+4*N, +* (Workspace: need 2*N*N + 4*N, * prefer 2*N*N+3*N+2*N*NB) * CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S, @@ -1221,14 +1226,14 @@ $ WORK( IR ), LDWRKR ) * * Generate left bidiagonalizing vectors in WORK(IU) -* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB) +* (Workspace: need 2*N*N + 4*N, prefer 2*N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU, $ WORK( ITAUQ ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in WORK(IR) -* (Workspace: need 2*N*N+4*N-1, +* (Workspace: need 2*N*N + 4*N-1, * prefer 2*N*N+3*N+(N-1)*NB) * CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR, @@ -1239,7 +1244,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IU) and computing * right singular vectors of R in WORK(IR) -* (Workspace: need 2*N*N+BDSPAC) +* (Workspace: need 2*N*N + BDSPAC) * CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, WORK( IU ), @@ -1266,14 +1271,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1284,25 +1289,27 @@ * * Zero out below R in A * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply Q in U by left vectors bidiagonalizing R -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right vectors bidiagonalizing R in A -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1346,7 +1353,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1359,7 +1366,7 @@ $ WORK( IU+1 ), LDWRKU ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1369,7 +1376,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in WORK(IU), copying result to VT -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S, $ WORK( IE ), WORK( ITAUQ ), @@ -1379,14 +1386,14 @@ $ LDVT ) * * Generate left bidiagonalizing vectors in WORK(IU) -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU, $ WORK( ITAUQ ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in VT -* (Workspace: need N*N+4*N-1, +* (Workspace: need N*N + 4*N-1, * prefer N*N+3*N+(N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), @@ -1396,7 +1403,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IU) and computing * right singular vectors of R in VT -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, $ LDVT, WORK( IU ), LDWRKU, DUM, 1, @@ -1417,14 +1424,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1441,7 +1448,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in VT -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -1449,14 +1456,14 @@ * * Multiply Q in U by left bidiagonalizing vectors * in VT -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in VT -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1503,7 +1510,7 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1517,7 +1524,7 @@ $ WORK( IR+1 ), LDWRKR ) * * Generate Q in U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* (Workspace: need N*N + N + M, prefer N*N + N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1527,7 +1534,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, $ WORK( IE ), WORK( ITAUQ ), @@ -1535,7 +1542,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), @@ -1544,7 +1551,7 @@ * * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IR) -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, $ 1, WORK( IR ), LDWRKR, DUM, 1, @@ -1569,14 +1576,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N+M, prefer N+M*NB) +* (Workspace: need N + M, prefer N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1587,11 +1594,13 @@ * * Zero out below R in A * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -1599,7 +1608,7 @@ * * Multiply Q in U by left bidiagonalizing vectors * in A -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), @@ -1634,7 +1643,7 @@ LDWRKU = LDA IR = IU + LDWRKU*N LDWRKR = LDA - ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN + ELSE IF( LWORK.GE.WRKBL+( LDA + N )*N ) THEN * * WORK(IU) is LDA by N and WORK(IR) is N by N * @@ -1653,14 +1662,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) +* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB) +* (Workspace: need 2*N*N + N + M, prefer 2*N*N + N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1678,7 +1687,7 @@ * * Bidiagonalize R in WORK(IU), copying result to * WORK(IR) -* (Workspace: need 2*N*N+4*N, +* (Workspace: need 2*N*N + 4*N, * prefer 2*N*N+3*N+2*N*NB) * CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S, @@ -1689,14 +1698,14 @@ $ WORK( IR ), LDWRKR ) * * Generate left bidiagonalizing vectors in WORK(IU) -* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB) +* (Workspace: need 2*N*N + 4*N, prefer 2*N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU, $ WORK( ITAUQ ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in WORK(IR) -* (Workspace: need 2*N*N+4*N-1, +* (Workspace: need 2*N*N + 4*N-1, * prefer 2*N*N+3*N+(N-1)*NB) * CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR, @@ -1707,7 +1716,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IU) and computing * right singular vectors of R in WORK(IR) -* (Workspace: need 2*N*N+BDSPAC) +* (Workspace: need 2*N*N + BDSPAC) * CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, WORK( IU ), @@ -1737,14 +1746,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N+M, prefer N+M*NB) +* (Workspace: need N + M, prefer N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1755,11 +1764,13 @@ * * Zero out below R in A * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -1767,14 +1778,14 @@ * * Multiply Q in U by left bidiagonalizing vectors * in A -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in A -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1818,14 +1829,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* (Workspace: need N*N + N + M, prefer N*N + N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1842,7 +1853,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in WORK(IU), copying result to VT -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S, $ WORK( IE ), WORK( ITAUQ ), @@ -1852,14 +1863,14 @@ $ LDVT ) * * Generate left bidiagonalizing vectors in WORK(IU) -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU, $ WORK( ITAUQ ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in VT -* (Workspace: need N*N+4*N-1, +* (Workspace: need N*N + 4*N-1, * prefer N*N+3*N+(N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), @@ -1869,7 +1880,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IU) and computing * right singular vectors of R in VT -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, $ LDVT, WORK( IU ), LDWRKU, DUM, 1, @@ -1894,14 +1905,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N+M, prefer N+M*NB) +* (Workspace: need N + M, prefer N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1918,7 +1929,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in VT -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -1926,14 +1937,14 @@ * * Multiply Q in U by left bidiagonalizing vectors * in VT -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in VT -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1967,7 +1978,7 @@ IWORK = ITAUP + N * * Bidiagonalize A -* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) +* (Workspace: need 3*N + M, prefer 3*N + (M + N)*NB) * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, @@ -1976,7 +1987,7 @@ * * If left singular vectors desired in U, copy result to U * and generate left bidiagonalizing vectors in U -* (Workspace: need 3*N+NCU, prefer 3*N+NCU*NB) +* (Workspace: need 3*N + NCU, prefer 3*N + NCU*NB) * CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) IF( WNTUS ) @@ -1990,7 +2001,7 @@ * * If right singular vectors desired in VT, copy result to * VT and generate right bidiagonalizing vectors in VT -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), @@ -2000,7 +2011,7 @@ * * If left singular vectors desired in A, generate left * bidiagonalizing vectors in A -* (Workspace: need 4*N, prefer 3*N+N*NB) +* (Workspace: need 4*N, prefer 3*N + N*NB) * CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2009,7 +2020,7 @@ * * If right singular vectors desired in A, generate right * bidiagonalizing vectors in A -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2071,7 +2082,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) @@ -2085,7 +2096,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, @@ -2093,7 +2104,7 @@ IF( WNTUO .OR. WNTUAS ) THEN * * If left singular vectors desired, generate Q -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2126,14 +2137,14 @@ * Sufficient workspace for a fast algorithm * IR = 1 - IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN + IF( LWORK.GE.MAX( WRKBL, LDA*N + M ) + LDA*M ) THEN * * WORK(IU) is LDA by N and WORK(IR) is LDA by M * LDWRKU = LDA CHUNK = N LDWRKR = LDA - ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN + ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N + M ) + M*M ) THEN * * WORK(IU) is LDA by N and WORK(IR) is M by M * @@ -2152,7 +2163,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2164,7 +2175,7 @@ $ WORK( IR+LDWRKR ), LDWRKR ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2174,14 +2185,14 @@ IWORK = ITAUP + M * * Bidiagonalize L in WORK(IR) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate right vectors bidiagonalizing L -* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) +* (Workspace: need M*M + 4*M-1, prefer M*M + 3*M + (M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR, $ WORK( ITAUP ), WORK( IWORK ), @@ -2190,7 +2201,7 @@ * * Perform bidiagonal QR iteration, computing right * singular vectors of L in WORK(IR) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1, @@ -2199,7 +2210,7 @@ * * Multiply right singular vectors of L in WORK(IR) by Q * in A, storing result in WORK(IU) and copying to A -* (Workspace: need M*M+2*M, prefer M*M+M*N+M) +* (Workspace: need M*M + 2*M, prefer M*M + M*N + M) * DO 30 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) @@ -2220,14 +2231,14 @@ IWORK = ITAUP + M * * Bidiagonalize A -* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) +* (Workspace: need 3*M + N, prefer 3*M + (M + N)*NB) * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate right vectors bidiagonalizing A -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2253,14 +2264,14 @@ * Sufficient workspace for a fast algorithm * IR = 1 - IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN + IF( LWORK.GE.MAX( WRKBL, LDA*N + M ) + LDA*M ) THEN * * WORK(IU) is LDA by N and WORK(IR) is LDA by M * LDWRKU = LDA CHUNK = N LDWRKR = LDA - ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN + ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N + M ) + M*M ) THEN * * WORK(IU) is LDA by N and WORK(IR) is M by M * @@ -2279,7 +2290,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2291,7 +2302,7 @@ $ LDU ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2301,7 +2312,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in U, copying result to WORK(IR) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, U, LDU, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -2309,14 +2320,14 @@ CALL DLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR ) * * Generate right vectors bidiagonalizing L in WORK(IR) -* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) +* (Workspace: need M*M + 4*M-1, prefer M*M + 3*M + (M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR, $ WORK( ITAUP ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate left vectors bidiagonalizing L in U -* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2325,7 +2336,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of L in U, and computing right * singular vectors of L in WORK(IR) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, U, LDU, DUM, 1, @@ -2334,7 +2345,7 @@ * * Multiply right singular vectors of L in WORK(IR) by Q * in A, storing result in WORK(IU) and copying to A -* (Workspace: need M*M+2*M, prefer M*M+M*N+M)) +* (Workspace: need M*M + 2*M, prefer M*M + M*N + M)) * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) @@ -2353,7 +2364,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2365,7 +2376,7 @@ $ LDU ) * * Generate Q in A -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2375,21 +2386,21 @@ IWORK = ITAUP + M * * Bidiagonalize L in U -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, U, LDU, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply right vectors bidiagonalizing L by Q in A -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU, $ WORK( ITAUP ), A, LDA, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate left vectors bidiagonalizing L in U -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2433,7 +2444,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2446,7 +2457,7 @@ $ WORK( IR+LDWRKR ), LDWRKR ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2456,7 +2467,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in WORK(IR) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, $ WORK( IE ), WORK( ITAUQ ), @@ -2465,7 +2476,7 @@ * * Generate right vectors bidiagonalizing L in * WORK(IR) -* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + (M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR, $ WORK( ITAUP ), WORK( IWORK ), @@ -2474,7 +2485,7 @@ * * Perform bidiagonal QR iteration, computing right * singular vectors of L in WORK(IR) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1, @@ -2495,7 +2506,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2505,7 +2516,7 @@ CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2520,14 +2531,14 @@ $ LDA ) * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply right vectors bidiagonalizing L by Q in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, @@ -2562,7 +2573,7 @@ LDWRKU = LDA IR = IU + LDWRKU*M LDWRKR = LDA - ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN + ELSE IF( LWORK.GE.WRKBL+( LDA + M )*M ) THEN * * WORK(IU) is LDA by M and WORK(IR) is M by M * @@ -2581,7 +2592,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) +* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2594,7 +2605,7 @@ $ WORK( IU+LDWRKU ), LDWRKU ) * * Generate Q in A -* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) +* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2605,7 +2616,7 @@ * * Bidiagonalize L in WORK(IU), copying result to * WORK(IR) -* (Workspace: need 2*M*M+4*M, +* (Workspace: need 2*M*M + 4*M, * prefer 2*M*M+3*M+2*M*NB) * CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S, @@ -2616,7 +2627,7 @@ $ WORK( IR ), LDWRKR ) * * Generate right bidiagonalizing vectors in WORK(IU) -* (Workspace: need 2*M*M+4*M-1, +* (Workspace: need 2*M*M + 4*M-1, * prefer 2*M*M+3*M+(M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU, @@ -2624,7 +2635,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in WORK(IR) -* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB) +* (Workspace: need 2*M*M + 4*M, prefer 2*M*M + 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), @@ -2634,7 +2645,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of L in WORK(IR) and computing * right singular vectors of L in WORK(IU) -* (Workspace: need 2*M*M+BDSPAC) +* (Workspace: need 2*M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ), $ WORK( IU ), LDWRKU, WORK( IR ), @@ -2661,14 +2672,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2683,21 +2694,21 @@ $ LDA ) * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply right vectors bidiagonalizing L by Q in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors of L in A -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2741,7 +2752,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2754,7 +2765,7 @@ $ WORK( IU+LDWRKU ), LDWRKU ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2764,7 +2775,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in WORK(IU), copying result to U -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S, $ WORK( IE ), WORK( ITAUQ ), @@ -2774,7 +2785,7 @@ $ LDU ) * * Generate right bidiagonalizing vectors in WORK(IU) -* (Workspace: need M*M+4*M-1, +* (Workspace: need M*M + 4*M-1, * prefer M*M+3*M+(M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU, @@ -2782,7 +2793,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in U -* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2791,7 +2802,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of L in U and computing right * singular vectors of L in WORK(IU) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ), $ WORK( IU ), LDWRKU, U, LDU, DUM, 1, @@ -2812,14 +2823,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2835,7 +2846,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in U -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, U, LDU, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -2843,14 +2854,14 @@ * * Multiply right bidiagonalizing vectors in U by Q * in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU, $ WORK( ITAUP ), VT, LDVT, $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in U -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2877,7 +2888,7 @@ * N right singular vectors to be computed in VT and * no left singular vectors to be computed * - IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN + IF( LWORK.GE.M*M+MAX( N + M, 4*M, BDSPAC ) ) THEN * * Sufficient workspace for a fast algorithm * @@ -2897,7 +2908,7 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2911,7 +2922,7 @@ $ WORK( IR+LDWRKR ), LDWRKR ) * * Generate Q in VT -* (Workspace: need M*M+M+N, prefer M*M+M+N*NB) +* (Workspace: need M*M + M + N, prefer M*M + M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2921,7 +2932,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in WORK(IR) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, $ WORK( IE ), WORK( ITAUQ ), @@ -2929,7 +2940,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in WORK(IR) -* (Workspace: need M*M+4*M-1, +* (Workspace: need M*M + 4*M-1, * prefer M*M+3*M+(M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR, @@ -2939,7 +2950,7 @@ * * Perform bidiagonal QR iteration, computing right * singular vectors of L in WORK(IR) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1, @@ -2964,14 +2975,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M+N, prefer M+N*NB) +* (Workspace: need M + N, prefer M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2986,7 +2997,7 @@ $ LDA ) * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -2994,7 +3005,7 @@ * * Multiply right bidiagonalizing vectors in A by Q * in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, @@ -3017,7 +3028,7 @@ * N right singular vectors to be computed in VT and * M left singular vectors to be overwritten on A * - IF( LWORK.GE.2*M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN + IF( LWORK.GE.2*M*M+MAX( N + M, 4*M, BDSPAC ) ) THEN * * Sufficient workspace for a fast algorithm * @@ -3029,7 +3040,7 @@ LDWRKU = LDA IR = IU + LDWRKU*M LDWRKR = LDA - ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN + ELSE IF( LWORK.GE.WRKBL+( LDA + M )*M ) THEN * * WORK(IU) is LDA by M and WORK(IR) is M by M * @@ -3048,14 +3059,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) +* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB) +* (Workspace: need 2*M*M + M + N, prefer 2*M*M + M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3073,7 +3084,7 @@ * * Bidiagonalize L in WORK(IU), copying result to * WORK(IR) -* (Workspace: need 2*M*M+4*M, +* (Workspace: need 2*M*M + 4*M, * prefer 2*M*M+3*M+2*M*NB) * CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S, @@ -3084,7 +3095,7 @@ $ WORK( IR ), LDWRKR ) * * Generate right bidiagonalizing vectors in WORK(IU) -* (Workspace: need 2*M*M+4*M-1, +* (Workspace: need 2*M*M + 4*M-1, * prefer 2*M*M+3*M+(M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU, @@ -3092,7 +3103,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in WORK(IR) -* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB) +* (Workspace: need 2*M*M + 4*M, prefer 2*M*M + 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), @@ -3102,7 +3113,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of L in WORK(IR) and computing * right singular vectors of L in WORK(IU) -* (Workspace: need 2*M*M+BDSPAC) +* (Workspace: need 2*M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ), $ WORK( IU ), LDWRKU, WORK( IR ), @@ -3132,14 +3143,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M+N, prefer M+N*NB) +* (Workspace: need M + N, prefer M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3154,7 +3165,7 @@ $ LDA ) * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -3162,14 +3173,14 @@ * * Multiply right bidiagonalizing vectors in A by Q * in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in A -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3193,7 +3204,7 @@ * N right singular vectors to be computed in VT and * M left singular vectors to be computed in U * - IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN + IF( LWORK.GE.M*M+MAX( N + M, 4*M, BDSPAC ) ) THEN * * Sufficient workspace for a fast algorithm * @@ -3213,14 +3224,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M*M+M+N, prefer M*M+M+N*NB) +* (Workspace: need M*M + M + N, prefer M*M + M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3237,7 +3248,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in WORK(IU), copying result to U -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S, $ WORK( IE ), WORK( ITAUQ ), @@ -3247,14 +3258,14 @@ $ LDU ) * * Generate right bidiagonalizing vectors in WORK(IU) -* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + (M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU, $ WORK( ITAUP ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in U -* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3263,7 +3274,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of L in U and computing right * singular vectors of L in WORK(IU) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ), $ WORK( IU ), LDWRKU, U, LDU, DUM, 1, @@ -3288,14 +3299,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M+N, prefer M+N*NB) +* (Workspace: need M + N, prefer M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3311,7 +3322,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in U -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, U, LDU, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -3319,14 +3330,14 @@ * * Multiply right bidiagonalizing vectors in U by Q * in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU, $ WORK( ITAUP ), VT, LDVT, $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in U -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3360,7 +3371,7 @@ IWORK = ITAUP + M * * Bidiagonalize A -* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) +* (Workspace: need 3*M + N, prefer 3*M + (M + N)*NB) * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, @@ -3369,7 +3380,7 @@ * * If left singular vectors desired in U, copy result to U * and generate left bidiagonalizing vectors in U -* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB) +* (Workspace: need 4*M-1, prefer 3*M + (M-1)*NB) * CALL DLACPY( 'L', M, M, A, LDA, U, LDU ) CALL DORGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), @@ -3379,7 +3390,7 @@ * * If right singular vectors desired in VT, copy result to * VT and generate right bidiagonalizing vectors in VT -* (Workspace: need 3*M+NRVT, prefer 3*M+NRVT*NB) +* (Workspace: need 3*M + NRVT, prefer 3*M + NRVT*NB) * CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) IF( WNTVA ) @@ -3393,7 +3404,7 @@ * * If left singular vectors desired in A, generate left * bidiagonalizing vectors in A -* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB) +* (Workspace: need 4*M-1, prefer 3*M + (M-1)*NB) * CALL DORGBR( 'Q', M, M, N, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3402,7 +3413,7 @@ * * If right singular vectors desired in A, generate right * bidiagonalizing vectors in A -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) diff --git a/lapack-netlib/SRC/dgesvdx.f b/lapack-netlib/SRC/dgesvdx.f index cfa2ff05d..accf2594e 100644 --- a/lapack-netlib/SRC/dgesvdx.f +++ b/lapack-netlib/SRC/dgesvdx.f @@ -123,13 +123,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION -*> VL >=0. +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -137,13 +139,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -169,7 +175,7 @@ *> vectors, stored columnwise) as specified by RANGE; if *> JOBU = 'N', U is not referenced. *> Note: The user must ensure that UCOL >= NS; if RANGE = 'V', -*> the exact value of NS is not known ILQFin advance and an upper +*> the exact value of NS is not known in advance and an upper *> bound must be used. *> \endverbatim *> @@ -248,7 +254,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleGEsing * @@ -257,10 +263,10 @@ $ IL, IU, NS, S, U, LDU, VT, LDVT, WORK, $ LWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU, JOBVT, RANGE @@ -357,8 +363,14 @@ IF( INFO.EQ.0 ) THEN IF( WANTU .AND. LDU.LT.M ) THEN INFO = -15 - ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN - INFO = -16 + ELSE IF( WANTVT ) THEN + IF( INDS ) THEN + IF( LDVT.LT.IU-IL+1 ) THEN + INFO = -17 + END IF + ELSE IF( LDVT.LT.MINMN ) THEN + INFO = -17 + END IF END IF END IF END IF @@ -380,18 +392,34 @@ * * Path 1 (M much larger than N) * - MAXWRK = N*(N*2+16) + + MAXWRK = N + $ N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, N*(N*2+20) + 2*N* + MAXWRK = MAX( MAXWRK, N*(N+5) + 2*N* $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - MINWRK = N*(N*2+21) + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,N*(N*3+6)+N* + $ ILAENV( 1, 'DORMQR', ' ', N, N, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,N*(N*3+6)+N* + $ ILAENV( 1, 'DORMLQ', ' ', N, N, -1, -1 ) ) + END IF + MINWRK = N*(N*3+20) ELSE * * Path 2 (M at least N, but not much larger) * - MAXWRK = N*(N*2+19) + ( M+N )* + MAXWRK = 4*N + ( M+N )* $ ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) - MINWRK = N*(N*2+20) + M + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,N*(N*2+5)+N* + $ ILAENV( 1, 'DORMQR', ' ', N, N, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,N*(N*2+5)+N* + $ ILAENV( 1, 'DORMLQ', ' ', N, N, -1, -1 ) ) + END IF + MINWRK = MAX(N*(N*2+19),4*N+M) END IF ELSE MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 ) @@ -399,18 +427,34 @@ * * Path 1t (N much larger than M) * - MAXWRK = M*(M*2+16) + + MAXWRK = M + $ M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, M*(M*2+20) + 2*M* + MAXWRK = MAX( MAXWRK, M*(M+5) + 2*M* $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) - MINWRK = M*(M*2+21) + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,M*(M*3+6)+M* + $ ILAENV( 1, 'DORMQR', ' ', M, M, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,M*(M*3+6)+M* + $ ILAENV( 1, 'DORMLQ', ' ', M, M, -1, -1 ) ) + END IF + MINWRK = M*(M*3+20) ELSE * -* Path 2t (N greater than M, but not much larger) +* Path 2t (N at least M, but not much larger) * - MAXWRK = M*(M*2+19) + ( M+N )* + MAXWRK = 4*M + ( M+N )* $ ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) - MINWRK = M*(M*2+20) + N + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,M*(M*2+5)+M* + $ ILAENV( 1, 'DORMQR', ' ', M, M, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,M*(M*2+5)+M* + $ ILAENV( 1, 'DORMLQ', ' ', M, M, -1, -1 ) ) + END IF + MINWRK = MAX(M*(M*2+19),4*M+N) END IF END IF END IF @@ -522,7 +566,7 @@ CALL DCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL DLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU ) + CALL DLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU ) * * Call DORMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -591,7 +635,7 @@ CALL DCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL DLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU ) + CALL DLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU ) * * Call DORMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -687,7 +731,7 @@ CALL DCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL DLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT ) + CALL DLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT) * * Call DORMBR to compute (VB**T)*(PB**T) * (Workspace in WORK( ITEMP ): need M, prefer M*NB) @@ -756,7 +800,7 @@ CALL DCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL DLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT ) + CALL DLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT) * * Call DORMBR to compute VB**T * PB**T * (Workspace in WORK( ITEMP ): need M, prefer M*NB) diff --git a/lapack-netlib/SRC/dgetc2.f b/lapack-netlib/SRC/dgetc2.f index 3cd7eeb2b..3f6be168d 100644 --- a/lapack-netlib/SRC/dgetc2.f +++ b/lapack-netlib/SRC/dgetc2.f @@ -98,7 +98,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup doubleGEauxiliary * @@ -111,10 +111,10 @@ * ===================================================================== SUBROUTINE DGETC2( N, A, LDA, IPIV, JPIV, INFO ) * -* -- LAPACK auxiliary routine (version 3.5.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, N diff --git a/lapack-netlib/SRC/dgetrf2.f b/lapack-netlib/SRC/dgetrf2.f index b1871b5dd..30aa42d68 100644 --- a/lapack-netlib/SRC/dgetrf2.f +++ b/lapack-netlib/SRC/dgetrf2.f @@ -37,7 +37,7 @@ *> the matrix into four submatrices: *> *> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2 -*> A = [ -----|----- ] with n1 = min(m,n) +*> A = [ -----|----- ] with n1 = min(m,n)/2 *> [ A21 | A22 ] n2 = n-n1 *> *> [ A11 ] @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleGEcomputational * * ===================================================================== RECURSIVE SUBROUTINE DGETRF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/dgghd3.f b/lapack-netlib/SRC/dgghd3.f index 812df3f23..034e94389 100644 --- a/lapack-netlib/SRC/dgghd3.f +++ b/lapack-netlib/SRC/dgghd3.f @@ -230,7 +230,7 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -277,7 +277,7 @@ * INFO = 0 NB = ILAENV( 1, 'DGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = 6*N*NB + LWKOPT = MAX( 6*N*NB, 1 ) WORK( 1 ) = DBLE( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) diff --git a/lapack-netlib/SRC/dgsvj1.f b/lapack-netlib/SRC/dgsvj1.f index b32ba0fe6..a0620d65f 100644 --- a/lapack-netlib/SRC/dgsvj1.f +++ b/lapack-netlib/SRC/dgsvj1.f @@ -1,4 +1,4 @@ -*> \brief \b DGSVJ1 pre-processor for the routine sgesvj, applies Jacobi rotations targeting only particular pivots. +*> \brief \b DGSVJ1 pre-processor for the routine dgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== * @@ -223,7 +223,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * @@ -236,10 +236,10 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. DOUBLE PRECISION EPS, SFMIN, TOL diff --git a/lapack-netlib/SRC/dhgeqz.f b/lapack-netlib/SRC/dhgeqz.f index bf6e414d7..e5b02fc7f 100644 --- a/lapack-netlib/SRC/dhgeqz.f +++ b/lapack-netlib/SRC/dhgeqz.f @@ -211,12 +211,12 @@ *> \param[in,out] Q *> \verbatim *> Q is DOUBLE PRECISION array, dimension (LDQ, N) -*> On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in +*> On entry, if COMPQ = 'V', the orthogonal matrix Q1 used in *> the reduction of (A,B) to generalized Hessenberg form. -*> On exit, if COMPZ = 'I', the orthogonal matrix of left Schur -*> vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix +*> On exit, if COMPQ = 'I', the orthogonal matrix of left Schur +*> vectors of (H,T), and if COMPQ = 'V', the orthogonal matrix *> of left Schur vectors of (A,B). -*> Not referenced if COMPZ = 'N'. +*> Not referenced if COMPQ = 'N'. *> \endverbatim *> *> \param[in] LDQ @@ -282,7 +282,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup doubleGEcomputational * @@ -304,10 +304,10 @@ $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, $ LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER COMPQ, COMPZ, JOB diff --git a/lapack-netlib/SRC/dlaed1.f b/lapack-netlib/SRC/dlaed1.f index c37c1d210..b4e018364 100644 --- a/lapack-netlib/SRC/dlaed1.f +++ b/lapack-netlib/SRC/dlaed1.f @@ -54,7 +54,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine DLAED2. *> @@ -148,7 +148,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -163,10 +163,10 @@ SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER CUTPNT, INFO, LDQ, N diff --git a/lapack-netlib/SRC/dlaed7.f b/lapack-netlib/SRC/dlaed7.f index 658ece9a0..babd57be3 100644 --- a/lapack-netlib/SRC/dlaed7.f +++ b/lapack-netlib/SRC/dlaed7.f @@ -59,7 +59,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine DLAED8. *> @@ -244,7 +244,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -260,10 +260,10 @@ $ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N, diff --git a/lapack-netlib/SRC/dlag2.f b/lapack-netlib/SRC/dlag2.f index a941b940b..1e3366c9b 100644 --- a/lapack-netlib/SRC/dlag2.f +++ b/lapack-netlib/SRC/dlag2.f @@ -99,7 +99,7 @@ *> will always be positive. If the eigenvalues are real, then *> the first (real) eigenvalue is WR1 / SCALE1 , but this may *> overflow or underflow, and in fact, SCALE1 may be zero or -*> less than the underflow threshhold if the exact eigenvalue +*> less than the underflow threshold if the exact eigenvalue *> is sufficiently large. *> \endverbatim *> @@ -112,7 +112,7 @@ *> eigenvalues are real, then the second (real) eigenvalue is *> WR2 / SCALE2 , but this may overflow or underflow, and in *> fact, SCALE2 may be zero or less than the underflow -*> threshhold if the exact eigenvalue is sufficiently large. +*> threshold if the exact eigenvalue is sufficiently large. *> \endverbatim *> *> \param[out] WR1 @@ -148,7 +148,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleOTHERauxiliary * @@ -156,10 +156,10 @@ SUBROUTINE DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, $ WR2, WI ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB @@ -266,8 +266,8 @@ * Note: the test of R in the following IF is to cover the case when * DISCR is small and negative and is flushed to zero during * the calculation of R. On machines which have a consistent -* flush-to-zero threshhold and handle numbers above that -* threshhold correctly, it would not be necessary. +* flush-to-zero threshold and handle numbers above that +* threshold correctly, it would not be necessary. * IF( DISCR.GE.ZERO .OR. R.EQ.ZERO ) THEN SUM = PP + SIGN( R, PP ) diff --git a/lapack-netlib/SRC/dlamrg.f b/lapack-netlib/SRC/dlamrg.f index 7126053e8..8e9d37bd1 100644 --- a/lapack-netlib/SRC/dlamrg.f +++ b/lapack-netlib/SRC/dlamrg.f @@ -50,7 +50,7 @@ *> \param[in] N2 *> \verbatim *> N2 is INTEGER -*> These arguements contain the respective lengths of the two +*> These arguments contain the respective lengths of the two *> sorted lists to be merged. *> \endverbatim *> @@ -92,17 +92,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER DTRD1, DTRD2, N1, N2 diff --git a/lapack-netlib/SRC/dlaqr3.f b/lapack-netlib/SRC/dlaqr3.f index aac01a49f..103cd366f 100644 --- a/lapack-netlib/SRC/dlaqr3.f +++ b/lapack-netlib/SRC/dlaqr3.f @@ -138,7 +138,7 @@ *> Z is DOUBLE PRECISION array, dimension (LDZ,N) *> IF WANTZ is .TRUE., then on output, the orthogonal *> similarity transformation mentioned above has been -*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> accumulated into Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ is .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -260,7 +260,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleOTHERauxiliary * @@ -275,10 +275,10 @@ $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T, $ LDT, NV, WV, LDWV, WORK, LWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, diff --git a/lapack-netlib/SRC/dlaqr5.f b/lapack-netlib/SRC/dlaqr5.f index 37ce6f6b0..b28df32aa 100644 --- a/lapack-netlib/SRC/dlaqr5.f +++ b/lapack-netlib/SRC/dlaqr5.f @@ -150,10 +150,10 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is DOUBLE PRECISION array of size (LDZ,IHI) +*> Z is DOUBLE PRECISION array of size (LDZ,IHIZ) *> If WANTZ = .TRUE., then the QR Sweep orthogonal *> similarity transformation is accumulated into -*> Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ = .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -236,7 +236,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleOTHERauxiliary * @@ -259,10 +259,10 @@ $ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, $ LDU, NV, WV, LDWV, NH, WH, LDWH ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, diff --git a/lapack-netlib/SRC/dlarrc.f b/lapack-netlib/SRC/dlarrc.f index f093563e9..9a6f7f795 100644 --- a/lapack-netlib/SRC/dlarrc.f +++ b/lapack-netlib/SRC/dlarrc.f @@ -60,12 +60,13 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> The lower bound for the eigenvalues. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> The lower and upper bounds for the eigenvalues. +*> The upper bound for the eigenvalues. *> \endverbatim *> *> \param[in] D @@ -119,7 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -136,10 +137,10 @@ SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN, $ EIGCNT, LCNT, RCNT, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBT diff --git a/lapack-netlib/SRC/dlarrd.f b/lapack-netlib/SRC/dlarrd.f index 65cdbe96e..00add6f9d 100644 --- a/lapack-netlib/SRC/dlarrd.f +++ b/lapack-netlib/SRC/dlarrd.f @@ -92,12 +92,16 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. Eigenvalues less than or equal +*> to VL, or greater than VU, will not be returned. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. Eigenvalues less than or equal *> to VL, or greater than VU, will not be returned. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. @@ -106,13 +110,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -311,7 +319,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -321,10 +329,10 @@ $ M, W, WERR, WL, WU, IBLOCK, INDEXW, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER ORDER, RANGE diff --git a/lapack-netlib/SRC/dlarre.f b/lapack-netlib/SRC/dlarre.f index e7eea10c6..d8e9c8459 100644 --- a/lapack-netlib/SRC/dlarre.f +++ b/lapack-netlib/SRC/dlarre.f @@ -78,12 +78,17 @@ *> \param[in,out] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound for the eigenvalues. +*> Eigenvalues less than or equal to VL, or greater than VU, +*> will not be returned. VL < VU. +*> If RANGE='I' or ='A', DLARRE computes bounds on the desired +*> part of the spectrum. *> \endverbatim *> *> \param[in,out] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds for the eigenvalues. +*> If RANGE='V', the upper bound for the eigenvalues. *> Eigenvalues less than or equal to VL, or greater than VU, *> will not be returned. VL < VU. *> If RANGE='I' or ='A', DLARRE computes bounds on the desired @@ -93,13 +98,16 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N. *> \endverbatim *> @@ -244,7 +252,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> > 0: A problem occured in DLARRE. +*> > 0: A problem occurred in DLARRE. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -268,7 +276,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -297,10 +305,10 @@ $ W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER RANGE diff --git a/lapack-netlib/SRC/dlarrf.f b/lapack-netlib/SRC/dlarrf.f index f054caa8c..afec65c99 100644 --- a/lapack-netlib/SRC/dlarrf.f +++ b/lapack-netlib/SRC/dlarrf.f @@ -51,7 +51,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix (subblock, if the matrix splitted). +*> The order of the matrix (subblock, if the matrix split). *> \endverbatim *> *> \param[in] D @@ -174,7 +174,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -193,10 +193,10 @@ $ SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA, $ DPLUS, LPLUS, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER CLSTRT, CLEND, INFO, N diff --git a/lapack-netlib/SRC/dlarrv.f b/lapack-netlib/SRC/dlarrv.f index 828661f2c..0628d49ed 100644 --- a/lapack-netlib/SRC/dlarrv.f +++ b/lapack-netlib/SRC/dlarrv.f @@ -59,12 +59,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> Lower bound of the interval that contains the desired +*> eigenvalues. VL < VU. Needed to compute gaps on the left or right +*> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> Lower and upper bounds of the interval that contains the desired +*> Upper bound of the interval that contains the desired *> eigenvalues. VL < VU. Needed to compute gaps on the left or right *> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim @@ -81,7 +84,7 @@ *> L is DOUBLE PRECISION array, dimension (N) *> On entry, the (N-1) subdiagonal elements of the unit *> bidiagonal matrix L are in elements 1 to N-1 of L -*> (if the matrix is not splitted.) At the end of each block +*> (if the matrix is not split.) At the end of each block *> is stored the corresponding shift as given by DLARRE. *> On exit, L is overwritten. *> \endverbatim @@ -236,7 +239,7 @@ *> INFO is INTEGER *> = 0: successful exit *> -*> > 0: A problem occured in DLARRV. +*> > 0: A problem occurred in DLARRV. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -263,7 +266,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHERauxiliary * @@ -283,10 +286,10 @@ $ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER DOL, DOU, INFO, LDZ, M, N diff --git a/lapack-netlib/SRC/dlarscl2.f b/lapack-netlib/SRC/dlarscl2.f index 81f5aa813..acd577833 100644 --- a/lapack-netlib/SRC/dlarscl2.f +++ b/lapack-netlib/SRC/dlarscl2.f @@ -72,7 +72,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -83,17 +83,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DLARSCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/dlascl.f b/lapack-netlib/SRC/dlascl.f index 9b9b33c0c..13c176ce3 100644 --- a/lapack-netlib/SRC/dlascl.f +++ b/lapack-netlib/SRC/dlascl.f @@ -114,7 +114,11 @@ *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). +*> The leading dimension of the array A. +*> If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M); +*> TYPE = 'B', LDA >= KL+1; +*> TYPE = 'Q', LDA >= KU+1; +*> TYPE = 'Z', LDA >= 2*KL+KU+1. *> \endverbatim *> *> \param[out] INFO @@ -132,17 +136,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * * ===================================================================== SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER TYPE diff --git a/lapack-netlib/SRC/dlascl2.f b/lapack-netlib/SRC/dlascl2.f index 8cd9dd72c..f9b3b8a15 100644 --- a/lapack-netlib/SRC/dlascl2.f +++ b/lapack-netlib/SRC/dlascl2.f @@ -72,7 +72,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -83,17 +83,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DLASCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/dlasd1.f b/lapack-netlib/SRC/dlasd1.f index 7b66d90b2..cf7ae9089 100644 --- a/lapack-netlib/SRC/dlasd1.f +++ b/lapack-netlib/SRC/dlasd1.f @@ -60,7 +60,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple singular values or when there are zeros in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine DLASD2. *> @@ -156,7 +156,7 @@ *> The leading dimension of the array VT. LDVT >= max( 1, M ). *> \endverbatim *> -*> \param[out] IDXQ +*> \param[in,out] IDXQ *> \verbatim *> IDXQ is INTEGER array, dimension(N) *> This contains the permutation which will reintegrate the @@ -190,7 +190,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -204,10 +204,10 @@ SUBROUTINE DLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, $ IDXQ, IWORK, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDU, LDVT, NL, NR, SQRE diff --git a/lapack-netlib/SRC/dlasd6.f b/lapack-netlib/SRC/dlasd6.f index a5238b919..d562cc53e 100644 --- a/lapack-netlib/SRC/dlasd6.f +++ b/lapack-netlib/SRC/dlasd6.f @@ -74,7 +74,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple singular values or if there is a zero -*> in the Z vector. For each such occurence the dimension of the +*> 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 DLASD7. *> @@ -232,14 +232,13 @@ *> \param[out] DIFR *> \verbatim *> DIFR is DOUBLE PRECISION array, -*> dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and -*> dimension ( N ) if ICOMPQ = 0. -*> On exit, DIFR(I, 1) is the distance between I-th updated -*> (undeflated) singular value and the I+1-th (undeflated) old -*> singular value. +*> dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and +*> dimension ( K ) if ICOMPQ = 0. +*> On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not +*> defined and will not be referenced. *> -*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the -*> normalizing factors for the right singular vector matrix. +*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the +*> normalizing factors for the right singular vector matrix. *> *> See DLASD8 for details on DIFL and DIFR. *> \endverbatim @@ -298,7 +297,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -314,10 +313,10 @@ $ LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, $ IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL, diff --git a/lapack-netlib/SRC/dlasdq.f b/lapack-netlib/SRC/dlasdq.f index 6beef32ac..94cc1141d 100644 --- a/lapack-netlib/SRC/dlasdq.f +++ b/lapack-netlib/SRC/dlasdq.f @@ -59,7 +59,7 @@ *> \verbatim *> UPLO is CHARACTER*1 *> On entry, UPLO specifies whether the input bidiagonal matrix -*> is upper or lower bidiagonal, and wether it is square are +*> is upper or lower bidiagonal, and whether it is square are *> not. *> UPLO = 'U' or 'u' B is upper bidiagonal. *> UPLO = 'L' or 'l' B is lower bidiagonal. @@ -197,7 +197,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -211,10 +211,10 @@ SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, $ U, LDU, C, LDC, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/dlasq3.f b/lapack-netlib/SRC/dlasq3.f index 4506e19f2..3ae35ad11 100644 --- a/lapack-netlib/SRC/dlasq3.f +++ b/lapack-netlib/SRC/dlasq3.f @@ -60,7 +60,7 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is DOUBLE PRECISION array, dimension ( 4*N ) +*> Z is DOUBLE PRECISION array, dimension ( 4*N0 ) *> Z holds the qd array. *> \endverbatim *> @@ -173,7 +173,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -182,10 +182,10 @@ $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, $ DN2, G, TAU ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. LOGICAL IEEE diff --git a/lapack-netlib/SRC/dlasq4.f b/lapack-netlib/SRC/dlasq4.f index 97d9bdeba..45361b2cb 100644 --- a/lapack-netlib/SRC/dlasq4.f +++ b/lapack-netlib/SRC/dlasq4.f @@ -56,7 +56,7 @@ *> *> \param[in] Z *> \verbatim -*> Z is DOUBLE PRECISION array, dimension ( 4*N ) +*> Z is DOUBLE PRECISION array, dimension ( 4*N0 ) *> Z holds the qd array. *> \endverbatim *> @@ -122,7 +122,7 @@ *> *> \param[in,out] G *> \verbatim -*> G is REAL +*> G is DOUBLE PRECISION *> G is passed as an argument in order to save its value between *> calls to DLASQ4. *> \endverbatim @@ -135,7 +135,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -151,10 +151,10 @@ SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, $ DN1, DN2, TAU, TTYPE, G ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER I0, N0, N0IN, PP, TTYPE diff --git a/lapack-netlib/SRC/dlasrt.f b/lapack-netlib/SRC/dlasrt.f index f5d0e6cd1..fca457efc 100644 --- a/lapack-netlib/SRC/dlasrt.f +++ b/lapack-netlib/SRC/dlasrt.f @@ -81,17 +81,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLASRT( ID, N, D, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER ID @@ -123,7 +123,7 @@ * .. * .. Executable Statements .. * -* Test the input paramters. +* Test the input parameters. * INFO = 0 DIR = -1 diff --git a/lapack-netlib/SRC/dlasy2.f b/lapack-netlib/SRC/dlasy2.f index a4b103053..0af00d39d 100644 --- a/lapack-netlib/SRC/dlasy2.f +++ b/lapack-netlib/SRC/dlasy2.f @@ -166,7 +166,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleSYauxiliary * @@ -174,10 +174,10 @@ SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR, $ LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. LOGICAL LTRANL, LTRANR @@ -438,8 +438,10 @@ 80 CONTINUE 90 CONTINUE 100 CONTINUE - IF( ABS( T16( 4, 4 ) ).LT.SMIN ) - $ T16( 4, 4 ) = SMIN + IF( ABS( T16( 4, 4 ) ).LT.SMIN ) THEN + INFO = 1 + T16( 4, 4 ) = SMIN + END IF SCALE = ONE IF( ( EIGHT*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( T16( 1, 1 ) ) .OR. $ ( EIGHT*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( T16( 2, 2 ) ) .OR. diff --git a/lapack-netlib/SRC/dlatdf.f b/lapack-netlib/SRC/dlatdf.f index be70313bb..5eba2843b 100644 --- a/lapack-netlib/SRC/dlatdf.f +++ b/lapack-netlib/SRC/dlatdf.f @@ -58,7 +58,7 @@ *> Zx = +-e - f with the sign giving the greater value *> of 2-norm(x). About 5 times as expensive as Default. *> IJOB .ne. 2: Local look ahead strategy where all entries of -*> the r.h.s. b is choosen as either +1 or -1 (Default). +*> the r.h.s. b is chosen as either +1 or -1 (Default). *> \endverbatim *> *> \param[in] N @@ -133,7 +133,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleOTHERauxiliary * @@ -171,10 +171,10 @@ SUBROUTINE DLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, $ JPIV ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IJOB, LDZ, N diff --git a/lapack-netlib/SRC/dorbdb1.f b/lapack-netlib/SRC/dorbdb1.f index b5675f71d..8d616bc1b 100644 --- a/lapack-netlib/SRC/dorbdb1.f +++ b/lapack-netlib/SRC/dorbdb1.f @@ -203,7 +203,7 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -304,9 +304,8 @@ $ X11(I+1,I+1), LDX11, WORK(ILARF) ) CALL DLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK(ILARF) ) - C = SQRT( DNRM2( P-I, X11(I+1,I+1), 1, X11(I+1,I+1), - $ 1 )**2 + DNRM2( M-P-I, X21(I+1,I+1), 1, X21(I+1,I+1), - $ 1 )**2 ) + C = SQRT( DNRM2( P-I, X11(I+1,I+1), 1 )**2 + $ + DNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) PHI(I) = ATAN2( S, C ) CALL DORBDB5( P-I, M-P-I, Q-I-1, X11(I+1,I+1), 1, $ X21(I+1,I+1), 1, X11(I+1,I+2), LDX11, diff --git a/lapack-netlib/SRC/dorbdb2.f b/lapack-netlib/SRC/dorbdb2.f index 3cf82cf40..554cc2ff6 100644 --- a/lapack-netlib/SRC/dorbdb2.f +++ b/lapack-netlib/SRC/dorbdb2.f @@ -202,7 +202,7 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -292,8 +292,8 @@ $ X11(I+1,I), LDX11, WORK(ILARF) ) CALL DLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X21(I,I), LDX21, WORK(ILARF) ) - S = SQRT( DNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + DNRM2( M-P-I+1, X21(I,I), 1, X21(I,I), 1 )**2 ) + S = SQRT( DNRM2( P-I, X11(I+1,I), 1 )**2 + $ + DNRM2( M-P-I+1, X21(I,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL DORBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1, diff --git a/lapack-netlib/SRC/dorbdb3.f b/lapack-netlib/SRC/dorbdb3.f index 03be504fa..003c4402d 100644 --- a/lapack-netlib/SRC/dorbdb3.f +++ b/lapack-netlib/SRC/dorbdb3.f @@ -201,7 +201,7 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -292,8 +292,8 @@ $ X11(I,I), LDX11, WORK(ILARF) ) CALL DLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) - C = SQRT( DNRM2( P-I+1, X11(I,I), 1, X11(I,I), - $ 1 )**2 + DNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), 1 )**2 ) + C = SQRT( DNRM2( P-I+1, X11(I,I), 1 )**2 + $ + DNRM2( M-P-I, X21(I+1,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL DORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1, diff --git a/lapack-netlib/SRC/dorbdb4.f b/lapack-netlib/SRC/dorbdb4.f index 8c7236054..a8fe7435d 100644 --- a/lapack-netlib/SRC/dorbdb4.f +++ b/lapack-netlib/SRC/dorbdb4.f @@ -213,7 +213,7 @@ $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -341,9 +341,8 @@ CALL DLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) IF( I .LT. M-Q ) THEN - S = SQRT( DNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + DNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), - $ 1 )**2 ) + S = SQRT( DNRM2( P-I, X11(I+1,I), 1 )**2 + $ + DNRM2( M-P-I, X21(I+1,I), 1 )**2 ) PHI(I) = ATAN2( S, C ) END IF * diff --git a/lapack-netlib/SRC/dorcsd2by1.f b/lapack-netlib/SRC/dorcsd2by1.f index 19dedbe8d..dd0cd351c 100644 --- a/lapack-netlib/SRC/dorcsd2by1.f +++ b/lapack-netlib/SRC/dorcsd2by1.f @@ -266,6 +266,9 @@ $ LWORKMIN, LWORKOPT, R LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. +* .. Local Arrays .. + DOUBLE PRECISION DUM1(1), DUM2(1,1) +* .. * .. External Subroutines .. EXTERNAL DBBCSD, DCOPY, DLACPY, DLAPMR, DLAPMT, DORBDB1, $ DORBDB2, DORBDB3, DORBDB4, DORGLQ, DORGQR, @@ -298,11 +301,11 @@ INFO = -8 ELSE IF( LDX21 .LT. MAX( 1, M-P ) ) THEN INFO = -10 - ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN + ELSE IF( WANTU1 .AND. LDU1 .LT. MAX( 1, P ) ) THEN INFO = -13 - ELSE IF( WANTU2 .AND. LDU2 .LT. M - P ) THEN + ELSE IF( WANTU2 .AND. LDU2 .LT. MAX( 1, M - P ) ) THEN INFO = -15 - ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN + ELSE IF( WANTV1T .AND. LDV1T .LT. MAX( 1, Q ) ) THEN INFO = -17 END IF * @@ -344,99 +347,125 @@ IORBDB = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ1 + MAX( 1, Q ) IORGLQ = ITAUQ1 + MAX( 1, Q ) + LORGQRMIN = 1 + LORGQROPT = 1 + LORGLQMIN = 1 + LORGLQOPT = 1 IF( R .EQ. Q ) THEN - CALL DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK, -1, CHILDINFO ) + CALL DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, WORK, + $ -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL DORGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL DORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL DORGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, - $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + ENDIF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL DORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), + $ -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL DORGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, + $ DUM1, WORK(1), -1, CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q-1 ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL DORGLQ( MAX(0,Q-1), MAX(0,Q-1), MAX(0,Q-1), V1T, LDV1T, - $ 0, WORK(1), -1, CHILDINFO ) - LORGLQMIN = MAX( 1, Q-1 ) - LORGLQOPT = INT( WORK(1) ) CALL DBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, 0, 0, - $ 0, 0, 0, 0, 0, 0, WORK(1), -1, CHILDINFO ) + $ DUM1, U1, LDU1, U2, LDU2, V1T, LDV1T, + $ DUM2, 1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. P ) THEN - CALL DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, + $ WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P-1 .GE. M-P ) THEN - CALL DORGQR( P-1, P-1, P-1, U1(2,2), LDU1, 0, WORK(1), - $ -1, CHILDINFO ) - LORGQRMIN = MAX( 1, P-1 ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL DORGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, - $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL DORGQR( P-1, P-1, P-1, U1(2,2), LDU1, DUM1, + $ WORK(1), -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL DORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), + $ -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL DORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL DORGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ 0, V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, 0, 0, - $ 0, 0, 0, 0, 0, 0, WORK(1), -1, CHILDINFO ) + $ DUM1, V1T, LDV1T, DUM2, 1, U1, LDU1, + $ U2, LDU2, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. M-P ) THEN - CALL DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, + $ WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P-1 ) THEN - CALL DORGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL DORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL DORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, 0, - $ WORK(1), -1, CHILDINFO ) - LORGQRMIN = MAX( 1, M-P-1 ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL DORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, + $ DUM1, WORK(1), -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL DORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL DORGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, 0, 0, 1, V1T, LDV1T, U2, LDU2, U1, LDU1, - $ 0, 0, 0, 0, 0, 0, 0, 0, WORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM1, DUM2, 1, V1T, LDV1T, U2, + $ LDU2, U1, LDU1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE - CALL DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, 0, WORK(1), -1, CHILDINFO ) + CALL DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LORBDB = M + INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL DORGQR( P, P, M-Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL DORGQR( P, P, M-Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL DORGQR( M-P, M-P, M-Q, U2, LDU2, 0, WORK(1), -1, - $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL DORGQR( M-P, M-P, M-Q, U2, LDU2, DUM1, WORK(1), + $ -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL DORGLQ( Q, Q, Q, V1T, LDV1T, DUM1, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL DORGLQ( Q, Q, Q, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, 0, U2, LDU2, U1, LDU1, 0, 1, V1T, LDV1T, - $ 0, 0, 0, 0, 0, 0, 0, 0, WORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM1, U2, LDU2, U1, LDU1, DUM2, + $ 1, V1T, LDV1T, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) END IF LWORKMIN = MAX( IORBDB+LORBDB-1, @@ -501,11 +530,11 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, - $ WORK(IB11D), WORK(IB11E), WORK(IB12D), - $ WORK(IB12E), WORK(IB21D), WORK(IB21E), - $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, + $ DUM2, 1, WORK(IB11D), WORK(IB11E), + $ WORK(IB12D), WORK(IB12E), WORK(IB21D), + $ WORK(IB21E), WORK(IB22D), WORK(IB22E), + $ WORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place zero submatrices in * preferred positions @@ -555,8 +584,8 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ WORK(IPHI), V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, - $ WORK(IB11D), WORK(IB11E), WORK(IB12D), + $ WORK(IPHI), V1T, LDV1T, DUM2, 1, U1, LDU1, U2, + $ LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -610,11 +639,11 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, WORK(IPHI), 0, 1, V1T, LDV1T, U2, LDU2, U1, - $ LDU1, WORK(IB11D), WORK(IB11E), WORK(IB12D), - $ WORK(IB12E), WORK(IB21D), WORK(IB21E), - $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, WORK(IPHI), DUM2, 1, V1T, LDV1T, U2, + $ LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E), + $ WORK(IB12D), WORK(IB12E), WORK(IB21D), + $ WORK(IB21E), WORK(IB22D), WORK(IB22E), + $ WORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions @@ -679,11 +708,11 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, 0, 1, V1T, - $ LDV1T, WORK(IB11D), WORK(IB11E), WORK(IB12D), - $ WORK(IB12E), WORK(IB21D), WORK(IB21E), - $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM2, + $ 1, V1T, LDV1T, WORK(IB11D), WORK(IB11E), + $ WORK(IB12D), WORK(IB12E), WORK(IB21D), + $ WORK(IB21E), WORK(IB22D), WORK(IB22E), + $ WORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions diff --git a/lapack-netlib/SRC/dsbevx.f b/lapack-netlib/SRC/dsbevx.f index 39517fb93..fc8836f79 100644 --- a/lapack-netlib/SRC/dsbevx.f +++ b/lapack-netlib/SRC/dsbevx.f @@ -126,12 +126,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -139,13 +142,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -249,7 +256,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -258,10 +265,10 @@ $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsbgvd.f b/lapack-netlib/SRC/dsbgvd.f index fe8d62873..a259ad78e 100644 --- a/lapack-netlib/SRC/dsbgvd.f +++ b/lapack-netlib/SRC/dsbgvd.f @@ -214,7 +214,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -227,10 +227,10 @@ SUBROUTINE DSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, $ Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO @@ -338,7 +338,7 @@ INDWK2 = INDWRK + N*N LLWRK2 = LWORK - INDWK2 + 1 CALL DSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ, - $ WORK( INDWRK ), IINFO ) + $ WORK, IINFO ) * * Reduce to tridiagonal form. * diff --git a/lapack-netlib/SRC/dsbgvx.f b/lapack-netlib/SRC/dsbgvx.f index fc06677da..2db4ac346 100644 --- a/lapack-netlib/SRC/dsbgvx.f +++ b/lapack-netlib/SRC/dsbgvx.f @@ -152,13 +152,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -166,14 +170,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -271,7 +280,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -285,10 +294,10 @@ $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, $ LDZ, WORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsgesv.f b/lapack-netlib/SRC/dsgesv.f index 64e2c1686..99eb122c8 100644 --- a/lapack-netlib/SRC/dsgesv.f +++ b/lapack-netlib/SRC/dsgesv.f @@ -164,7 +164,7 @@ *> -3 : failure of SGETRF *> -31: stop the iterative refinement after the 30th *> iterations -*> > 0: iterative refinement has been sucessfully used. +*> > 0: iterative refinement has been successfully used. *> Returns the number of iterations *> \endverbatim *> @@ -187,7 +187,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleGEsolve * @@ -195,10 +195,10 @@ SUBROUTINE DSGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, $ SWORK, ITER, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, ITER, LDA, LDB, LDX, N, NRHS diff --git a/lapack-netlib/SRC/dspevx.f b/lapack-netlib/SRC/dspevx.f index 35a96b2b8..4f9e8d46f 100644 --- a/lapack-netlib/SRC/dspevx.f +++ b/lapack-netlib/SRC/dspevx.f @@ -96,12 +96,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -109,13 +112,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -218,7 +225,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -227,10 +234,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, $ INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dspgvx.f b/lapack-netlib/SRC/dspgvx.f index 9eb91f7a1..e87ad5fce 100644 --- a/lapack-netlib/SRC/dspgvx.f +++ b/lapack-netlib/SRC/dspgvx.f @@ -118,13 +118,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,14 +136,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -249,7 +258,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -263,10 +272,10 @@ $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsposv.f b/lapack-netlib/SRC/dsposv.f index bb72199ba..f7573dd3c 100644 --- a/lapack-netlib/SRC/dsposv.f +++ b/lapack-netlib/SRC/dsposv.f @@ -168,7 +168,7 @@ *> -3 : failure of SPOTRF *> -31: stop the iterative refinement after the 30th *> iterations -*> > 0: iterative refinement has been sucessfully used. +*> > 0: iterative refinement has been successfully used. *> Returns the number of iterations *> \endverbatim *> @@ -191,7 +191,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doublePOsolve * @@ -199,10 +199,10 @@ SUBROUTINE DSPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, $ SWORK, ITER, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/dstebz.f b/lapack-netlib/SRC/dstebz.f index 01bea27c3..25d271206 100644 --- a/lapack-netlib/SRC/dstebz.f +++ b/lapack-netlib/SRC/dstebz.f @@ -87,13 +87,18 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. Eigenvalues less than or equal +*> to VL, or greater than VU, will not be returned. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. Eigenvalues less than or equal *> to VL, or greater than VU, will not be returned. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. @@ -102,14 +107,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -254,7 +264,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -263,10 +273,10 @@ $ M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER ORDER, RANGE diff --git a/lapack-netlib/SRC/dstegr.f b/lapack-netlib/SRC/dstegr.f index 298e1c766..a56f90631 100644 --- a/lapack-netlib/SRC/dstegr.f +++ b/lapack-netlib/SRC/dstegr.f @@ -48,7 +48,7 @@ *> either an interval (VL,VU] or a range of indices IL:IU for the desired *> eigenvalues. *> -*> DSTEGR is a compatability wrapper around the improved DSTEMR routine. +*> DSTEGR is a compatibility wrapper around the improved DSTEMR routine. *> See DSTEMR for further details. *> *> One important change is that the ABSTOL parameter no longer provides any @@ -105,13 +105,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -119,14 +123,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -240,7 +249,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * @@ -256,10 +265,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/dstemr.f b/lapack-netlib/SRC/dstemr.f index 8967c18fc..60884672f 100644 --- a/lapack-netlib/SRC/dstemr.f +++ b/lapack-netlib/SRC/dstemr.f @@ -136,13 +136,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -150,14 +154,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -294,7 +303,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * @@ -312,10 +321,10 @@ $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/dstevr.f b/lapack-netlib/SRC/dstevr.f index 941ec97f3..dd40cf99c 100644 --- a/lapack-netlib/SRC/dstevr.f +++ b/lapack-netlib/SRC/dstevr.f @@ -128,12 +128,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -141,13 +144,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -280,7 +287,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -297,10 +304,10 @@ $ M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/dstevx.f b/lapack-netlib/SRC/dstevx.f index cda9de16c..0cdfe9992 100644 --- a/lapack-netlib/SRC/dstevx.f +++ b/lapack-netlib/SRC/dstevx.f @@ -89,12 +89,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -102,13 +105,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -212,7 +219,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -220,10 +227,10 @@ SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/dsyevr.f b/lapack-netlib/SRC/dsyevr.f index 08f363613..c78fb156d 100644 --- a/lapack-netlib/SRC/dsyevr.f +++ b/lapack-netlib/SRC/dsyevr.f @@ -153,12 +153,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -166,13 +169,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -306,7 +313,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleSYeigen * @@ -325,10 +332,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsyevx.f b/lapack-netlib/SRC/dsyevx.f index cb990e50d..52c847779 100644 --- a/lapack-netlib/SRC/dsyevx.f +++ b/lapack-netlib/SRC/dsyevx.f @@ -98,12 +98,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -111,13 +114,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -237,7 +244,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleSYeigen * @@ -246,10 +253,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsygvx.f b/lapack-netlib/SRC/dsygvx.f index 0ed770637..13ab094db 100644 --- a/lapack-netlib/SRC/dsygvx.f +++ b/lapack-netlib/SRC/dsygvx.f @@ -131,12 +131,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -144,13 +147,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -276,7 +283,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleSYeigen * @@ -290,10 +297,10 @@ $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, $ LWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsytrf_rook.f b/lapack-netlib/SRC/dsytrf_rook.f index 81264872a..a7f405378 100644 --- a/lapack-netlib/SRC/dsytrf_rook.f +++ b/lapack-netlib/SRC/dsytrf_rook.f @@ -208,7 +208,7 @@ * ===================================================================== SUBROUTINE DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.1) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -261,7 +261,7 @@ * Determine the block size * NB = ILAENV( 1, 'DSYTRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/dsytrs2.f b/lapack-netlib/SRC/dsytrs2.f index 09a87fe3d..9d1205b77 100644 --- a/lapack-netlib/SRC/dsytrs2.f +++ b/lapack-netlib/SRC/dsytrs2.f @@ -106,7 +106,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (N) +*> WORK is DOUBLE PRECISION array, dimension (N) *> \endverbatim *> *> \param[out] INFO @@ -124,7 +124,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleSYcomputational * @@ -132,10 +132,10 @@ SUBROUTINE DSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/dtgsen.f b/lapack-netlib/SRC/dtgsen.f index 82b17626f..14719e4fd 100644 --- a/lapack-netlib/SRC/dtgsen.f +++ b/lapack-netlib/SRC/dtgsen.f @@ -305,7 +305,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * @@ -452,10 +452,10 @@ $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL WANTQ, WANTZ @@ -542,6 +542,7 @@ * M = 0 PAIR = .FALSE. + IF( .NOT.LQUERY .OR. IJOB.NE.0 ) THEN DO 10 K = 1, N IF( PAIR ) THEN PAIR = .FALSE. @@ -561,6 +562,7 @@ END IF END IF 10 CONTINUE + END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN LWMIN = MAX( 1, 4*N+16, 2*M*( N-M ) ) diff --git a/lapack-netlib/SRC/dtrevc3.f b/lapack-netlib/SRC/dtrevc3.f new file mode 100644 index 000000000..ba5abb5f5 --- /dev/null +++ b/lapack-netlib/SRC/dtrevc3.f @@ -0,0 +1,1303 @@ +*> \brief \b DTREVC3 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DTREVC3 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, +* VR, LDVR, MM, M, WORK, LWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER HOWMNY, SIDE +* INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. +* LOGICAL SELECT( * ) +* DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), +* $ WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DTREVC3 computes some or all of the right and/or left eigenvectors of +*> a real upper quasi-triangular matrix T. +*> Matrices of this type are produced by the Schur factorization of +*> a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. +*> +*> The right eigenvector x and the left eigenvector y of T corresponding +*> to an eigenvalue w are defined by: +*> +*> T*x = w*x, (y**T)*T = w*(y**T) +*> +*> where y**T denotes the transpose of the vector y. +*> The eigenvalues are not input to this routine, but are read directly +*> from the diagonal blocks of T. +*> +*> This routine returns the matrices X and/or Y of right and left +*> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an +*> input matrix. If Q is the orthogonal factor that reduces a matrix +*> A to Schur form T, then Q*X and Q*Y are the matrices of right and +*> left eigenvectors of A. +*> +*> This uses a Level 3 BLAS version of the back transformation. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'R': compute right eigenvectors only; +*> = 'L': compute left eigenvectors only; +*> = 'B': compute both right and left eigenvectors. +*> \endverbatim +*> +*> \param[in] HOWMNY +*> \verbatim +*> HOWMNY is CHARACTER*1 +*> = 'A': compute all right and/or left eigenvectors; +*> = 'B': compute all right and/or left eigenvectors, +*> backtransformed by the matrices in VR and/or VL; +*> = 'S': compute selected right and/or left eigenvectors, +*> as indicated by the logical array SELECT. +*> \endverbatim +*> +*> \param[in,out] SELECT +*> \verbatim +*> SELECT is LOGICAL array, dimension (N) +*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be +*> computed. +*> If w(j) is a real eigenvalue, the corresponding real +*> eigenvector is computed if SELECT(j) is .TRUE.. +*> If w(j) and w(j+1) are the real and imaginary parts of a +*> complex eigenvalue, the corresponding complex eigenvector is +*> computed if either SELECT(j) or SELECT(j+1) is .TRUE., and +*> on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to +*> .FALSE.. +*> Not referenced if HOWMNY = 'A' or 'B'. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the matrix T. N >= 0. +*> \endverbatim +*> +*> \param[in] T +*> \verbatim +*> T is DOUBLE PRECISION array, dimension (LDT,N) +*> The upper quasi-triangular matrix T in Schur canonical form. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= max(1,N). +*> \endverbatim +*> +*> \param[in,out] VL +*> \verbatim +*> VL is DOUBLE PRECISION array, dimension (LDVL,MM) +*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must +*> contain an N-by-N matrix Q (usually the orthogonal matrix Q +*> of Schur vectors returned by DHSEQR). +*> On exit, if SIDE = 'L' or 'B', VL contains: +*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*Y; +*> if HOWMNY = 'S', the left eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VL, in the same order as their +*> eigenvalues. +*> A complex eigenvector corresponding to a complex eigenvalue +*> is stored in two consecutive columns, the first holding the +*> real part, and the second the imaginary part. +*> Not referenced if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDVL +*> \verbatim +*> LDVL is INTEGER +*> The leading dimension of the array VL. +*> LDVL >= 1, and if SIDE = 'L' or 'B', LDVL >= N. +*> \endverbatim +*> +*> \param[in,out] VR +*> \verbatim +*> VR is DOUBLE PRECISION array, dimension (LDVR,MM) +*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must +*> contain an N-by-N matrix Q (usually the orthogonal matrix Q +*> of Schur vectors returned by DHSEQR). +*> On exit, if SIDE = 'R' or 'B', VR contains: +*> if HOWMNY = 'A', the matrix X of right eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*X; +*> if HOWMNY = 'S', the right eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VR, in the same order as their +*> eigenvalues. +*> A complex eigenvector corresponding to a complex eigenvalue +*> is stored in two consecutive columns, the first holding the +*> real part and the second the imaginary part. +*> Not referenced if SIDE = 'L'. +*> \endverbatim +*> +*> \param[in] LDVR +*> \verbatim +*> LDVR is INTEGER +*> The leading dimension of the array VR. +*> LDVR >= 1, and if SIDE = 'R' or 'B', LDVR >= N. +*> \endverbatim +*> +*> \param[in] MM +*> \verbatim +*> MM is INTEGER +*> The number of columns in the arrays VL and/or VR. MM >= M. +*> \endverbatim +*> +*> \param[out] M +*> \verbatim +*> M is INTEGER +*> The number of columns in the arrays VL and/or VR actually +*> used to store the eigenvectors. +*> If HOWMNY = 'A' or 'B', M is set to N. +*> Each selected real eigenvector occupies one column and each +*> selected complex eigenvector occupies two columns. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of array WORK. LWORK >= max(1,3*N). +*> For optimum performance, LWORK >= N + 2*N*NB, 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. +* +*> \date November 2011 +* +* @precisions fortran d -> s +* +*> \ingroup doubleOTHERcomputational +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The algorithm used in this program is basically backward (forward) +*> substitution, with scaling to make the the code robust against +*> possible overflow. +*> +*> Each eigenvector is normalized so that the element of largest +*> magnitude has magnitude 1; here the magnitude of a complex number +*> (x,y) is taken to be |x| + |y|. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, LDVR, MM, M, WORK, LWORK, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2011 +* +* .. Scalar Arguments .. + CHARACTER HOWMNY, SIDE + INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. + LOGICAL SELECT( * ) + DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), + $ WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) + INTEGER NBMIN, NBMAX + PARAMETER ( NBMIN = 8, NBMAX = 128 ) +* .. +* .. Local Scalars .. + LOGICAL ALLV, BOTHV, LEFTV, LQUERY, OVER, PAIR, + $ RIGHTV, SOMEV + INTEGER I, IERR, II, IP, IS, J, J1, J2, JNXT, K, KI, + $ IV, MAXWRK, NB, KI2 + DOUBLE PRECISION BETA, BIGNUM, EMAX, OVFL, REC, REMAX, SCALE, + $ SMIN, SMLNUM, ULP, UNFL, VCRIT, VMAX, WI, WR, + $ XNORM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER IDAMAX, ILAENV + DOUBLE PRECISION DDOT, DLAMCH + EXTERNAL LSAME, IDAMAX, ILAENV, DDOT, DLAMCH +* .. +* .. External Subroutines .. + EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. +* .. Local Arrays .. + DOUBLE PRECISION X( 2, 2 ) + INTEGER ISCOMPLEX( NBMAX ) +* .. +* .. Executable Statements .. +* +* Decode and test the input parameters +* + BOTHV = LSAME( SIDE, 'B' ) + RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV + LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV +* + ALLV = LSAME( HOWMNY, 'A' ) + OVER = LSAME( HOWMNY, 'B' ) + SOMEV = LSAME( HOWMNY, 'S' ) +* + INFO = 0 + NB = ILAENV( 1, 'DTREVC', SIDE // HOWMNY, N, -1, -1, -1 ) + MAXWRK = N + 2*N*NB + WORK(1) = MAXWRK + LQUERY = ( LWORK.EQ.-1 ) + IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN + INFO = -1 + ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDT.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN + INFO = -8 + ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN + INFO = -10 + ELSE IF( LWORK.LT.MAX( 1, 3*N ) .AND. .NOT.LQUERY ) THEN + INFO = -14 + ELSE +* +* Set M to the number of columns required to store the selected +* eigenvectors, standardize the array SELECT if necessary, and +* test MM. +* + IF( SOMEV ) THEN + M = 0 + PAIR = .FALSE. + DO 10 J = 1, N + IF( PAIR ) THEN + PAIR = .FALSE. + SELECT( J ) = .FALSE. + ELSE + IF( J.LT.N ) THEN + IF( T( J+1, J ).EQ.ZERO ) THEN + IF( SELECT( J ) ) + $ M = M + 1 + ELSE + PAIR = .TRUE. + IF( SELECT( J ) .OR. SELECT( J+1 ) ) THEN + SELECT( J ) = .TRUE. + M = M + 2 + END IF + END IF + ELSE + IF( SELECT( N ) ) + $ M = M + 1 + END IF + END IF + 10 CONTINUE + ELSE + M = N + END IF +* + IF( MM.LT.M ) THEN + INFO = -11 + END IF + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DTREVC3', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible. +* + IF( N.EQ.0 ) + $ RETURN +* +* Use blocked version of back-transformation if sufficient workspace. +* Zero-out the workspace to avoid potential NaN propagation. +* + IF( OVER .AND. LWORK .GE. N + 2*N*NBMIN ) THEN + NB = (LWORK - N) / (2*N) + NB = MIN( NB, NBMAX ) + CALL DLASET( 'F', N, 1+2*NB, ZERO, ZERO, WORK, N ) + ELSE + NB = 1 + END IF +* +* Set the constants to control overflow. +* + UNFL = DLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL DLABAD( UNFL, OVFL ) + ULP = DLAMCH( 'Precision' ) + SMLNUM = UNFL*( N / ULP ) + BIGNUM = ( ONE-ULP ) / SMLNUM +* +* Compute 1-norm of each column of strictly upper triangular +* part of T to control overflow in triangular solver. +* + WORK( 1 ) = ZERO + DO 30 J = 2, N + WORK( J ) = ZERO + DO 20 I = 1, J - 1 + WORK( J ) = WORK( J ) + ABS( T( I, J ) ) + 20 CONTINUE + 30 CONTINUE +* +* Index IP is used to specify the real or complex eigenvalue: +* IP = 0, real eigenvalue, +* 1, first of conjugate complex pair: (wr,wi) +* -1, second of conjugate complex pair: (wr,wi) +* ISCOMPLEX array stores IP for each column in current block. +* + IF( RIGHTV ) THEN +* +* ============================================================ +* Compute right eigenvectors. +* +* IV is index of column in current block. +* For complex right vector, uses IV-1 for real part and IV for complex part. +* Non-blocked version always uses IV=2; +* blocked version starts with IV=NB, goes down to 1 or 2. +* (Note the "0-th" column is used for 1-norms computed above.) + IV = 2 + IF( NB.GT.2 ) THEN + IV = NB + END IF + + IP = 0 + IS = M + DO 140 KI = N, 1, -1 + IF( IP.EQ.-1 ) THEN +* previous iteration (ki+1) was second of conjugate pair, +* so this ki is first of conjugate pair; skip to end of loop + IP = 1 + GO TO 140 + ELSE IF( KI.EQ.1 ) THEN +* last column, so this ki must be real eigenvalue + IP = 0 + ELSE IF( T( KI, KI-1 ).EQ.ZERO ) THEN +* zero on sub-diagonal, so this ki is real eigenvalue + IP = 0 + ELSE +* non-zero on sub-diagonal, so this ki is second of conjugate pair + IP = -1 + END IF + + IF( SOMEV ) THEN + IF( IP.EQ.0 ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 140 + ELSE + IF( .NOT.SELECT( KI-1 ) ) + $ GO TO 140 + END IF + END IF +* +* Compute the KI-th eigenvalue (WR,WI). +* + WR = T( KI, KI ) + WI = ZERO + IF( IP.NE.0 ) + $ WI = SQRT( ABS( T( KI, KI-1 ) ) )* + $ SQRT( ABS( T( KI-1, KI ) ) ) + SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM ) +* + IF( IP.EQ.0 ) THEN +* +* -------------------------------------------------------- +* Real right eigenvector +* + WORK( KI + IV*N ) = ONE +* +* Form right-hand side. +* + DO 50 K = 1, KI - 1 + WORK( K + IV*N ) = -T( K, KI ) + 50 CONTINUE +* +* Solve upper quasi-triangular system: +* [ T(1:KI-1,1:KI-1) - WR ]*X = SCALE*WORK. +* + JNXT = KI - 1 + DO 60 J = KI - 1, 1, -1 + IF( J.GT.JNXT ) + $ GO TO 60 + J1 = J + J2 = J + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + J1 = J - 1 + JNXT = J - 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* + CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale X(1,1) to avoid overflow when updating +* the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL DSCAL( KI, SCALE, WORK( 1+IV*N ), 1 ) + WORK( J+IV*N ) = X( 1, 1 ) +* +* Update right-hand side +* + CALL DAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1, + $ WORK( 1+IV*N ), 1 ) +* + ELSE +* +* 2-by-2 diagonal block +* + CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, + $ T( J-1, J-1 ), LDT, ONE, ONE, + $ WORK( J-1+IV*N ), N, WR, ZERO, X, 2, + $ SCALE, XNORM, IERR ) +* +* Scale X(1,1) and X(2,1) to avoid overflow when +* updating the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + BETA = MAX( WORK( J-1 ), WORK( J ) ) + IF( BETA.GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + X( 2, 1 ) = X( 2, 1 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL DSCAL( KI, SCALE, WORK( 1+IV*N ), 1 ) + WORK( J-1+IV*N ) = X( 1, 1 ) + WORK( J +IV*N ) = X( 2, 1 ) +* +* Update right-hand side +* + CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, + $ WORK( 1+IV*N ), 1 ) + CALL DAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1, + $ WORK( 1+IV*N ), 1 ) + END IF + 60 CONTINUE +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL DCOPY( KI, WORK( 1 + IV*N ), 1, VR( 1, IS ), 1 ) +* + II = IDAMAX( KI, VR( 1, IS ), 1 ) + REMAX = ONE / ABS( VR( II, IS ) ) + CALL DSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 70 K = KI + 1, N + VR( K, IS ) = ZERO + 70 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.1 ) + $ CALL DGEMV( 'N', N, KI-1, ONE, VR, LDVR, + $ WORK( 1 + IV*N ), 1, WORK( KI + IV*N ), + $ VR( 1, KI ), 1 ) +* + II = IDAMAX( N, VR( 1, KI ), 1 ) + REMAX = ONE / ABS( VR( II, KI ) ) + CALL DSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + IV*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP +* back-transform and normalization is done below + END IF + ELSE +* +* -------------------------------------------------------- +* Complex right eigenvector. +* +* Initial solve +* [ ( T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I*WI) ]*X = 0. +* [ ( T(KI, KI-1) T(KI, KI) ) ] +* + IF( ABS( T( KI-1, KI ) ).GE.ABS( T( KI, KI-1 ) ) ) THEN + WORK( KI-1 + (IV-1)*N ) = ONE + WORK( KI + (IV )*N ) = WI / T( KI-1, KI ) + ELSE + WORK( KI-1 + (IV-1)*N ) = -WI / T( KI, KI-1 ) + WORK( KI + (IV )*N ) = ONE + END IF + WORK( KI + (IV-1)*N ) = ZERO + WORK( KI-1 + (IV )*N ) = ZERO +* +* Form right-hand side. +* + DO 80 K = 1, KI - 2 + WORK( K+(IV-1)*N ) = -WORK( KI-1+(IV-1)*N )*T(K,KI-1) + WORK( K+(IV )*N ) = -WORK( KI +(IV )*N )*T(K,KI ) + 80 CONTINUE +* +* Solve upper quasi-triangular system: +* [ T(1:KI-2,1:KI-2) - (WR+i*WI) ]*X = SCALE*(WORK+i*WORK2) +* + JNXT = KI - 2 + DO 90 J = KI - 2, 1, -1 + IF( J.GT.JNXT ) + $ GO TO 90 + J1 = J + J2 = J + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + J1 = J - 1 + JNXT = J - 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* + CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+(IV-1)*N ), N, + $ WR, WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale X(1,1) and X(1,2) to avoid overflow when +* updating the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + X( 1, 2 ) = X( 1, 2 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL DSCAL( KI, SCALE, WORK( 1+(IV-1)*N ), 1 ) + CALL DSCAL( KI, SCALE, WORK( 1+(IV )*N ), 1 ) + END IF + WORK( J+(IV-1)*N ) = X( 1, 1 ) + WORK( J+(IV )*N ) = X( 1, 2 ) +* +* Update the right-hand side +* + CALL DAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL DAXPY( J-1, -X( 1, 2 ), T( 1, J ), 1, + $ WORK( 1+(IV )*N ), 1 ) +* + ELSE +* +* 2-by-2 diagonal block +* + CALL DLALN2( .FALSE., 2, 2, SMIN, ONE, + $ T( J-1, J-1 ), LDT, ONE, ONE, + $ WORK( J-1+(IV-1)*N ), N, WR, WI, X, 2, + $ SCALE, XNORM, IERR ) +* +* Scale X to avoid overflow when updating +* the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + BETA = MAX( WORK( J-1 ), WORK( J ) ) + IF( BETA.GT.BIGNUM / XNORM ) THEN + REC = ONE / XNORM + X( 1, 1 ) = X( 1, 1 )*REC + X( 1, 2 ) = X( 1, 2 )*REC + X( 2, 1 ) = X( 2, 1 )*REC + X( 2, 2 ) = X( 2, 2 )*REC + SCALE = SCALE*REC + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL DSCAL( KI, SCALE, WORK( 1+(IV-1)*N ), 1 ) + CALL DSCAL( KI, SCALE, WORK( 1+(IV )*N ), 1 ) + END IF + WORK( J-1+(IV-1)*N ) = X( 1, 1 ) + WORK( J +(IV-1)*N ) = X( 2, 1 ) + WORK( J-1+(IV )*N ) = X( 1, 2 ) + WORK( J +(IV )*N ) = X( 2, 2 ) +* +* Update the right-hand side +* + CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL DAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL DAXPY( J-2, -X( 1, 2 ), T( 1, J-1 ), 1, + $ WORK( 1+(IV )*N ), 1 ) + CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1, + $ WORK( 1+(IV )*N ), 1 ) + END IF + 90 CONTINUE +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL DCOPY( KI, WORK( 1+(IV-1)*N ), 1, VR(1,IS-1), 1 ) + CALL DCOPY( KI, WORK( 1+(IV )*N ), 1, VR(1,IS ), 1 ) +* + EMAX = ZERO + DO 100 K = 1, KI + EMAX = MAX( EMAX, ABS( VR( K, IS-1 ) )+ + $ ABS( VR( K, IS ) ) ) + 100 CONTINUE + REMAX = ONE / EMAX + CALL DSCAL( KI, REMAX, VR( 1, IS-1 ), 1 ) + CALL DSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 110 K = KI + 1, N + VR( K, IS-1 ) = ZERO + VR( K, IS ) = ZERO + 110 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.2 ) THEN + CALL DGEMV( 'N', N, KI-2, ONE, VR, LDVR, + $ WORK( 1 + (IV-1)*N ), 1, + $ WORK( KI-1 + (IV-1)*N ), VR(1,KI-1), 1) + CALL DGEMV( 'N', N, KI-2, ONE, VR, LDVR, + $ WORK( 1 + (IV)*N ), 1, + $ WORK( KI + (IV)*N ), VR( 1, KI ), 1 ) + ELSE + CALL DSCAL( N, WORK(KI-1+(IV-1)*N), VR(1,KI-1), 1) + CALL DSCAL( N, WORK(KI +(IV )*N), VR(1,KI ), 1) + END IF +* + EMAX = ZERO + DO 120 K = 1, N + EMAX = MAX( EMAX, ABS( VR( K, KI-1 ) )+ + $ ABS( VR( K, KI ) ) ) + 120 CONTINUE + REMAX = ONE / EMAX + CALL DSCAL( N, REMAX, VR( 1, KI-1 ), 1 ) + CALL DSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + (IV-1)*N ) = ZERO + WORK( K + (IV )*N ) = ZERO + END DO + ISCOMPLEX( IV-1 ) = -IP + ISCOMPLEX( IV ) = IP + IV = IV - 1 +* back-transform and normalization is done below + END IF + END IF + + IF( NB.GT.1 ) THEN +* -------------------------------------------------------- +* Blocked version of back-transform +* For complex case, KI2 includes both vectors (KI-1 and KI) + IF( IP.EQ.0 ) THEN + KI2 = KI + ELSE + KI2 = KI - 1 + END IF + +* Columns IV:NB of work are valid vectors. +* When the number of vectors stored reaches NB-1 or NB, +* or if this was last vector, do the GEMM + IF( (IV.LE.2) .OR. (KI2.EQ.1) ) THEN + CALL DGEMM( 'N', 'N', N, NB-IV+1, KI2+NB-IV, ONE, + $ VR, LDVR, + $ WORK( 1 + (IV)*N ), N, + $ ZERO, + $ WORK( 1 + (NB+IV)*N ), N ) +* normalize vectors + DO K = IV, NB + IF( ISCOMPLEX(K).EQ.0 ) THEN +* real eigenvector + II = IDAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / ABS( WORK( II + (NB+K)*N ) ) + ELSE IF( ISCOMPLEX(K).EQ.1 ) THEN +* first eigenvector of conjugate pair + EMAX = ZERO + DO II = 1, N + EMAX = MAX( EMAX, + $ ABS( WORK( II + (NB+K )*N ) )+ + $ ABS( WORK( II + (NB+K+1)*N ) ) ) + END DO + REMAX = ONE / EMAX +* else if ISCOMPLEX(K).EQ.-1 +* second eigenvector of conjugate pair +* reuse same REMAX as previous K + END IF + CALL DSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL DLACPY( 'F', N, NB-IV+1, + $ WORK( 1 + (NB+IV)*N ), N, + $ VR( 1, KI2 ), LDVR ) + IV = NB + ELSE + IV = IV - 1 + END IF + END IF ! blocked back-transform +* + IS = IS - 1 + IF( IP.NE.0 ) + $ IS = IS - 1 + 140 CONTINUE + END IF + + IF( LEFTV ) THEN +* +* ============================================================ +* Compute left eigenvectors. +* +* IV is index of column in current block. +* For complex left vector, uses IV for real part and IV+1 for complex part. +* Non-blocked version always uses IV=1; +* blocked version starts with IV=1, goes up to NB-1 or NB. +* (Note the "0-th" column is used for 1-norms computed above.) + IV = 1 + IP = 0 + IS = 1 + DO 260 KI = 1, N + IF( IP.EQ.1 ) THEN +* previous iteration (ki-1) was first of conjugate pair, +* so this ki is second of conjugate pair; skip to end of loop + IP = -1 + GO TO 260 + ELSE IF( KI.EQ.N ) THEN +* last column, so this ki must be real eigenvalue + IP = 0 + ELSE IF( T( KI+1, KI ).EQ.ZERO ) THEN +* zero on sub-diagonal, so this ki is real eigenvalue + IP = 0 + ELSE +* non-zero on sub-diagonal, so this ki is first of conjugate pair + IP = 1 + END IF +* + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 260 + END IF +* +* Compute the KI-th eigenvalue (WR,WI). +* + WR = T( KI, KI ) + WI = ZERO + IF( IP.NE.0 ) + $ WI = SQRT( ABS( T( KI, KI+1 ) ) )* + $ SQRT( ABS( T( KI+1, KI ) ) ) + SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM ) +* + IF( IP.EQ.0 ) THEN +* +* -------------------------------------------------------- +* Real left eigenvector +* + WORK( KI + IV*N ) = ONE +* +* Form right-hand side. +* + DO 160 K = KI + 1, N + WORK( K + IV*N ) = -T( KI, K ) + 160 CONTINUE +* +* Solve transposed quasi-triangular system: +* [ T(KI+1:N,KI+1:N) - WR ]**T * X = SCALE*WORK +* + VMAX = ONE + VCRIT = BIGNUM +* + JNXT = KI + 1 + DO 170 J = KI + 1, N + IF( J.LT.JNXT ) + $ GO TO 170 + J1 = J + J2 = J + JNXT = J + 1 + IF( J.LT.N ) THEN + IF( T( J+1, J ).NE.ZERO ) THEN + J2 = J + 1 + JNXT = J + 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side. +* + IF( WORK( J ).GT.VCRIT ) THEN + REC = ONE / VMAX + CALL DSCAL( N-KI+1, REC, WORK( KI+IV*N ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+IV*N ) = WORK( J+IV*N ) - + $ DDOT( J-KI-1, T( KI+1, J ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* +* Solve [ T(J,J) - WR ]**T * X = WORK +* + CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL DSCAL( N-KI+1, SCALE, WORK( KI+IV*N ), 1 ) + WORK( J+IV*N ) = X( 1, 1 ) + VMAX = MAX( ABS( WORK( J+IV*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + ELSE +* +* 2-by-2 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side. +* + BETA = MAX( WORK( J ), WORK( J+1 ) ) + IF( BETA.GT.VCRIT ) THEN + REC = ONE / VMAX + CALL DSCAL( N-KI+1, REC, WORK( KI+IV*N ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+IV*N ) = WORK( J+IV*N ) - + $ DDOT( J-KI-1, T( KI+1, J ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* + WORK( J+1+IV*N ) = WORK( J+1+IV*N ) - + $ DDOT( J-KI-1, T( KI+1, J+1 ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* +* Solve +* [ T(J,J)-WR T(J,J+1) ]**T * X = SCALE*( WORK1 ) +* [ T(J+1,J) T(J+1,J+1)-WR ] ( WORK2 ) +* + CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL DSCAL( N-KI+1, SCALE, WORK( KI+IV*N ), 1 ) + WORK( J +IV*N ) = X( 1, 1 ) + WORK( J+1+IV*N ) = X( 2, 1 ) +* + VMAX = MAX( ABS( WORK( J +IV*N ) ), + $ ABS( WORK( J+1+IV*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + END IF + 170 CONTINUE +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL DCOPY( N-KI+1, WORK( KI + IV*N ), 1, + $ VL( KI, IS ), 1 ) +* + II = IDAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 + REMAX = ONE / ABS( VL( II, IS ) ) + CALL DSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) +* + DO 180 K = 1, KI - 1 + VL( K, IS ) = ZERO + 180 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N ) + $ CALL DGEMV( 'N', N, N-KI, ONE, + $ VL( 1, KI+1 ), LDVL, + $ WORK( KI+1 + IV*N ), 1, + $ WORK( KI + IV*N ), VL( 1, KI ), 1 ) +* + II = IDAMAX( N, VL( 1, KI ), 1 ) + REMAX = ONE / ABS( VL( II, KI ) ) + CALL DSCAL( N, REMAX, VL( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + IV*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP +* back-transform and normalization is done below + END IF + ELSE +* +* -------------------------------------------------------- +* Complex left eigenvector. +* +* Initial solve: +* [ ( T(KI,KI) T(KI,KI+1) )**T - (WR - I* WI) ]*X = 0. +* [ ( T(KI+1,KI) T(KI+1,KI+1) ) ] +* + IF( ABS( T( KI, KI+1 ) ).GE.ABS( T( KI+1, KI ) ) ) THEN + WORK( KI + (IV )*N ) = WI / T( KI, KI+1 ) + WORK( KI+1 + (IV+1)*N ) = ONE + ELSE + WORK( KI + (IV )*N ) = ONE + WORK( KI+1 + (IV+1)*N ) = -WI / T( KI+1, KI ) + END IF + WORK( KI+1 + (IV )*N ) = ZERO + WORK( KI + (IV+1)*N ) = ZERO +* +* Form right-hand side. +* + DO 190 K = KI + 2, N + WORK( K+(IV )*N ) = -WORK( KI +(IV )*N )*T(KI, K) + WORK( K+(IV+1)*N ) = -WORK( KI+1+(IV+1)*N )*T(KI+1,K) + 190 CONTINUE +* +* Solve transposed quasi-triangular system: +* [ T(KI+2:N,KI+2:N)**T - (WR-i*WI) ]*X = WORK1+i*WORK2 +* + VMAX = ONE + VCRIT = BIGNUM +* + JNXT = KI + 2 + DO 200 J = KI + 2, N + IF( J.LT.JNXT ) + $ GO TO 200 + J1 = J + J2 = J + JNXT = J + 1 + IF( J.LT.N ) THEN + IF( T( J+1, J ).NE.ZERO ) THEN + J2 = J + 1 + JNXT = J + 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* +* Scale if necessary to avoid overflow when +* forming the right-hand side elements. +* + IF( WORK( J ).GT.VCRIT ) THEN + REC = ONE / VMAX + CALL DSCAL( N-KI+1, REC, WORK(KI+(IV )*N), 1 ) + CALL DSCAL( N-KI+1, REC, WORK(KI+(IV+1)*N), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+(IV )*N ) = WORK( J+(IV)*N ) - + $ DDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) + WORK( J+(IV+1)*N ) = WORK( J+(IV+1)*N ) - + $ DDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* +* Solve [ T(J,J)-(WR-i*WI) ]*(X11+i*X12)= WK+I*WK2 +* + CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ -WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL DSCAL( N-KI+1, SCALE, WORK(KI+(IV )*N), 1) + CALL DSCAL( N-KI+1, SCALE, WORK(KI+(IV+1)*N), 1) + END IF + WORK( J+(IV )*N ) = X( 1, 1 ) + WORK( J+(IV+1)*N ) = X( 1, 2 ) + VMAX = MAX( ABS( WORK( J+(IV )*N ) ), + $ ABS( WORK( J+(IV+1)*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + ELSE +* +* 2-by-2 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side elements. +* + BETA = MAX( WORK( J ), WORK( J+1 ) ) + IF( BETA.GT.VCRIT ) THEN + REC = ONE / VMAX + CALL DSCAL( N-KI+1, REC, WORK(KI+(IV )*N), 1 ) + CALL DSCAL( N-KI+1, REC, WORK(KI+(IV+1)*N), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J +(IV )*N ) = WORK( J+(IV)*N ) - + $ DDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) +* + WORK( J +(IV+1)*N ) = WORK( J+(IV+1)*N ) - + $ DDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* + WORK( J+1+(IV )*N ) = WORK( J+1+(IV)*N ) - + $ DDOT( J-KI-2, T( KI+2, J+1 ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) +* + WORK( J+1+(IV+1)*N ) = WORK( J+1+(IV+1)*N ) - + $ DDOT( J-KI-2, T( KI+2, J+1 ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* +* Solve 2-by-2 complex linear equation +* [ (T(j,j) T(j,j+1) )**T - (wr-i*wi)*I ]*X = SCALE*B +* [ (T(j+1,j) T(j+1,j+1)) ] +* + CALL DLALN2( .TRUE., 2, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ -WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL DSCAL( N-KI+1, SCALE, WORK(KI+(IV )*N), 1) + CALL DSCAL( N-KI+1, SCALE, WORK(KI+(IV+1)*N), 1) + END IF + WORK( J +(IV )*N ) = X( 1, 1 ) + WORK( J +(IV+1)*N ) = X( 1, 2 ) + WORK( J+1+(IV )*N ) = X( 2, 1 ) + WORK( J+1+(IV+1)*N ) = X( 2, 2 ) + VMAX = MAX( ABS( X( 1, 1 ) ), ABS( X( 1, 2 ) ), + $ ABS( X( 2, 1 ) ), ABS( X( 2, 2 ) ), + $ VMAX ) + VCRIT = BIGNUM / VMAX +* + END IF + 200 CONTINUE +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL DCOPY( N-KI+1, WORK( KI + (IV )*N ), 1, + $ VL( KI, IS ), 1 ) + CALL DCOPY( N-KI+1, WORK( KI + (IV+1)*N ), 1, + $ VL( KI, IS+1 ), 1 ) +* + EMAX = ZERO + DO 220 K = KI, N + EMAX = MAX( EMAX, ABS( VL( K, IS ) )+ + $ ABS( VL( K, IS+1 ) ) ) + 220 CONTINUE + REMAX = ONE / EMAX + CALL DSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) + CALL DSCAL( N-KI+1, REMAX, VL( KI, IS+1 ), 1 ) +* + DO 230 K = 1, KI - 1 + VL( K, IS ) = ZERO + VL( K, IS+1 ) = ZERO + 230 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N-1 ) THEN + CALL DGEMV( 'N', N, N-KI-1, ONE, + $ VL( 1, KI+2 ), LDVL, + $ WORK( KI+2 + (IV)*N ), 1, + $ WORK( KI + (IV)*N ), + $ VL( 1, KI ), 1 ) + CALL DGEMV( 'N', N, N-KI-1, ONE, + $ VL( 1, KI+2 ), LDVL, + $ WORK( KI+2 + (IV+1)*N ), 1, + $ WORK( KI+1 + (IV+1)*N ), + $ VL( 1, KI+1 ), 1 ) + ELSE + CALL DSCAL( N, WORK(KI+ (IV )*N), VL(1, KI ), 1) + CALL DSCAL( N, WORK(KI+1+(IV+1)*N), VL(1, KI+1), 1) + END IF +* + EMAX = ZERO + DO 240 K = 1, N + EMAX = MAX( EMAX, ABS( VL( K, KI ) )+ + $ ABS( VL( K, KI+1 ) ) ) + 240 CONTINUE + REMAX = ONE / EMAX + CALL DSCAL( N, REMAX, VL( 1, KI ), 1 ) + CALL DSCAL( N, REMAX, VL( 1, KI+1 ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + (IV )*N ) = ZERO + WORK( K + (IV+1)*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP + ISCOMPLEX( IV+1 ) = -IP + IV = IV + 1 +* back-transform and normalization is done below + END IF + END IF + + IF( NB.GT.1 ) THEN +* -------------------------------------------------------- +* Blocked version of back-transform +* For complex case, KI2 includes both vectors (KI and KI+1) + IF( IP.EQ.0 ) THEN + KI2 = KI + ELSE + KI2 = KI + 1 + END IF + +* Columns 1:IV of work are valid vectors. +* When the number of vectors stored reaches NB-1 or NB, +* or if this was last vector, do the GEMM + IF( (IV.GE.NB-1) .OR. (KI2.EQ.N) ) THEN + CALL DGEMM( 'N', 'N', N, IV, N-KI2+IV, ONE, + $ VL( 1, KI2-IV+1 ), LDVL, + $ WORK( KI2-IV+1 + (1)*N ), N, + $ ZERO, + $ WORK( 1 + (NB+1)*N ), N ) +* normalize vectors + DO K = 1, IV + IF( ISCOMPLEX(K).EQ.0) THEN +* real eigenvector + II = IDAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / ABS( WORK( II + (NB+K)*N ) ) + ELSE IF( ISCOMPLEX(K).EQ.1) THEN +* first eigenvector of conjugate pair + EMAX = ZERO + DO II = 1, N + EMAX = MAX( EMAX, + $ ABS( WORK( II + (NB+K )*N ) )+ + $ ABS( WORK( II + (NB+K+1)*N ) ) ) + END DO + REMAX = ONE / EMAX +* else if ISCOMPLEX(K).EQ.-1 +* second eigenvector of conjugate pair +* reuse same REMAX as previous K + END IF + CALL DSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL DLACPY( 'F', N, IV, + $ WORK( 1 + (NB+1)*N ), N, + $ VL( 1, KI2-IV+1 ), LDVL ) + IV = 1 + ELSE + IV = IV + 1 + END IF + END IF ! blocked back-transform +* + IS = IS + 1 + IF( IP.NE.0 ) + $ IS = IS + 1 + 260 CONTINUE + END IF +* + RETURN +* +* End of DTREVC3 +* + END diff --git a/lapack-netlib/SRC/ilaenv.f b/lapack-netlib/SRC/ilaenv.f index 89a4468ff..b963ad738 100644 --- a/lapack-netlib/SRC/ilaenv.f +++ b/lapack-netlib/SRC/ilaenv.f @@ -132,7 +132,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -162,10 +162,10 @@ * ===================================================================== INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*( * ) NAME, OPTS @@ -397,6 +397,12 @@ ELSE NB = 64 END IF + ELSE IF ( C3.EQ.'EVC' ) THEN + IF( SNAME ) THEN + NB = 64 + ELSE + NB = 64 + END IF END IF ELSE IF( C2.EQ.'LA' ) THEN IF( C3.EQ.'UUM' ) THEN diff --git a/lapack-netlib/SRC/ilaver.f b/lapack-netlib/SRC/ilaver.f index c882d03f5..0da02707e 100644 --- a/lapack-netlib/SRC/ilaver.f +++ b/lapack-netlib/SRC/ilaver.f @@ -25,13 +25,19 @@ * ========== * *> \param[out] VERS_MAJOR +*> \verbatim *> return the lapack major version +*> \endverbatim *> *> \param[out] VERS_MINOR +*> \verbatim *> return the lapack minor version from the major version +*> \endverbatim *> *> \param[out] VERS_PATCH +*> \verbatim *> return the lapack patch version from the minor version +*> \endverbatim * * Authors: * ======== @@ -41,17 +47,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * * ===================================================================== SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * ===================================================================== * @@ -59,7 +65,7 @@ * ===================================================================== VERS_MAJOR = 3 VERS_MINOR = 6 - VERS_PATCH = 0 + VERS_PATCH = 1 * ===================================================================== * RETURN diff --git a/lapack-netlib/SRC/sbbcsd.f b/lapack-netlib/SRC/sbbcsd.f index 46b87c7ee..d2cd707fb 100644 --- a/lapack-netlib/SRC/sbbcsd.f +++ b/lapack-netlib/SRC/sbbcsd.f @@ -149,7 +149,7 @@ *> \param[in,out] U1 *> \verbatim *> U1 is REAL array, dimension (LDU1,P) -*> On entry, an LDU1-by-P matrix. On exit, U1 is postmultiplied +*> On entry, a P-by-P matrix. On exit, U1 is postmultiplied *> by the left singular vector matrix common to [ B11 ; 0 ] and *> [ B12 0 0 ; 0 -I 0 0 ]. *> \endverbatim @@ -157,13 +157,13 @@ *> \param[in] LDU1 *> \verbatim *> LDU1 is INTEGER -*> The leading dimension of the array U1. +*> The leading dimension of the array U1, LDU1 >= MAX(1,P). *> \endverbatim *> *> \param[in,out] U2 *> \verbatim *> U2 is REAL array, dimension (LDU2,M-P) -*> On entry, an LDU2-by-(M-P) matrix. On exit, U2 is +*> On entry, an (M-P)-by-(M-P) matrix. On exit, U2 is *> postmultiplied by the left singular vector matrix common to *> [ B21 ; 0 ] and [ B22 0 0 ; 0 0 I ]. *> \endverbatim @@ -171,13 +171,13 @@ *> \param[in] LDU2 *> \verbatim *> LDU2 is INTEGER -*> The leading dimension of the array U2. +*> The leading dimension of the array U2, LDU2 >= MAX(1,M-P). *> \endverbatim *> *> \param[in,out] V1T *> \verbatim *> V1T is REAL array, dimension (LDV1T,Q) -*> On entry, a LDV1T-by-Q matrix. On exit, V1T is premultiplied +*> On entry, a Q-by-Q matrix. On exit, V1T is premultiplied *> by the transpose of the right singular vector *> matrix common to [ B11 ; 0 ] and [ B21 ; 0 ]. *> \endverbatim @@ -185,13 +185,13 @@ *> \param[in] LDV1T *> \verbatim *> LDV1T is INTEGER -*> The leading dimension of the array V1T. +*> The leading dimension of the array V1T, LDV1T >= MAX(1,Q). *> \endverbatim *> *> \param[in,out] V2T *> \verbatim *> V2T is REAL array, dimenison (LDV2T,M-Q) -*> On entry, a LDV2T-by-(M-Q) matrix. On exit, V2T is +*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is *> premultiplied by the transpose of the right *> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and *> [ B22 0 0 ; 0 0 I ]. @@ -200,7 +200,7 @@ *> \param[in] LDV2T *> \verbatim *> LDV2T is INTEGER -*> The leading dimension of the array V2T. +*> The leading dimension of the array V2T, LDV2T >= MAX(1,M-Q). *> \endverbatim *> *> \param[out] B11D @@ -322,7 +322,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHERcomputational * @@ -332,10 +332,10 @@ $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS diff --git a/lapack-netlib/SRC/sbdsdc.f b/lapack-netlib/SRC/sbdsdc.f index 261aa1c21..b31cc0bf0 100644 --- a/lapack-netlib/SRC/sbdsdc.f +++ b/lapack-netlib/SRC/sbdsdc.f @@ -191,7 +191,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -205,10 +205,10 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, $ WORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER COMPQ, UPLO @@ -311,7 +311,7 @@ WSTART = 1 QSTART = 3 IF( ICOMPQ.EQ.1 ) THEN - CALL SCOPY( N, D, 1, Q( 1 ), 1 ) + CALL SCOPY( N, D, 1, Q( 1 ), 1 ) CALL SCOPY( N-1, E, 1, Q( N+1 ), 1 ) END IF IF( IUPLO.EQ.2 ) THEN @@ -335,8 +335,11 @@ * If ICOMPQ = 0, use SLASDQ to compute the singular values. * IF( ICOMPQ.EQ.0 ) THEN +* Ignore WSTART, instead using WORK( 1 ), since the two vectors +* for CS and -SN above are added only if ICOMPQ == 2, +* and adding them exceeds documented WORK size of 4*n. CALL SLASDQ( 'U', 0, N, 0, 0, 0, D, E, VT, LDVT, U, LDU, U, - $ LDU, WORK( WSTART ), INFO ) + $ LDU, WORK( 1 ), INFO ) GO TO 40 END IF * diff --git a/lapack-netlib/SRC/sbdsvdx.f b/lapack-netlib/SRC/sbdsvdx.f index 752640700..6b5c3c419 100644 --- a/lapack-netlib/SRC/sbdsvdx.f +++ b/lapack-netlib/SRC/sbdsvdx.f @@ -80,7 +80,7 @@ *> = 'L': B is lower bidiagonal. *> \endverbatim *> -*> \param[in] JOBXZ +*> \param[in] JOBZ *> \verbatim *> JOBZ is CHARACTER*1 *> = 'N': Compute singular values only; @@ -117,14 +117,16 @@ *> *> \param[in] VL *> \verbatim -*> VL is REAL -*> VL >=0. +*> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,13 +134,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -190,7 +196,10 @@ *> If JOBZ = 'V', then if INFO = 0, the first NS elements of *> IWORK are zero. If INFO > 0, then IWORK contains the indices *> of the eigenvectors that failed to converge in DSTEVX. +*> \endverbatim *> +*> \param[out] INFO +*> \verbatim *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value @@ -209,7 +218,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -217,7 +226,7 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, $ NS, S, Z, LDZ, WORK, IWORK, INFO) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -371,7 +380,6 @@ IF( ABS( E( I ) ).LE.THRESH ) E( I ) = ZERO END DO IF( ABS( D( N ) ).LE.THRESH ) D( N ) = ZERO - E( N ) = ZERO * * Pointers for arrays used by SSTEVX. * @@ -398,7 +406,7 @@ * of the active submatrix. * RNGVX = 'I' - CALL SLASET( 'F', N*2, N+1, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL SLASET( 'F', N*2, N+1, ZERO, ZERO, Z, LDZ ) ELSE IF( VALSV ) THEN * * Find singular values in a half-open interval. We aim @@ -418,7 +426,7 @@ IF( NS.EQ.0 ) THEN RETURN ELSE - CALL SLASET( 'F', N*2, NS, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL SLASET( 'F', N*2, NS, ZERO, ZERO, Z, LDZ ) END IF ELSE IF( INDSV ) THEN * @@ -455,7 +463,7 @@ * IF( VLTGK.EQ.VUTGK ) VLTGK = VLTGK - TOL * - CALL SLASET( 'F', N*2, IU-IL+1, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL SLASET( 'F', N*2, IU-IL+1, ZERO, ZERO, Z, LDZ) END IF * * Initialize variables and pointers for S, Z, and WORK. @@ -709,9 +717,11 @@ NRU = 0 NRV = 0 END IF !** NTGK.GT.0 **! - IF( IROWZ.LT.N*2 ) Z( 1:IROWZ-1, ICOLZ ) = ZERO + IF( IROWZ.LT.N*2 .AND. WANTZ ) THEN + Z( 1:IROWZ-1, ICOLZ ) = ZERO + END IF END DO !** IDPTR loop **! - IF( SPLIT ) THEN + IF( SPLIT .AND. WANTZ ) THEN * * Bring back eigenvector corresponding * to eigenvalue equal to zero. @@ -744,7 +754,7 @@ IF( K.NE.NS+1-I ) THEN S( K ) = S( NS+1-I ) S( NS+1-I ) = SMIN - CALL SSWAP( N*2, Z( 1,K ), 1, Z( 1,NS+1-I ), 1 ) + IF( WANTZ ) CALL SSWAP( N*2, Z( 1,K ), 1, Z( 1,NS+1-I ), 1 ) END IF END DO * @@ -754,7 +764,7 @@ K = IU - IL + 1 IF( K.LT.NS ) THEN S( K+1:NS ) = ZERO - Z( 1:N*2,K+1:NS ) = ZERO + IF( WANTZ ) Z( 1:N*2,K+1:NS ) = ZERO NS = K END IF END IF @@ -762,6 +772,7 @@ * Reorder Z: U = Z( 1:N,1:NS ), V = Z( N+1:N*2,1:NS ). * If B is a lower diagonal, swap U and V. * + IF( WANTZ ) THEN DO I = 1, NS CALL SCOPY( N*2, Z( 1,I ), 1, WORK, 1 ) IF( LOWER ) THEN @@ -772,6 +783,7 @@ CALL SCOPY( N, WORK( 1 ), 2, Z( N+1,I ), 1 ) END IF END DO + END IF * RETURN * diff --git a/lapack-netlib/SRC/sgbequb.f b/lapack-netlib/SRC/sgbequb.f index d1effd9e3..d94b88516 100644 --- a/lapack-netlib/SRC/sgbequb.f +++ b/lapack-netlib/SRC/sgbequb.f @@ -83,7 +83,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) +*> AB is REAL array, dimension (LDAB,N) *> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. *> The j-th column of A is stored in the j-th column of the *> array AB as follows: @@ -152,7 +152,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realGBcomputational * @@ -160,10 +160,10 @@ SUBROUTINE SGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, $ AMAX, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, KL, KU, LDAB, M, N diff --git a/lapack-netlib/SRC/sgbrfsx.f b/lapack-netlib/SRC/sgbrfsx.f index a154c3d6e..234ea170e 100644 --- a/lapack-netlib/SRC/sgbrfsx.f +++ b/lapack-netlib/SRC/sgbrfsx.f @@ -121,7 +121,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) +*> AB is REAL array, dimension (LDAB,N) *> The original band matrix A, stored in rows 1 to KL+KU+1. *> The j-th column of A is stored in the j-th column of the *> array AB as follows: @@ -136,7 +136,7 @@ *> *> \param[in] AFB *> \verbatim -*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N) +*> AFB is REAL array, dimension (LDAFB,N) *> Details of the LU factorization of the band matrix A, as *> computed by DGBTRF. U is stored as an upper triangular band *> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and @@ -440,7 +440,7 @@ $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.1) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -646,7 +646,7 @@ * * Perform refinement on each right-hand side * - IF (REF_TYPE .NE. 0) THEN + IF ( REF_TYPE .NE. 0 .AND. INFO .EQ. 0 ) THEN PREC_TYPE = ILAPREC( 'D' ) diff --git a/lapack-netlib/SRC/sgeesx.f b/lapack-netlib/SRC/sgeesx.f index fe98b450e..1deb4d5f7 100644 --- a/lapack-netlib/SRC/sgeesx.f +++ b/lapack-netlib/SRC/sgeesx.f @@ -90,7 +90,7 @@ *> *> \param[in] SELECT *> \verbatim -*> SELECT is procedure) LOGICAL FUNCTION of two REAL arguments +*> SELECT is a LOGICAL FUNCTION of two REAL arguments *> SELECT must be declared EXTERNAL in the calling subroutine. *> If SORT = 'S', SELECT is used to select eigenvalues to sort *> to the top left of the Schur form. @@ -272,7 +272,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realGEeigen * @@ -281,10 +281,10 @@ $ WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, $ IWORK, LIWORK, BWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVS, SENSE, SORT diff --git a/lapack-netlib/SRC/sgeev.f b/lapack-netlib/SRC/sgeev.f index 667de0afe..9f21d1fc5 100644 --- a/lapack-netlib/SRC/sgeev.f +++ b/lapack-netlib/SRC/sgeev.f @@ -26,7 +26,7 @@ * INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. -* REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), +* REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), * $ WI( * ), WORK( * ), WR( * ) * .. * @@ -181,56 +181,59 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 +* +* @generated from dgeev.f, fortran d -> s, Tue Apr 19 01:47:44 2016 * *> \ingroup realGEeigen * * ===================================================================== SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, $ LDVR, WORK, LWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVL, JOBVR INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. - REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ WI( * ), WORK( * ), WR( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL LQUERY, SCALEA, WANTVL, WANTVR CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K, - $ MAXWRK, MINWRK, NOUT - REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT + REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY, - $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC, + $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC3, $ XERBLA * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL SLAMCH, SLANGE, SLAPY2, SNRM2 - EXTERNAL LSAME, ILAENV, ISAMAX, SLAMCH, SLANGE, SLAPY2, + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SLANGE, SLAPY2, SNRM2 + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SLANGE, SLAPY2, $ SNRM2 * .. * .. Intrinsic Functions .. @@ -279,24 +282,34 @@ MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1, $ 'SORGHR', ' ', N, 1, N, -1 ) ) CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) + CALL STREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, N, NOUT, + $ WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) MAXWRK = MAX( MAXWRK, 4*N ) ELSE IF( WANTVR ) THEN MINWRK = 4*N MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1, $ 'SORGHR', ' ', N, 1, N, -1 ) ) CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) + CALL STREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, N, NOUT, + $ WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) MAXWRK = MAX( MAXWRK, 4*N ) ELSE MINWRK = 3*N CALL SHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) END IF MAXWRK = MAX( MAXWRK, MINWRK ) @@ -426,10 +439,10 @@ IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (Workspace: need 4*N) +* (Workspace: need 4*N, prefer N + N + 2*N*NB) * - CALL STREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), IERR ) + CALL STREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * IF( WANTVL ) THEN diff --git a/lapack-netlib/SRC/sgeevx.f b/lapack-netlib/SRC/sgeevx.f index 821c080cd..db20e8bee 100644 --- a/lapack-netlib/SRC/sgeevx.f +++ b/lapack-netlib/SRC/sgeevx.f @@ -25,11 +25,11 @@ * .. Scalar Arguments .. * CHARACTER BALANC, JOBVL, JOBVR, SENSE * INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N -* REAL ABNRM +* REAL ABNRM * .. * .. Array Arguments .. * INTEGER IWORK( * ) -* REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), +* REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), * $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ), * $ WI( * ), WORK( * ), WR( * ) * .. @@ -210,7 +210,7 @@ *> \verbatim *> IHI is INTEGER *> ILO and IHI are integer values determined when A was -*> balanced. The balanced A(i,j) = 0 if I > J and +*> balanced. The balanced A(i,j) = 0 if I > J and *> J = 1,...,ILO-1 or I = IHI+1,...,N. *> \endverbatim *> @@ -294,7 +294,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 +* +* @generated from dgeevx.f, fortran d -> s, Tue Apr 19 01:47:44 2016 * *> \ingroup realGEeigen * @@ -302,20 +304,21 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, $ VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, $ RCONDE, RCONDV, WORK, LWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER BALANC, JOBVL, JOBVR, SENSE INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N - REAL ABNRM + REAL ABNRM * .. * .. Array Arguments .. INTEGER IWORK( * ) - REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), + REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ), $ WI( * ), WORK( * ), WR( * ) * .. @@ -323,32 +326,32 @@ * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK, - $ MINWRK, NOUT - REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT + REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY, - $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC, + $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC3, $ STRSNA, XERBLA * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL SLAMCH, SLANGE, SLAPY2, SNRM2 - EXTERNAL LSAME, ILAENV, ISAMAX, SLAMCH, SLANGE, SLAPY2, + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SLANGE, SLAPY2, SNRM2 + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SLANGE, SLAPY2, $ SNRM2 * .. * .. Intrinsic Functions .. @@ -366,8 +369,9 @@ WNTSNE = LSAME( SENSE, 'E' ) WNTSNV = LSAME( SENSE, 'V' ) WNTSNB = LSAME( SENSE, 'B' ) - IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) .OR. - $ LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) THEN + IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) + $ .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) + $ THEN INFO = -1 ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN INFO = -2 @@ -405,9 +409,19 @@ MAXWRK = N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 ) * IF( WANTVL ) THEN + CALL STREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN + CALL STREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR, $ WORK, -1, INFO ) ELSE @@ -419,7 +433,7 @@ $ LDVR, WORK, -1, INFO ) END IF END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) * IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN MINWRK = 2*N @@ -571,18 +585,18 @@ $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * -* If INFO > 0 from SHSEQR, then quit +* If INFO .NE. 0 from SHSEQR, then quit * - IF( INFO.GT.0 ) + IF( INFO.NE.0 ) $ GO TO 50 * IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (Workspace: need 3*N) +* (Workspace: need 3*N, prefer N + 2*N*NB) * - CALL STREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), IERR ) + CALL STREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * * Compute condition numbers if desired diff --git a/lapack-netlib/SRC/sgejsv.f b/lapack-netlib/SRC/sgejsv.f index 55bb59e12..7d80d4ec0 100644 --- a/lapack-netlib/SRC/sgejsv.f +++ b/lapack-netlib/SRC/sgejsv.f @@ -53,7 +53,6 @@ *> of [SIGMA] is computed and stored in the array SVA. *> SGEJSV can sometimes compute tiny singular values and their singular vectors much *> more accurately than other SVD routines, see below under Further Details. - *> \endverbatim * * Arguments: @@ -238,7 +237,7 @@ *> copied back to the V array. This 'W' option is just *> a reminder to the caller that in this case U is *> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced. +*> If JOBU = 'N' U is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDU @@ -260,7 +259,7 @@ *> copied back to the U array. This 'W' option is just *> a reminder to the caller that in this case V is *> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced. +*> If JOBV = 'N' V is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDV @@ -392,7 +391,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realGEsing * @@ -459,7 +458,7 @@ *> LAPACK Working note 170. *> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR *> factorization software - a case study. -*> ACM Trans. math. Softw. Vol. 35, No 2 (2008), pp. 1-28. +*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28. *> LAPACK Working note 176. *> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, *> QSVD, (H,K)-SVD computations. @@ -477,10 +476,10 @@ $ M, N, A, LDA, SVA, U, LDU, V, LDV, $ WORK, LWORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. IMPLICIT NONE @@ -591,7 +590,11 @@ * * Quick return for void matrix (Y3K safe) * #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) RETURN + IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN + IWORK(1:3) = 0 + WORK(1:7) = 0 + RETURN + ENDIF * * Determine whether the matrix U should be M x N or M x M * @@ -717,6 +720,7 @@ IWORK(1) = 0 IWORK(2) = 0 END IF + IWORK(3) = 0 IF ( ERREST ) WORK(3) = ONE IF ( LSVEC .AND. RSVEC ) THEN WORK(4) = ONE diff --git a/lapack-netlib/SRC/sgeqrt3.f b/lapack-netlib/SRC/sgeqrt3.f index 86a43f67d..a0e1c2c18 100644 --- a/lapack-netlib/SRC/sgeqrt3.f +++ b/lapack-netlib/SRC/sgeqrt3.f @@ -100,7 +100,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realGEcomputational * @@ -132,10 +132,10 @@ * ===================================================================== RECURSIVE SUBROUTINE SGEQRT3( M, N, A, LDA, T, LDT, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, LDT @@ -177,7 +177,7 @@ * * Compute Householder transform when N=1 * - CALL SLARFG( M, A, A( MIN( 2, M ), 1 ), 1, T ) + CALL SLARFG( M, A(1,1), A( MIN( 2, M ), 1 ), 1, T(1,1) ) * ELSE * diff --git a/lapack-netlib/SRC/sgesdd.f b/lapack-netlib/SRC/sgesdd.f index 1bc7e8a4e..cae699394 100644 --- a/lapack-netlib/SRC/sgesdd.f +++ b/lapack-netlib/SRC/sgesdd.f @@ -18,8 +18,8 @@ * Definition: * =========== * -* SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, -* LWORK, IWORK, INFO ) +* SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, +* WORK, LWORK, IWORK, INFO ) * * .. Scalar Arguments .. * CHARACTER JOBZ @@ -27,7 +27,7 @@ * .. * .. Array Arguments .. * INTEGER IWORK( * ) -* REAL A( LDA, * ), S( * ), U( LDU, * ), +* REAL A( LDA, * ), S( * ), U( LDU, * ), * $ VT( LDVT, * ), WORK( * ) * .. * @@ -154,8 +154,8 @@ *> \param[in] LDVT *> \verbatim *> LDVT is INTEGER -*> The leading dimension of the array VT. LDVT >= 1; if -*> JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; +*> The leading dimension of the array VT. LDVT >= 1; +*> if JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; *> if JOBZ = 'S', LDVT >= min(M,N). *> \endverbatim *> @@ -169,16 +169,18 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 1. -*> If JOBZ = 'N', -*> LWORK >= 3*min(M,N) + max(max(M,N),6*min(M,N)). -*> If JOBZ = 'O', -*> LWORK >= 3*min(M,N) + -*> max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)). -*> If JOBZ = 'S' or 'A' -*> LWORK >= min(M,N)*(7+4*min(M,N)) -*> For good performance, LWORK should generally be larger. -*> If LWORK = -1 but other input arguments are legal, WORK(1) -*> returns the optimal LWORK. +*> If LWORK = -1, a workspace query is assumed. The optimal +*> size for the WORK array is calculated and stored in WORK(1), +*> and no other work except argument checking is performed. +*> +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LWORK >= 3*mn + max( mx, 7*mn ). +*> If JOBZ = 'O', LWORK >= 3*mn + max( mx, 5*mn*mn + 4*mn ). +*> If JOBZ = 'S', LWORK >= 4*mn*mn + 7*mn. +*> If JOBZ = 'A', LWORK >= 4*mn*mn + 6*mn + mx. +*> These are not tight minimums in all cases; see comments inside code. +*> For good performance, LWORK should generally be larger; +*> a query is recommended. *> \endverbatim *> *> \param[out] IWORK @@ -202,7 +204,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realGEsing * @@ -213,13 +215,14 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, - $ LWORK, IWORK, INFO ) + SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, + $ WORK, LWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ @@ -227,14 +230,14 @@ * .. * .. Array Arguments .. INTEGER IWORK( * ) - REAL A( LDA, * ), S( * ), U( LDU, * ), + REAL A( LDA, * ), S( * ), U( LDU, * ), $ VT( LDVT, * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. @@ -243,7 +246,16 @@ $ IR, ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT, $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK, $ MNTHR, NWORK, WRKBL - REAL ANRM, BIGNUM, EPS, SMLNUM + INTEGER LWORK_SGEBRD_MN, LWORK_SGEBRD_MM, + $ LWORK_SGEBRD_NN, LWORK_SGELQF_MN, + $ LWORK_SGEQRF_MN, + $ LWORK_SORGBR_P_MM, LWORK_SORGBR_Q_NN, + $ LWORK_SORGLQ_MN, LWORK_SORGLQ_NN, + $ LWORK_SORGQR_MM, LWORK_SORGQR_MN, + $ LWORK_SORMBR_PRT_MM, LWORK_SORMBR_QLN_MM, + $ LWORK_SORMBR_PRT_MN, LWORK_SORMBR_QLN_MN, + $ LWORK_SORMBR_PRT_NN, LWORK_SORMBR_QLN_NN + REAL ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. INTEGER IDUM( 1 ) @@ -256,9 +268,8 @@ * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV REAL SLAMCH, SLANGE - EXTERNAL ILAENV, LSAME, SLAMCH, SLANGE + EXTERNAL SLAMCH, SLANGE, LSAME * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -267,13 +278,13 @@ * * Test the input arguments * - INFO = 0 - MINMN = MIN( M, N ) - WNTQA = LSAME( JOBZ, 'A' ) - WNTQS = LSAME( JOBZ, 'S' ) + INFO = 0 + MINMN = MIN( M, N ) + WNTQA = LSAME( JOBZ, 'A' ) + WNTQS = LSAME( JOBZ, 'S' ) WNTQAS = WNTQA .OR. WNTQS - WNTQO = LSAME( JOBZ, 'O' ) - WNTQN = LSAME( JOBZ, 'N' ) + WNTQO = LSAME( JOBZ, 'O' ) + WNTQN = LSAME( JOBZ, 'N' ) LQUERY = ( LWORK.EQ.-1 ) * IF( .NOT.( WNTQA .OR. WNTQS .OR. WNTQO .OR. WNTQN ) ) THEN @@ -294,222 +305,270 @@ END IF * * Compute workspace -* (Note: Comments in the code beginning "Workspace:" describe the -* minimal amount of workspace needed at that point in the code, +* Note: Comments in the code beginning "Workspace:" describe the +* minimal amount of workspace allocated at that point in the code, * as well as the preferred amount for good performance. * NB refers to the optimal block size for the immediately -* following subroutine, as returned by ILAENV.) +* following subroutine, as returned by ILAENV. * IF( INFO.EQ.0 ) THEN MINWRK = 1 MAXWRK = 1 + BDSPAC = 0 + MNTHR = INT( MINMN*11.0E0 / 6.0E0 ) IF( M.GE.N .AND. MINMN.GT.0 ) THEN * * Compute space needed for SBDSDC * - MNTHR = INT( MINMN*11.0E0 / 6.0E0 ) IF( WNTQN ) THEN +* sbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) +* keep 7*N for backwards compatability. BDSPAC = 7*N ELSE BDSPAC = 3*N*N + 4*N END IF +* +* Compute space preferred for each routine + CALL SGEBRD( M, N, DUM(1), M, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_SGEBRD_MN = INT( DUM(1) ) +* + CALL SGEBRD( N, N, DUM(1), N, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_SGEBRD_NN = INT( DUM(1) ) +* + CALL SGEQRF( M, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_SGEQRF_MN = INT( DUM(1) ) +* + CALL SORGBR( 'Q', N, N, N, DUM(1), N, DUM(1), DUM(1), -1, + $ IERR ) + LWORK_SORGBR_Q_NN = INT( DUM(1) ) +* + CALL SORGQR( M, M, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_SORGQR_MM = INT( DUM(1) ) +* + CALL SORGQR( M, N, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_SORGQR_MN = INT( DUM(1) ) +* + CALL SORMBR( 'P', 'R', 'T', N, N, N, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_SORMBR_PRT_NN = INT( DUM(1) ) +* + CALL SORMBR( 'Q', 'L', 'N', N, N, N, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_SORMBR_QLN_NN = INT( DUM(1) ) +* + CALL SORMBR( 'Q', 'L', 'N', M, N, N, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_SORMBR_QLN_MN = INT( DUM(1) ) +* + CALL SORMBR( 'Q', 'L', 'N', M, M, N, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_SORMBR_QLN_MM = INT( DUM(1) ) +* IF( M.GE.MNTHR ) THEN IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * - WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, - $ -1 ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+N ) + WRKBL = N + LWORK_SGEQRF_MN + WRKBL = MAX( WRKBL, 3*N + LWORK_SGEBRD_NN ) + MAXWRK = MAX( WRKBL, BDSPAC + N ) MINWRK = BDSPAC + N ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') +* Path 2 (M >> N, JOBZ='O') * - WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'SORGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) + WRKBL = N + LWORK_SGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_SORGQR_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + 2*N*N MINWRK = BDSPAC + 2*N*N + 3*N ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * - WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'SORGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) + WRKBL = N + LWORK_SGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_SORGQR_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + N*N MINWRK = BDSPAC + N*N + 3*N ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * - WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'SORGQR', ' ', M, - $ M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) + WRKBL = N + LWORK_SGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_SORGQR_MM ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + N*N - MINWRK = BDSPAC + N*N + 2*N + M + MINWRK = N*N + MAX( 3*N + BDSPAC, N + M ) END IF ELSE * -* Path 5 (M at least N, but not much larger) +* Path 5 (M >= N, but not much larger) * - WRKBL = 3*N + ( M+N )*ILAENV( 1, 'SGEBRD', ' ', M, N, -1, - $ -1 ) + WRKBL = 3*N + LWORK_SGEBRD_MN IF( WNTQN ) THEN - MAXWRK = MAX( WRKBL, BDSPAC+3*N ) +* Path 5n (M >= N, jobz='N') + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) ELSE IF( WNTQO ) THEN - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'QLN', M, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) +* Path 5o (M >= N, jobz='O') + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_MN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + M*N - MINWRK = 3*N + MAX( M, N*N+BDSPAC ) + MINWRK = 3*N + MAX( M, N*N + BDSPAC ) ELSE IF( WNTQS ) THEN - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'QLN', M, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*N ) +* Path 5s (M >= N, jobz='S') + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) ELSE IF( WNTQA ) THEN - WRKBL = MAX( WRKBL, 3*N+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, BDSPAC+3*N ) +* Path 5a (M >= N, jobz='A') + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) END IF END IF - ELSE IF ( MINMN.GT.0 ) THEN + ELSE IF( MINMN.GT.0 ) THEN * * Compute space needed for SBDSDC * - MNTHR = INT( MINMN*11.0E0 / 6.0E0 ) IF( WNTQN ) THEN +* sbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) +* keep 7*N for backwards compatability. BDSPAC = 7*M ELSE BDSPAC = 3*M*M + 4*M END IF +* +* Compute space preferred for each routine + CALL SGEBRD( M, N, DUM(1), M, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_SGEBRD_MN = INT( DUM(1) ) +* + CALL SGEBRD( M, M, A, M, S, DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_SGEBRD_MM = INT( DUM(1) ) +* + CALL SGELQF( M, N, A, M, DUM(1), DUM(1), -1, IERR ) + LWORK_SGELQF_MN = INT( DUM(1) ) +* + CALL SORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR ) + LWORK_SORGLQ_NN = INT( DUM(1) ) +* + CALL SORGLQ( M, N, M, A, M, DUM(1), DUM(1), -1, IERR ) + LWORK_SORGLQ_MN = INT( DUM(1) ) +* + CALL SORGBR( 'P', M, M, M, A, N, DUM(1), DUM(1), -1, IERR ) + LWORK_SORGBR_P_MM = INT( DUM(1) ) +* + CALL SORMBR( 'P', 'R', 'T', M, M, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_SORMBR_PRT_MM = INT( DUM(1) ) +* + CALL SORMBR( 'P', 'R', 'T', M, N, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_SORMBR_PRT_MN = INT( DUM(1) ) +* + CALL SORMBR( 'P', 'R', 'T', N, N, M, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_SORMBR_PRT_NN = INT( DUM(1) ) +* + CALL SORMBR( 'Q', 'L', 'N', M, M, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_SORMBR_QLN_MM = INT( DUM(1) ) +* IF( N.GE.MNTHR ) THEN IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * - WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, - $ -1 ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+M ) + WRKBL = M + LWORK_SGELQF_MN + WRKBL = MAX( WRKBL, 3*M + LWORK_SGEBRD_MM ) + MAXWRK = MAX( WRKBL, BDSPAC + M ) MINWRK = BDSPAC + M ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * - WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'SORGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) + WRKBL = M + LWORK_SGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_SORGLQ_MN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + 2*M*M MINWRK = BDSPAC + 2*M*M + 3*M ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') +* Path 3t (N >> M, JOBZ='S') * - WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'SORGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) + WRKBL = M + LWORK_SGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_SORGLQ_MN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*M MINWRK = BDSPAC + M*M + 3*M ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * - WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'SORGLQ', ' ', N, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) + WRKBL = M + LWORK_SGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_SORGLQ_NN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*M - MINWRK = BDSPAC + M*M + 3*M + MINWRK = M*M + MAX( 3*M + BDSPAC, M + N ) END IF ELSE * -* Path 5t (N greater than M, but not much larger) +* Path 5t (N > M, but not much larger) * - WRKBL = 3*M + ( M+N )*ILAENV( 1, 'SGEBRD', ' ', M, N, -1, - $ -1 ) + WRKBL = 3*M + LWORK_SGEBRD_MN IF( WNTQN ) THEN - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5tn (N > M, jobz='N') + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) ELSE IF( WNTQO ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', M, N, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) +* Path 5to (N > M, jobz='O') + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_MN ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*N - MINWRK = 3*M + MAX( N, M*M+BDSPAC ) + MINWRK = 3*M + MAX( N, M*M + BDSPAC ) ELSE IF( WNTQS ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', M, N, M, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5ts (N > M, jobz='S') + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_MN ) + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) ELSE IF( WNTQA ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, M, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5ta (N > M, jobz='A') + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) END IF END IF END IF + MAXWRK = MAX( MAXWRK, MINWRK ) WORK( 1 ) = MAXWRK * @@ -559,17 +618,18 @@ * IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need 2*N, prefer N+N*NB) +* Workspace: need N [tau] + N [work] +* Workspace: prefer N [tau] + N*NB [work] * CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Zero out below R * @@ -580,7 +640,8 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* Workspace: need 3*N [e, tauq, taup] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + 2*N*NB [work] * CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -588,14 +649,14 @@ NWORK = IE + N * * Perform bidiagonal SVD, computing singular values only -* (Workspace: need N+BDSPAC) +* Workspace: need N [e] + BDSPAC * CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ = 'O') +* Path 2 (M >> N, JOBZ = 'O') * N left singular vectors to be overwritten on A and * N right singular vectors to be computed in VT * @@ -603,42 +664,45 @@ * * WORK(IR) is LDWRKR by N * - IF( LWORK.GE.LDA*N+N*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. LDA*N + N*N + 3*N + BDSPAC ) THEN LDWRKR = LDA ELSE - LDWRKR = ( LWORK-N*N-3*N-BDSPAC ) / N + LDWRKR = ( LWORK - N*N - 3*N - BDSPAC ) / N END IF ITAU = IR + LDWRKR*N NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy R to WORK(IR), zeroing out below it * CALL SLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ), + CALL SLASET( 'L', N - 1, N - 1, ZERO, ZERO, WORK(IR+1), $ LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + N ITAUP = ITAUQ + N NWORK = ITAUP + N * -* Bidiagonalize R in VT, copying result to WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Bidiagonalize R in WORK(IR) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * WORK(IU) is N by N * @@ -648,7 +712,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -656,21 +720,23 @@ * * Overwrite WORK(IU) by left singular vectors of R * and VT by right singular vectors of R -* (Workspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IU ), N, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of R in * WORK(IU), storing result in WORK(IR) and copying to A -* (Workspace: need 2*N*N, prefer N*N+M*N) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] +* Workspace: prefer M*N [R] + 3*N [e, tauq, taup] + N*N [U] * DO 10 I = 1, M, LDWRKR - CHUNK = MIN( M-I+1, LDWRKR ) + CHUNK = MIN( M - I + 1, LDWRKR ) CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), $ LDA, WORK( IU ), N, ZERO, WORK( IR ), $ LDWRKR ) @@ -680,7 +746,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * N left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -693,38 +759,41 @@ NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy R to WORK(IR), zeroing out below it * CALL SLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ), + CALL SLASET( 'L', N - 1, N - 1, ZERO, ZERO, WORK(IR+1), $ LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + N ITAUP = ITAUQ + N NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagoal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -732,19 +801,20 @@ * * Overwrite U by left singular vectors of R and VT * by right singular vectors of R -* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * CALL SORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in U -* (Workspace: need N*N) +* Workspace: need N*N [R] * CALL SLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR ) CALL SGEMM( 'N', 'N', M, N, N, ONE, A, LDA, WORK( IR ), @@ -752,7 +822,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * M left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -765,16 +835,18 @@ NWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* Workspace: need N*N [U] + N [tau] + N [work] +* Workspace: prefer N*N [U] + N [tau] + N*NB [work] * CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* Workspace: need N*N [U] + N [tau] + M [work] +* Workspace: prefer N*N [U] + N [tau] + M*NB [work] CALL SORGQR( M, M, N, U, LDU, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Produce R in A, zeroing out other entries * @@ -785,7 +857,8 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [U] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -794,7 +867,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -802,18 +875,19 @@ * * Overwrite WORK(IU) by left singular vectors of R and VT * by right singular vectors of R -* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [U] + 3*N [e, tauq, taup] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', N, N, N, A, LDA, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in U by left singular vectors of R in * WORK(IU), storing result in A -* (Workspace: need N*N) +* Workspace: need N*N [U] * CALL SGEMM( 'N', 'N', M, N, N, ONE, U, LDU, WORK( IU ), $ LDWRKU, ZERO, A, LDA ) @@ -828,7 +902,7 @@ * * M .LT. MNTHR * -* Path 5 (M at least N, but not much larger) +* Path 5 (M >= N, but not much larger) * Reduce to bidiagonal form without QR decomposition * IE = 1 @@ -837,21 +911,24 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) +* Workspace: need 3*N [e, tauq, taup] + M [work] +* Workspace: prefer 3*N [e, tauq, taup] + (M+N)*NB [work] * CALL SGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5n (M >= N, JOBZ='N') * Perform bidiagonal SVD, only computing singular values -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 5o (M >= N, JOBZ='O') IU = NWORK - IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*N + BDSPAC ) THEN * * WORK( IU ) is M by N * @@ -859,6 +936,8 @@ NWORK = IU + LDWRKU*N CALL SLASET( 'F', M, N, ZERO, ZERO, WORK( IU ), $ LDWRKU ) +* IR is unused; silence compile warnings + IR = -1 ELSE * * WORK( IU ) is N by N @@ -869,53 +948,59 @@ * WORK(IR) is LDWRKR by N * IR = NWORK - LDWRKR = ( LWORK-N*N-3*N ) / N + LDWRKR = ( LWORK - N*N - 3*N ) / N END IF NWORK = IU + LDWRKU*N * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), $ LDWRKU, VT, LDVT, DUM, IDUM, WORK( NWORK ), $ IWORK, INFO ) * * Overwrite VT by right singular vectors of A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL SORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * - IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*N + BDSPAC ) THEN * +* Path 5o-fast * Overwrite WORK(IU) by left singular vectors of A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + M*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + M*N [U] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Copy left singular vectors of A from WORK(IU) to A * CALL SLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) ELSE * +* Path 5o-slow * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL SORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of * bidiagonal matrix in WORK(IU), storing result in * WORK(IR) and copying to A -* (Workspace: need 2*N*N, prefer N*N+M*N) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + NB*N [R] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + M*N [R] * DO 20 I = 1, M, LDWRKR - CHUNK = MIN( M-I+1, LDWRKR ) + CHUNK = MIN( M - I + 1, LDWRKR ) CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), $ LDA, WORK( IU ), LDWRKU, ZERO, $ WORK( IR ), LDWRKR ) @@ -926,10 +1011,11 @@ * ELSE IF( WNTQS ) THEN * +* Path 5s (M >= N, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL SLASET( 'F', M, N, ZERO, ZERO, U, LDU ) CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, @@ -938,20 +1024,22 @@ * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 3*N, prefer 2*N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) ELSE IF( WNTQA ) THEN * +* Path 5a (M >= N, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL SLASET( 'F', M, M, ZERO, ZERO, U, LDU ) CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, @@ -961,20 +1049,21 @@ * Set the right corner of U to identity matrix * IF( M.GT.N ) THEN - CALL SLASET( 'F', M-N, M-N, ZERO, ONE, U( N+1, N+1 ), + CALL SLASET( 'F', M - N, M - N, ZERO, ONE, U(N+1,N+1), $ LDU ) END IF * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need N*N+2*N+M, prefer N*N+2*N+M*NB) +* Workspace: need 3*N [e, tauq, taup] + M [work] +* Workspace: prefer 3*N [e, tauq, taup] + M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', N, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) END IF * END IF @@ -989,17 +1078,18 @@ * IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M, prefer M+M*NB) +* Workspace: need M [tau] + M [work] +* Workspace: prefer M [tau] + M*NB [work] * CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Zero out above L * @@ -1010,7 +1100,8 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* Workspace: need 3*M [e, tauq, taup] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + 2*M*NB [work] * CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1018,68 +1109,69 @@ NWORK = IE + M * * Perform bidiagonal SVD, computing singular values only -* (Workspace: need M+BDSPAC) +* Workspace: need M [e] + BDSPAC * CALL SBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * M right singular vectors to be overwritten on A and * M left singular vectors to be computed in U * IVT = 1 * -* IVT is M by M +* WORK(IVT) is M by M +* WORK(IL) is M by M; it is later resized to M by chunk for gemm * IL = IVT + M*M - IF( LWORK.GE.M*N+M*M+3*M+BDSPAC ) THEN -* -* WORK(IL) is M by N -* + IF( LWORK .GE. M*N + M*M + 3*M + BDSPAC ) THEN LDWRKL = M CHUNK = N ELSE LDWRKL = M - CHUNK = ( LWORK-M*M ) / M + CHUNK = ( LWORK - M*M ) / M END IF ITAU = IL + LDWRKL*M NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] * CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing about above it * CALL SLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL ) - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, - $ WORK( IL+LDWRKL ), LDWRKL ) + CALL SLASET( 'U', M - 1, M - 1, ZERO, ZERO, + $ WORK( IL + LDWRKL ), LDWRKL ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] * CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + M ITAUP = ITAUQ + M NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL SGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U, and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M+M*M+BDSPAC) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), M, DUM, IDUM, WORK( NWORK ), @@ -1087,21 +1179,24 @@ * * Overwrite U by left singular vectors of L and WORK(IVT) * by right singular vectors of L -* (Workspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUP ), WORK( IVT ), M, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IVT) by Q * in A, storing result in WORK(IL) and copying to A -* (Workspace: need 2*M*M, prefer M*M+M*N) +* Workspace: need M*M [VT] + M*M [L] +* Workspace: prefer M*M [VT] + M*N [L] +* At this point, L is resized as M by chunk. * DO 30 I = 1, N, CHUNK - BLK = MIN( N-I+1, CHUNK ) + BLK = MIN( N - I + 1, CHUNK ) CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), M, $ A( 1, I ), LDA, ZERO, WORK( IL ), LDWRKL ) CALL SLACPY( 'F', M, BLK, WORK( IL ), LDWRKL, @@ -1110,7 +1205,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') +* Path 3t (N >> M, JOBZ='S') * M right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1123,38 +1218,41 @@ NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [L] + M [tau] + M*NB [work] * CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing out above it * CALL SLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL ) - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, - $ WORK( IL+LDWRKL ), LDWRKL ) + CALL SLASET( 'U', M - 1, M - 1, ZERO, ZERO, + $ WORK( IL + LDWRKL ), LDWRKL ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [L] + M [tau] + M*NB [work] * CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + M ITAUP = ITAUQ + M NWORK = ITAUP + M * -* Bidiagonalize L in WORK(IU), copying result to U -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Bidiagonalize L in WORK(IU). +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [L] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL SGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, VT, $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -1162,18 +1260,19 @@ * * Overwrite U by left singular vectors of L and VT * by right singular vectors of L -* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB) +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [L] + 3*M [e, tauq, taup] + M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IL) by * Q in A, storing result in VT -* (Workspace: need M*M) +* Workspace: need M*M [L] * CALL SLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL ) CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IL ), LDWRKL, @@ -1181,7 +1280,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * N right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1194,17 +1293,19 @@ NWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M [tau] + M*NB [work] * CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M [tau] + N [work] +* Workspace: prefer M*M [VT] + M [tau] + N*NB [work] * CALL SORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Produce L in A, zeroing out other entries * @@ -1215,7 +1316,8 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1224,7 +1326,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M+M*M+BDSPAC) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), LDWKVT, DUM, IDUM, @@ -1232,18 +1334,19 @@ * * Overwrite U by left singular vectors of L and WORK(IVT) * by right singular vectors of L -* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup]+ M [work] +* Workspace: prefer M*M [VT] + 3*M [e, tauq, taup]+ M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, M, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', M, M, M, A, LDA, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IVT) by * Q in VT, storing result in A -* (Workspace: need M*M) +* Workspace: need M*M [VT] * CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IVT ), LDWKVT, $ VT, LDVT, ZERO, A, LDA ) @@ -1258,7 +1361,7 @@ * * N .LT. MNTHR * -* Path 5t (N greater than M, but not much larger) +* Path 5t (N > M, but not much larger) * Reduce to bidiagonal form without LQ decomposition * IE = 1 @@ -1267,28 +1370,33 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) +* Workspace: need 3*M [e, tauq, taup] + N [work] +* Workspace: prefer 3*M [e, tauq, taup] + (M+N)*NB [work] * CALL SGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5tn (N > M, JOBZ='N') * Perform bidiagonal SVD, only computing singular values -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'L', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 5to (N > M, JOBZ='O') LDWKVT = M IVT = NWORK - IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*M + BDSPAC ) THEN * * WORK( IVT ) is M by N * CALL SLASET( 'F', M, N, ZERO, ZERO, WORK( IVT ), $ LDWKVT ) NWORK = IVT + LDWKVT*N +* IL is unused; silence compile warnings + IL = -1 ELSE * * WORK( IVT ) is M by M @@ -1298,52 +1406,58 @@ * * WORK(IL) is M by CHUNK * - CHUNK = ( LWORK-M*M-3*M ) / M + CHUNK = ( LWORK - M*M - 3*M ) / M END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M*M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + BDSPAC * CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), LDWKVT, DUM, IDUM, $ WORK( NWORK ), IWORK, INFO ) * * Overwrite U by left singular vectors of A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * - IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*M + BDSPAC ) THEN * +* Path 5to-fast * Overwrite WORK(IVT) by left singular vectors of A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*N [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*N [VT] + M*NB [work] * CALL SORMBR( 'P', 'R', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Copy right singular vectors of A from WORK(IVT) to A * CALL SLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) ELSE * +* Path 5to-slow * Generate P**T in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*NB [work] * CALL SORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply Q in A by right singular vectors of * bidiagonal matrix in WORK(IVT), storing result in * WORK(IL) and copying to A -* (Workspace: need 2*M*M, prefer M*M+M*N) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M*NB [L] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*N [L] * DO 40 I = 1, N, CHUNK - BLK = MIN( N-I+1, CHUNK ) + BLK = MIN( N - I + 1, CHUNK ) CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), $ LDWKVT, A( 1, I ), LDA, ZERO, $ WORK( IL ), M ) @@ -1353,10 +1467,11 @@ END IF ELSE IF( WNTQS ) THEN * +* Path 5ts (N > M, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL SLASET( 'F', M, N, ZERO, ZERO, VT, LDVT ) CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT, @@ -1365,20 +1480,22 @@ * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 3*M, prefer 2*M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) ELSE IF( WNTQA ) THEN * +* Path 5ta (N > M, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL SLASET( 'F', N, N, ZERO, ZERO, VT, LDVT ) CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT, @@ -1388,20 +1505,21 @@ * Set the right corner of VT to identity matrix * IF( N.GT.M ) THEN - CALL SLASET( 'F', N-M, N-M, ZERO, ONE, VT( M+1, M+1 ), + CALL SLASET( 'F', N-M, N-M, ZERO, ONE, VT(M+1,M+1), $ LDVT ) END IF * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 2*M+N, prefer 2*M+N*NB) +* Workspace: need 3*M [e, tauq, taup] + N [work] +* Workspace: prefer 3*M [e, tauq, taup] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', N, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) END IF * END IF diff --git a/lapack-netlib/SRC/sgesvd.f b/lapack-netlib/SRC/sgesvd.f index 263548b07..4e37528ba 100644 --- a/lapack-netlib/SRC/sgesvd.f +++ b/lapack-netlib/SRC/sgesvd.f @@ -211,7 +211,7 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, $ WORK, LWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.1) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -314,24 +314,24 @@ BDSPAC = 5*N * Compute space needed for SGEQRF CALL SGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_SGEQRF=DUM(1) + LWORK_SGEQRF = INT( DUM(1) ) * Compute space needed for SORGQR CALL SORGQR( M, N, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_SORGQR_N=DUM(1) + LWORK_SORGQR_N = INT( DUM(1) ) CALL SORGQR( M, M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_SORGQR_M=DUM(1) + LWORK_SORGQR_M = INT( DUM(1) ) * Compute space needed for SGEBRD CALL SGEBRD( N, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_SGEBRD=DUM(1) + LWORK_SGEBRD = INT( DUM(1) ) * Compute space needed for SORGBR P CALL SORGBR( 'P', N, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_P=DUM(1) + LWORK_SORGBR_P = INT( DUM(1) ) * Compute space needed for SORGBR Q CALL SORGBR( 'Q', N, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_Q=DUM(1) + LWORK_SORGBR_Q = INT( DUM(1) ) * IF( M.GE.MNTHR ) THEN IF( WNTUN ) THEN @@ -447,18 +447,18 @@ * CALL SGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_SGEBRD=DUM(1) + LWORK_SGEBRD = INT( DUM(1) ) MAXWRK = 3*N + LWORK_SGEBRD IF( WNTUS .OR. WNTUO ) THEN CALL SORGBR( 'Q', M, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_Q=DUM(1) + LWORK_SORGBR_Q = INT( DUM(1) ) MAXWRK = MAX( MAXWRK, 3*N+LWORK_SORGBR_Q ) END IF IF( WNTUA ) THEN CALL SORGBR( 'Q', M, M, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_Q=DUM(1) + LWORK_SORGBR_Q = INT( DUM(1) ) MAXWRK = MAX( MAXWRK, 3*N+LWORK_SORGBR_Q ) END IF IF( .NOT.WNTVN ) THEN @@ -475,24 +475,24 @@ BDSPAC = 5*M * Compute space needed for SGELQF CALL SGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_SGELQF=DUM(1) + LWORK_SGELQF = INT( DUM(1) ) * Compute space needed for SORGLQ CALL SORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR ) - LWORK_SORGLQ_N=DUM(1) + LWORK_SORGLQ_N = INT( DUM(1) ) CALL SORGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_SORGLQ_M=DUM(1) + LWORK_SORGLQ_M = INT( DUM(1) ) * Compute space needed for SGEBRD CALL SGEBRD( M, M, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_SGEBRD=DUM(1) + LWORK_SGEBRD = INT( DUM(1) ) * Compute space needed for SORGBR P CALL SORGBR( 'P', M, M, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_P=DUM(1) + LWORK_SORGBR_P = INT( DUM(1) ) * Compute space needed for SORGBR Q CALL SORGBR( 'Q', M, M, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_Q=DUM(1) + LWORK_SORGBR_Q = INT( DUM(1) ) IF( N.GE.MNTHR ) THEN IF( WNTVN ) THEN * @@ -608,19 +608,19 @@ * CALL SGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_SGEBRD=DUM(1) + LWORK_SGEBRD = INT( DUM(1) ) MAXWRK = 3*M + LWORK_SGEBRD IF( WNTVS .OR. WNTVO ) THEN * Compute space needed for SORGBR P CALL SORGBR( 'P', M, N, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_P=DUM(1) + LWORK_SORGBR_P = INT( DUM(1) ) MAXWRK = MAX( MAXWRK, 3*M+LWORK_SORGBR_P ) END IF IF( WNTVA ) THEN CALL SORGBR( 'P', N, N, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_P=DUM(1) + LWORK_SORGBR_P = INT( DUM(1) ) MAXWRK = MAX( MAXWRK, 3*M+LWORK_SORGBR_P ) END IF IF( .NOT.WNTUN ) THEN @@ -693,7 +693,10 @@ * * Zero out below R * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) + END IF IE = 1 ITAUQ = IE + N ITAUP = ITAUQ + N @@ -1122,8 +1125,10 @@ * * Zero out below R in A * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (Workspace: need 4*N, prefer 3*N+2*N*NB) @@ -1285,8 +1290,10 @@ * * Zero out below R in A * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (Workspace: need 4*N, prefer 3*N+2*N*NB) @@ -1588,8 +1595,10 @@ * * Zero out below R in A * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (Workspace: need 4*N, prefer 3*N+2*N*NB) @@ -1756,8 +1765,10 @@ * * Zero out below R in A * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (Workspace: need 4*N, prefer 3*N+2*N*NB) diff --git a/lapack-netlib/SRC/sgesvdx.f b/lapack-netlib/SRC/sgesvdx.f index aae8b0764..8a2fc9b0c 100644 --- a/lapack-netlib/SRC/sgesvdx.f +++ b/lapack-netlib/SRC/sgesvdx.f @@ -123,13 +123,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL -*> VL >=0. +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -137,13 +139,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -169,7 +175,7 @@ *> vectors, stored columnwise) as specified by RANGE; if *> JOBU = 'N', U is not referenced. *> Note: The user must ensure that UCOL >= NS; if RANGE = 'V', -*> the exact value of NS is not known ILQFin advance and an upper +*> the exact value of NS is not known in advance and an upper *> bound must be used. *> \endverbatim *> @@ -248,7 +254,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realGEsing * @@ -257,10 +263,10 @@ $ IL, IU, NS, S, U, LDU, VT, LDVT, WORK, $ LWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU, JOBVT, RANGE @@ -357,8 +363,14 @@ IF( INFO.EQ.0 ) THEN IF( WANTU .AND. LDU.LT.M ) THEN INFO = -15 - ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN - INFO = -16 + ELSE IF( WANTVT ) THEN + IF( INDS ) THEN + IF( LDVT.LT.IU-IL+1 ) THEN + INFO = -17 + END IF + ELSE IF( LDVT.LT.MINMN ) THEN + INFO = -17 + END IF END IF END IF END IF @@ -380,18 +392,34 @@ * * Path 1 (M much larger than N) * - MAXWRK = N*(N*2+16) + + MAXWRK = N + $ N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, N*(N*2+20) + 2*N* + MAXWRK = MAX( MAXWRK, N*(N+5) + 2*N* $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - MINWRK = N*(N*2+21) + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,N*(N*3+6)+N* + $ ILAENV( 1, 'SORMQR', ' ', N, N, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,N*(N*3+6)+N* + $ ILAENV( 1, 'SORMLQ', ' ', N, N, -1, -1 ) ) + END IF + MINWRK = N*(N*3+20) ELSE * * Path 2 (M at least N, but not much larger) * - MAXWRK = N*(N*2+19) + ( M+N )* + MAXWRK = 4*N + ( M+N )* $ ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 ) - MINWRK = N*(N*2+20) + M + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,N*(N*2+5)+N* + $ ILAENV( 1, 'SORMQR', ' ', N, N, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,N*(N*2+5)+N* + $ ILAENV( 1, 'SORMLQ', ' ', N, N, -1, -1 ) ) + END IF + MINWRK = MAX(N*(N*2+19),4*N+M) END IF ELSE MNTHR = ILAENV( 6, 'SGESVD', JOBU // JOBVT, M, N, 0, 0 ) @@ -399,18 +427,34 @@ * * Path 1t (N much larger than M) * - MAXWRK = M*(M*2+16) + + MAXWRK = M + $ M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, M*(M*2+20) + 2*M* + MAXWRK = MAX( MAXWRK, M*(M+5) + 2*M* $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) ) - MINWRK = M*(M*2+21) + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,M*(M*3+6)+M* + $ ILAENV( 1, 'SORMQR', ' ', M, M, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,M*(M*3+6)+M* + $ ILAENV( 1, 'SORMLQ', ' ', M, M, -1, -1 ) ) + END IF + MINWRK = M*(M*3+20) ELSE * -* Path 2t (N greater than M, but not much larger) +* Path 2t (N at least M, but not much larger) * - MAXWRK = M*(M*2+19) + ( M+N )* + MAXWRK = 4*M + ( M+N )* $ ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 ) - MINWRK = M*(M*2+20) + N + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,M*(M*2+5)+M* + $ ILAENV( 1, 'SORMQR', ' ', M, M, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,M*(M*2+5)+M* + $ ILAENV( 1, 'SORMLQ', ' ', M, M, -1, -1 ) ) + END IF + MINWRK = MAX(M*(M*2+19),4*M+N) END IF END IF END IF @@ -522,7 +566,7 @@ CALL SCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL SLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU ) + CALL SLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU ) * * Call SORMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -591,7 +635,7 @@ CALL SCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL SLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU ) + CALL SLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU ) * * Call SORMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -687,7 +731,7 @@ CALL SCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL SLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT ) + CALL SLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT) * * Call SORMBR to compute (VB**T)*(PB**T) * (Workspace in WORK( ITEMP ): need M, prefer M*NB) @@ -756,7 +800,7 @@ CALL SCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL SLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT ) + CALL SLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT) * * Call SORMBR to compute VB**T * PB**T * (Workspace in WORK( ITEMP ): need M, prefer M*NB) diff --git a/lapack-netlib/SRC/sgetc2.f b/lapack-netlib/SRC/sgetc2.f index 598446519..ce6a5b392 100644 --- a/lapack-netlib/SRC/sgetc2.f +++ b/lapack-netlib/SRC/sgetc2.f @@ -98,7 +98,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup realGEauxiliary * @@ -111,10 +111,10 @@ * ===================================================================== SUBROUTINE SGETC2( N, A, LDA, IPIV, JPIV, INFO ) * -* -- LAPACK auxiliary routine (version 3.5.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, N diff --git a/lapack-netlib/SRC/sgetrf2.f b/lapack-netlib/SRC/sgetrf2.f index 068710b77..02b6c3454 100644 --- a/lapack-netlib/SRC/sgetrf2.f +++ b/lapack-netlib/SRC/sgetrf2.f @@ -37,7 +37,7 @@ *> the matrix into four submatrices: *> *> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2 -*> A = [ -----|----- ] with n1 = min(m,n) +*> A = [ -----|----- ] with n1 = min(m,n)/2 * [ A21 | A22 ] n2 = n-n1 *> *> [ A11 ] @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realGEcomputational * * ===================================================================== RECURSIVE SUBROUTINE SGETRF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/sgghd3.f b/lapack-netlib/SRC/sgghd3.f index 3c58aea78..758f4b5c7 100644 --- a/lapack-netlib/SRC/sgghd3.f +++ b/lapack-netlib/SRC/sgghd3.f @@ -230,7 +230,7 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -277,7 +277,7 @@ * INFO = 0 NB = ILAENV( 1, 'SGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = 6*N*NB + LWKOPT = MAX( 6*N*NB, 1 ) WORK( 1 ) = REAL( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) diff --git a/lapack-netlib/SRC/sggsvp3.f b/lapack-netlib/SRC/sggsvp3.f index f54962462..595afab13 100644 --- a/lapack-netlib/SRC/sggsvp3.f +++ b/lapack-netlib/SRC/sggsvp3.f @@ -220,7 +220,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> WORK is REAL array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -272,7 +272,7 @@ $ TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, $ IWORK, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * August 2015 diff --git a/lapack-netlib/SRC/shgeqz.f b/lapack-netlib/SRC/shgeqz.f index 254e65fcf..6d55c5563 100644 --- a/lapack-netlib/SRC/shgeqz.f +++ b/lapack-netlib/SRC/shgeqz.f @@ -211,12 +211,12 @@ *> \param[in,out] Q *> \verbatim *> Q is REAL array, dimension (LDQ, N) -*> On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in +*> On entry, if COMPQ = 'V', the orthogonal matrix Q1 used in *> the reduction of (A,B) to generalized Hessenberg form. -*> On exit, if COMPZ = 'I', the orthogonal matrix of left Schur -*> vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix +*> On exit, if COMPQ = 'I', the orthogonal matrix of left Schur +*> vectors of (H,T), and if COMPQ = 'V', the orthogonal matrix *> of left Schur vectors of (A,B). -*> Not referenced if COMPZ = 'N'. +*> Not referenced if COMPQ = 'N'. *> \endverbatim *> *> \param[in] LDQ @@ -282,7 +282,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup realGEcomputational * @@ -304,10 +304,10 @@ $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, $ LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER COMPQ, COMPZ, JOB diff --git a/lapack-netlib/SRC/slaed1.f b/lapack-netlib/SRC/slaed1.f index 74eeb6330..c6f52d0fd 100644 --- a/lapack-netlib/SRC/slaed1.f +++ b/lapack-netlib/SRC/slaed1.f @@ -54,7 +54,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine SLAED2. *> @@ -148,7 +148,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -163,10 +163,10 @@ SUBROUTINE SLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER CUTPNT, INFO, LDQ, N diff --git a/lapack-netlib/SRC/slaed7.f b/lapack-netlib/SRC/slaed7.f index 3d3d62928..f6615e039 100644 --- a/lapack-netlib/SRC/slaed7.f +++ b/lapack-netlib/SRC/slaed7.f @@ -59,7 +59,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine SLAED8. *> @@ -244,7 +244,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -260,10 +260,10 @@ $ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N, diff --git a/lapack-netlib/SRC/slag2.f b/lapack-netlib/SRC/slag2.f index ad04333a0..da18f6b23 100644 --- a/lapack-netlib/SRC/slag2.f +++ b/lapack-netlib/SRC/slag2.f @@ -99,7 +99,7 @@ *> will always be positive. If the eigenvalues are real, then *> the first (real) eigenvalue is WR1 / SCALE1 , but this may *> overflow or underflow, and in fact, SCALE1 may be zero or -*> less than the underflow threshhold if the exact eigenvalue +*> less than the underflow threshold if the exact eigenvalue *> is sufficiently large. *> \endverbatim *> @@ -112,7 +112,7 @@ *> eigenvalues are real, then the second (real) eigenvalue is *> WR2 / SCALE2 , but this may overflow or underflow, and in *> fact, SCALE2 may be zero or less than the underflow -*> threshhold if the exact eigenvalue is sufficiently large. +*> threshold if the exact eigenvalue is sufficiently large. *> \endverbatim *> *> \param[out] WR1 @@ -148,7 +148,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realOTHERauxiliary * @@ -156,10 +156,10 @@ SUBROUTINE SLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, $ WR2, WI ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB @@ -266,8 +266,8 @@ * Note: the test of R in the following IF is to cover the case when * DISCR is small and negative and is flushed to zero during * the calculation of R. On machines which have a consistent -* flush-to-zero threshhold and handle numbers above that -* threshhold correctly, it would not be necessary. +* flush-to-zero threshold and handle numbers above that +* threshold correctly, it would not be necessary. * IF( DISCR.GE.ZERO .OR. R.EQ.ZERO ) THEN SUM = PP + SIGN( R, PP ) diff --git a/lapack-netlib/SRC/slamrg.f b/lapack-netlib/SRC/slamrg.f index 6229abd6a..7f171cbe9 100644 --- a/lapack-netlib/SRC/slamrg.f +++ b/lapack-netlib/SRC/slamrg.f @@ -50,7 +50,7 @@ *> \param[in] N2 *> \verbatim *> N2 is INTEGER -*> These arguements contain the respective lengths of the two +*> These arguments contain the respective lengths of the two *> sorted lists to be merged. *> \endverbatim *> @@ -92,17 +92,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE SLAMRG( N1, N2, A, STRD1, STRD2, INDEX ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER N1, N2, STRD1, STRD2 diff --git a/lapack-netlib/SRC/slaqr3.f b/lapack-netlib/SRC/slaqr3.f index 150febd43..b80b27af5 100644 --- a/lapack-netlib/SRC/slaqr3.f +++ b/lapack-netlib/SRC/slaqr3.f @@ -138,7 +138,7 @@ *> Z is REAL array, dimension (LDZ,N) *> IF WANTZ is .TRUE., then on output, the orthogonal *> similarity transformation mentioned above has been -*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> accumulated into Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ is .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -260,7 +260,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realOTHERauxiliary * @@ -275,10 +275,10 @@ $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T, $ LDT, NV, WV, LDWV, WORK, LWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, diff --git a/lapack-netlib/SRC/slaqr5.f b/lapack-netlib/SRC/slaqr5.f index 6a2997417..d9ed7922d 100644 --- a/lapack-netlib/SRC/slaqr5.f +++ b/lapack-netlib/SRC/slaqr5.f @@ -150,10 +150,10 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is REAL array of size (LDZ,IHI) +*> Z is REAL array of size (LDZ,IHIZ) *> If WANTZ = .TRUE., then the QR Sweep orthogonal *> similarity transformation is accumulated into -*> Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ = .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -236,7 +236,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realOTHERauxiliary * @@ -259,10 +259,10 @@ $ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, $ LDU, NV, WV, LDWV, NH, WH, LDWH ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, diff --git a/lapack-netlib/SRC/slarrc.f b/lapack-netlib/SRC/slarrc.f index 7812ca553..ec9c252c2 100644 --- a/lapack-netlib/SRC/slarrc.f +++ b/lapack-netlib/SRC/slarrc.f @@ -59,25 +59,26 @@ *> *> \param[in] VL *> \verbatim -*> VL is DOUBLE PRECISION +*> VL is REAL +*> The lower bound for the eigenvalues. *> \endverbatim *> *> \param[in] VU *> \verbatim -*> VU is DOUBLE PRECISION -*> The lower and upper bounds for the eigenvalues. +*> VU is REAL +*> The upper bound for the eigenvalues. *> \endverbatim *> *> \param[in] D *> \verbatim -*> D is DOUBLE PRECISION array, dimension (N) +*> D is REAL array, dimension (N) *> JOBT = 'T': The N diagonal elements of the tridiagonal matrix T. *> JOBT = 'L': The N diagonal elements of the diagonal matrix D. *> \endverbatim *> *> \param[in] E *> \verbatim -*> E is DOUBLE PRECISION array, dimension (N) +*> E is REAL array, dimension (N) *> JOBT = 'T': The N-1 offdiagonal elements of the matrix T. *> JOBT = 'L': The N-1 offdiagonal elements of the matrix L. *> \endverbatim @@ -119,7 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -136,10 +137,10 @@ SUBROUTINE SLARRC( JOBT, N, VL, VU, D, E, PIVMIN, $ EIGCNT, LCNT, RCNT, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBT diff --git a/lapack-netlib/SRC/slarrd.f b/lapack-netlib/SRC/slarrd.f index 7d17210c3..5ac428e2a 100644 --- a/lapack-netlib/SRC/slarrd.f +++ b/lapack-netlib/SRC/slarrd.f @@ -92,12 +92,16 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. Eigenvalues less than or equal +*> to VL, or greater than VU, will not be returned. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. Eigenvalues less than or equal *> to VL, or greater than VU, will not be returned. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. @@ -106,13 +110,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -311,7 +319,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -321,10 +329,10 @@ $ M, W, WERR, WL, WU, IBLOCK, INDEXW, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER ORDER, RANGE diff --git a/lapack-netlib/SRC/slarre.f b/lapack-netlib/SRC/slarre.f index a5b9f2fd6..bf56986c0 100644 --- a/lapack-netlib/SRC/slarre.f +++ b/lapack-netlib/SRC/slarre.f @@ -78,12 +78,17 @@ *> \param[in,out] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound for the eigenvalues. +*> Eigenvalues less than or equal to VL, or greater than VU, +*> will not be returned. VL < VU. +*> If RANGE='I' or ='A', SLARRE computes bounds on the desired +*> part of the spectrum. *> \endverbatim *> *> \param[in,out] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds for the eigenvalues. +*> If RANGE='V', the upper bound for the eigenvalues. *> Eigenvalues less than or equal to VL, or greater than VU, *> will not be returned. VL < VU. *> If RANGE='I' or ='A', SLARRE computes bounds on the desired @@ -93,13 +98,16 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N. *> \endverbatim *> @@ -244,7 +252,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> > 0: A problem occured in SLARRE. +*> > 0: A problem occurred in SLARRE. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -268,7 +276,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -297,10 +305,10 @@ $ W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER RANGE diff --git a/lapack-netlib/SRC/slarrf.f b/lapack-netlib/SRC/slarrf.f index 058e5027c..f686018d1 100644 --- a/lapack-netlib/SRC/slarrf.f +++ b/lapack-netlib/SRC/slarrf.f @@ -51,7 +51,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix (subblock, if the matrix splitted). +*> The order of the matrix (subblock, if the matrix split). *> \endverbatim *> *> \param[in] D @@ -174,7 +174,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -193,10 +193,10 @@ $ SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA, $ DPLUS, LPLUS, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER CLSTRT, CLEND, INFO, N diff --git a/lapack-netlib/SRC/slarrv.f b/lapack-netlib/SRC/slarrv.f index 73847f394..b098c3d11 100644 --- a/lapack-netlib/SRC/slarrv.f +++ b/lapack-netlib/SRC/slarrv.f @@ -59,12 +59,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> Lower bound of the interval that contains the desired +*> eigenvalues. VL < VU. Needed to compute gaps on the left or right +*> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> Lower and upper bounds of the interval that contains the desired +*> Upper bound of the interval that contains the desired *> eigenvalues. VL < VU. Needed to compute gaps on the left or right *> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim @@ -81,7 +84,7 @@ *> L is REAL array, dimension (N) *> On entry, the (N-1) subdiagonal elements of the unit *> bidiagonal matrix L are in elements 1 to N-1 of L -*> (if the matrix is not splitted.) At the end of each block +*> (if the matrix is not split.) At the end of each block *> is stored the corresponding shift as given by SLARRE. *> On exit, L is overwritten. *> \endverbatim @@ -236,7 +239,7 @@ *> INFO is INTEGER *> = 0: successful exit *> -*> > 0: A problem occured in SLARRV. +*> > 0: A problem occurred in SLARRV. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -263,7 +266,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHERauxiliary * @@ -283,10 +286,10 @@ $ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER DOL, DOU, INFO, LDZ, M, N diff --git a/lapack-netlib/SRC/slarscl2.f b/lapack-netlib/SRC/slarscl2.f index df7ede2c8..3f51d722d 100644 --- a/lapack-netlib/SRC/slarscl2.f +++ b/lapack-netlib/SRC/slarscl2.f @@ -72,7 +72,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -83,17 +83,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHERcomputational * * ===================================================================== SUBROUTINE SLARSCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/slascl.f b/lapack-netlib/SRC/slascl.f index bacf86ed4..d67ea0f09 100644 --- a/lapack-netlib/SRC/slascl.f +++ b/lapack-netlib/SRC/slascl.f @@ -114,7 +114,11 @@ *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). +*> The leading dimension of the array A. +*> If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M); +*> TYPE = 'B', LDA >= KL+1; +*> TYPE = 'Q', LDA >= KU+1; +*> TYPE = 'Z', LDA >= 2*KL+KU+1. *> \endverbatim *> *> \param[out] INFO @@ -132,17 +136,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * * ===================================================================== SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER TYPE diff --git a/lapack-netlib/SRC/slascl2.f b/lapack-netlib/SRC/slascl2.f index a44a3c8fd..bb2f960b8 100644 --- a/lapack-netlib/SRC/slascl2.f +++ b/lapack-netlib/SRC/slascl2.f @@ -72,7 +72,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -83,17 +83,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHERcomputational * * ===================================================================== SUBROUTINE SLASCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/slasd1.f b/lapack-netlib/SRC/slasd1.f index ae076a0f5..63d878be5 100644 --- a/lapack-netlib/SRC/slasd1.f +++ b/lapack-netlib/SRC/slasd1.f @@ -60,7 +60,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple singular values or when there are zeros in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine SLASD2. *> @@ -156,7 +156,7 @@ *> The leading dimension of the array VT. LDVT >= max( 1, M ). *> \endverbatim *> -*> \param[out] IDXQ +*> \param[in,out] IDXQ *> \verbatim *> IDXQ is INTEGER array, dimension (N) *> This contains the permutation which will reintegrate the @@ -190,7 +190,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -204,10 +204,10 @@ SUBROUTINE SLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, $ IDXQ, IWORK, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDU, LDVT, NL, NR, SQRE diff --git a/lapack-netlib/SRC/slasd6.f b/lapack-netlib/SRC/slasd6.f index f79a06d03..9f31e6ccf 100644 --- a/lapack-netlib/SRC/slasd6.f +++ b/lapack-netlib/SRC/slasd6.f @@ -74,7 +74,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple singular values or if there is a zero -*> in the Z vector. For each such occurence the dimension of the +*> 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 SLASD7. *> @@ -232,14 +232,13 @@ *> \param[out] DIFR *> \verbatim *> DIFR is REAL array, -*> dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and -*> dimension ( N ) if ICOMPQ = 0. -*> On exit, DIFR(I, 1) is the distance between I-th updated -*> (undeflated) singular value and the I+1-th (undeflated) old -*> singular value. +*> dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and +*> dimension ( K ) if ICOMPQ = 0. +*> On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not +*> defined and will not be referenced. *> -*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the -*> normalizing factors for the right singular vector matrix. +*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the +*> normalizing factors for the right singular vector matrix. *> *> See SLASD8 for details on DIFL and DIFR. *> \endverbatim @@ -298,7 +297,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -314,10 +313,10 @@ $ LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, $ IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL, diff --git a/lapack-netlib/SRC/slasdq.f b/lapack-netlib/SRC/slasdq.f index 289ed855c..7b72fb98f 100644 --- a/lapack-netlib/SRC/slasdq.f +++ b/lapack-netlib/SRC/slasdq.f @@ -59,7 +59,7 @@ *> \verbatim *> UPLO is CHARACTER*1 *> On entry, UPLO specifies whether the input bidiagonal matrix -*> is upper or lower bidiagonal, and wether it is square are +*> is upper or lower bidiagonal, and whether it is square are *> not. *> UPLO = 'U' or 'u' B is upper bidiagonal. *> UPLO = 'L' or 'l' B is lower bidiagonal. @@ -197,7 +197,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -211,10 +211,10 @@ SUBROUTINE SLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, $ U, LDU, C, LDC, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/slasq3.f b/lapack-netlib/SRC/slasq3.f index 4187a943e..879fdfbbd 100644 --- a/lapack-netlib/SRC/slasq3.f +++ b/lapack-netlib/SRC/slasq3.f @@ -60,7 +60,7 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is REAL array, dimension ( 4*N ) +*> Z is REAL array, dimension ( 4*N0 ) *> Z holds the qd array. *> \endverbatim *> @@ -173,7 +173,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -182,10 +182,10 @@ $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, $ DN2, G, TAU ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. LOGICAL IEEE diff --git a/lapack-netlib/SRC/slasq4.f b/lapack-netlib/SRC/slasq4.f index bdd24f32c..1ad5a9118 100644 --- a/lapack-netlib/SRC/slasq4.f +++ b/lapack-netlib/SRC/slasq4.f @@ -56,7 +56,7 @@ *> *> \param[in] Z *> \verbatim -*> Z is REAL array, dimension ( 4*N ) +*> Z is REAL array, dimension ( 4*N0 ) *> Z holds the qd array. *> \endverbatim *> @@ -135,7 +135,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -151,10 +151,10 @@ SUBROUTINE SLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, $ DN1, DN2, TAU, TTYPE, G ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER I0, N0, N0IN, PP, TTYPE diff --git a/lapack-netlib/SRC/slasrt.f b/lapack-netlib/SRC/slasrt.f index e93c0d6db..d3aa12921 100644 --- a/lapack-netlib/SRC/slasrt.f +++ b/lapack-netlib/SRC/slasrt.f @@ -81,17 +81,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE SLASRT( ID, N, D, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER ID @@ -123,7 +123,7 @@ * .. * .. Executable Statements .. * -* Test the input paramters. +* Test the input parameters. * INFO = 0 DIR = -1 diff --git a/lapack-netlib/SRC/slasy2.f b/lapack-netlib/SRC/slasy2.f index 5684a119f..ed34a823e 100644 --- a/lapack-netlib/SRC/slasy2.f +++ b/lapack-netlib/SRC/slasy2.f @@ -166,7 +166,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realSYauxiliary * @@ -174,10 +174,10 @@ SUBROUTINE SLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR, $ LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. LOGICAL LTRANL, LTRANR @@ -438,8 +438,10 @@ 80 CONTINUE 90 CONTINUE 100 CONTINUE - IF( ABS( T16( 4, 4 ) ).LT.SMIN ) - $ T16( 4, 4 ) = SMIN + IF( ABS( T16( 4, 4 ) ).LT.SMIN ) THEN + INFO = 1 + T16( 4, 4 ) = SMIN + END IF SCALE = ONE IF( ( EIGHT*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( T16( 1, 1 ) ) .OR. $ ( EIGHT*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( T16( 2, 2 ) ) .OR. diff --git a/lapack-netlib/SRC/slatdf.f b/lapack-netlib/SRC/slatdf.f index 51773d4e5..dc5e2b749 100644 --- a/lapack-netlib/SRC/slatdf.f +++ b/lapack-netlib/SRC/slatdf.f @@ -58,7 +58,7 @@ *> Zx = +-e - f with the sign giving the greater value *> of 2-norm(x). About 5 times as expensive as Default. *> IJOB .ne. 2: Local look ahead strategy where all entries of -*> the r.h.s. b is choosen as either +1 or -1 (Default). +*> the r.h.s. b is chosen as either +1 or -1 (Default). *> \endverbatim *> *> \param[in] N @@ -133,7 +133,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realOTHERauxiliary * @@ -171,10 +171,10 @@ SUBROUTINE SLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, $ JPIV ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IJOB, LDZ, N diff --git a/lapack-netlib/SRC/sorbdb1.f b/lapack-netlib/SRC/sorbdb1.f index b1f5f4628..a8c2e96bd 100644 --- a/lapack-netlib/SRC/sorbdb1.f +++ b/lapack-netlib/SRC/sorbdb1.f @@ -203,7 +203,7 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -304,9 +304,8 @@ $ X11(I+1,I+1), LDX11, WORK(ILARF) ) CALL SLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK(ILARF) ) - C = SQRT( SNRM2( P-I, X11(I+1,I+1), 1, X11(I+1,I+1), - $ 1 )**2 + SNRM2( M-P-I, X21(I+1,I+1), 1, X21(I+1,I+1), - $ 1 )**2 ) + C = SQRT( SNRM2( P-I, X11(I+1,I+1), 1 )**2 + $ + SNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) PHI(I) = ATAN2( S, C ) CALL SORBDB5( P-I, M-P-I, Q-I-1, X11(I+1,I+1), 1, $ X21(I+1,I+1), 1, X11(I+1,I+2), LDX11, diff --git a/lapack-netlib/SRC/sorbdb2.f b/lapack-netlib/SRC/sorbdb2.f index 582540e34..c9919a174 100644 --- a/lapack-netlib/SRC/sorbdb2.f +++ b/lapack-netlib/SRC/sorbdb2.f @@ -201,7 +201,7 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -291,8 +291,8 @@ $ X11(I+1,I), LDX11, WORK(ILARF) ) CALL SLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X21(I,I), LDX21, WORK(ILARF) ) - S = SQRT( SNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + SNRM2( M-P-I+1, X21(I,I), 1, X21(I,I), 1 )**2 ) + S = SQRT( SNRM2( P-I, X11(I+1,I), 1 )**2 + $ + SNRM2( M-P-I+1, X21(I,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL SORBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1, diff --git a/lapack-netlib/SRC/sorbdb3.f b/lapack-netlib/SRC/sorbdb3.f index ea52f4db3..8ce74d407 100644 --- a/lapack-netlib/SRC/sorbdb3.f +++ b/lapack-netlib/SRC/sorbdb3.f @@ -202,7 +202,7 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -293,8 +293,8 @@ $ X11(I,I), LDX11, WORK(ILARF) ) CALL SLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) - C = SQRT( SNRM2( P-I+1, X11(I,I), 1, X11(I,I), - $ 1 )**2 + SNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), 1 )**2 ) + C = SQRT( SNRM2( P-I+1, X11(I,I), 1 )**2 + $ + SNRM2( M-P-I, X21(I+1,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL SORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1, diff --git a/lapack-netlib/SRC/sorbdb4.f b/lapack-netlib/SRC/sorbdb4.f index 9ed16a714..1efe146b1 100644 --- a/lapack-netlib/SRC/sorbdb4.f +++ b/lapack-netlib/SRC/sorbdb4.f @@ -214,7 +214,7 @@ $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -342,9 +342,8 @@ CALL SLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) IF( I .LT. M-Q ) THEN - S = SQRT( SNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + SNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), - $ 1 )**2 ) + S = SQRT( SNRM2( P-I, X11(I+1,I), 1 )**2 + $ + SNRM2( M-P-I, X21(I+1,I), 1 )**2 ) PHI(I) = ATAN2( S, C ) END IF * diff --git a/lapack-netlib/SRC/sorcsd2by1.f b/lapack-netlib/SRC/sorcsd2by1.f index b2401af19..3354d091c 100644 --- a/lapack-netlib/SRC/sorcsd2by1.f +++ b/lapack-netlib/SRC/sorcsd2by1.f @@ -232,7 +232,7 @@ $ X21, LDX21, THETA, U1, LDU1, U2, LDU2, V1T, $ LDV1T, WORK, LWORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -264,6 +264,9 @@ $ LWORKMIN, LWORKOPT, R LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. +* .. Local Arrays .. + REAL DUM1(1), DUM2(1,1) +* .. * .. External Subroutines .. EXTERNAL SBBCSD, SCOPY, SLACPY, SLAPMR, SLAPMT, SORBDB1, $ SORBDB2, SORBDB3, SORBDB4, SORGLQ, SORGQR, @@ -296,11 +299,11 @@ INFO = -8 ELSE IF( LDX21 .LT. MAX( 1, M-P ) ) THEN INFO = -10 - ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN + ELSE IF( WANTU1 .AND. LDU1 .LT. MAX( 1, P ) ) THEN INFO = -13 - ELSE IF( WANTU2 .AND. LDU2 .LT. M - P ) THEN + ELSE IF( WANTU2 .AND. LDU2 .LT. MAX( 1, M - P ) ) THEN INFO = -15 - ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN + ELSE IF( WANTV1T .AND. LDV1T .LT. MAX( 1, Q ) ) THEN INFO = -17 END IF * @@ -342,98 +345,124 @@ IORBDB = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ1 + MAX( 1, Q ) IORGLQ = ITAUQ1 + MAX( 1, Q ) + LORGQRMIN = 1 + LORGQROPT = 1 + LORGLQMIN = 1 + LORGLQOPT = 1 IF( R .EQ. Q ) THEN - CALL SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK, -1, CHILDINFO ) + CALL SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, WORK, -1, + $ CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL SORGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL SORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL SORGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + ENDIF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL SORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL SORGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, + $ DUM1, WORK(1), -1, CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q-1 ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL SORGLQ( MAX(0,Q-1), MAX(0,Q-1), MAX(0,Q-1), V1T, LDV1T, - $ 0, WORK(1), -1, CHILDINFO ) - LORGLQMIN = MAX( 1, Q-1 ) - LORGLQOPT = INT( WORK(1) ) CALL SBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, 0, 0, - $ 0, 0, 0, 0, 0, 0, WORK(1), -1, CHILDINFO ) + $ DUM1, U1, LDU1, U2, LDU2, V1T, LDV1T, DUM2, + $ 1, DUM1, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, WORK(1), -1, CHILDINFO + $ ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. P ) THEN - CALL SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, + $ CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P-1 .GE. M-P ) THEN - CALL SORGQR( P-1, P-1, P-1, U1(2,2), LDU1, 0, WORK(1), - $ -1, CHILDINFO ) - LORGQRMIN = MAX( 1, P-1 ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL SORGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, - $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL SORGQR( P-1, P-1, P-1, U1(2,2), LDU1, DUM1, + $ WORK(1), -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL SORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), -1, + $ CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL SORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL SORGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL SBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ 0, V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, 0, 0, - $ 0, 0, 0, 0, 0, 0, WORK(1), -1, CHILDINFO ) + $ DUM1, V1T, LDV1T, DUM2, 1, U1, LDU1, U2, + $ LDU2, DUM1, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, WORK(1), -1, CHILDINFO + $ ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. M-P ) THEN - CALL SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, + $ CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P-1 ) THEN - CALL SORGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL SORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL SORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, 0, - $ WORK(1), -1, CHILDINFO ) - LORGQRMIN = MAX( 1, M-P-1 ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL SORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, DUM1, + $ WORK(1), -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL SORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL SORGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL SBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, 0, 0, 1, V1T, LDV1T, U2, LDU2, U1, LDU1, - $ 0, 0, 0, 0, 0, 0, 0, 0, WORK(1), -1, + $ THETA, DUM1, DUM2, 1, V1T, LDV1T, U2, LDU2, + $ U1, LDU1, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, $ CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE - CALL SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, 0, WORK(1), -1, CHILDINFO ) + CALL SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, DUM1, + $ WORK(1), -1, CHILDINFO ) LORBDB = M + INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL SORGQR( P, P, M-Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL SORGQR( P, P, M-Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL SORGQR( M-P, M-P, M-Q, U2, LDU2, 0, WORK(1), -1, - $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL SORGQR( M-P, M-P, M-Q, U2, LDU2, DUM1, WORK(1), + $ -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL SORGLQ( Q, Q, Q, V1T, LDV1T, DUM1, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL SORGLQ( Q, Q, Q, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL SBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, 0, U2, LDU2, U1, LDU1, 0, 1, V1T, LDV1T, - $ 0, 0, 0, 0, 0, 0, 0, 0, WORK(1), -1, + $ THETA, DUM1, U2, LDU2, U1, LDU1, DUM2, 1, + $ V1T, LDV1T, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, $ CHILDINFO ) LBBCSD = INT( WORK(1) ) END IF @@ -499,8 +528,8 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, - $ WORK(IB11D), WORK(IB11E), WORK(IB12D), + $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, + $ DUM2, 1, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -553,8 +582,8 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ WORK(IPHI), V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, - $ WORK(IB11D), WORK(IB11E), WORK(IB12D), + $ WORK(IPHI), V1T, LDV1T, DUM1, 1, U1, LDU1, U2, + $ LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -608,11 +637,11 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, WORK(IPHI), 0, 1, V1T, LDV1T, U2, LDU2, U1, - $ LDU1, WORK(IB11D), WORK(IB11E), WORK(IB12D), - $ WORK(IB12E), WORK(IB21D), WORK(IB21E), - $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, WORK(IPHI), DUM1, 1, V1T, LDV1T, U2, + $ LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E), + $ WORK(IB12D), WORK(IB12E), WORK(IB21D), + $ WORK(IB21E), WORK(IB22D), WORK(IB22E), + $ WORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions @@ -677,8 +706,8 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, 0, 1, V1T, - $ LDV1T, WORK(IB11D), WORK(IB11E), WORK(IB12D), + $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM1, 1, + $ V1T, LDV1T, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, $ CHILDINFO ) diff --git a/lapack-netlib/SRC/ssbevx.f b/lapack-netlib/SRC/ssbevx.f index 0fa1ac45f..a03c4a415 100644 --- a/lapack-netlib/SRC/ssbevx.f +++ b/lapack-netlib/SRC/ssbevx.f @@ -126,12 +126,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -139,13 +142,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -249,7 +256,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -258,10 +265,10 @@ $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/ssbgvd.f b/lapack-netlib/SRC/ssbgvd.f index b0d48ae93..fac2baadc 100644 --- a/lapack-netlib/SRC/ssbgvd.f +++ b/lapack-netlib/SRC/ssbgvd.f @@ -214,7 +214,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -227,10 +227,10 @@ SUBROUTINE SSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, $ Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO @@ -338,7 +338,7 @@ INDWK2 = INDWRK + N*N LLWRK2 = LWORK - INDWK2 + 1 CALL SSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ, - $ WORK( INDWRK ), IINFO ) + $ WORK, IINFO ) * * Reduce to tridiagonal form. * diff --git a/lapack-netlib/SRC/ssbgvx.f b/lapack-netlib/SRC/ssbgvx.f index b35a7b323..2b27f023f 100644 --- a/lapack-netlib/SRC/ssbgvx.f +++ b/lapack-netlib/SRC/ssbgvx.f @@ -152,13 +152,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -166,14 +170,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -271,7 +280,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -285,10 +294,10 @@ $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, $ LDZ, WORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/sspevx.f b/lapack-netlib/SRC/sspevx.f index 565aedf31..c2bbaf717 100644 --- a/lapack-netlib/SRC/sspevx.f +++ b/lapack-netlib/SRC/sspevx.f @@ -96,12 +96,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -109,13 +112,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -218,7 +225,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -227,10 +234,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, $ INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/sspgvx.f b/lapack-netlib/SRC/sspgvx.f index c95139a62..8f8ed9a8f 100644 --- a/lapack-netlib/SRC/sspgvx.f +++ b/lapack-netlib/SRC/sspgvx.f @@ -118,13 +118,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,14 +136,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -249,7 +258,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -263,10 +272,10 @@ $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/sstebz.f b/lapack-netlib/SRC/sstebz.f index c5263651a..1e231ec89 100644 --- a/lapack-netlib/SRC/sstebz.f +++ b/lapack-netlib/SRC/sstebz.f @@ -87,13 +87,18 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. Eigenvalues less than or equal +*> to VL, or greater than VU, will not be returned. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. Eigenvalues less than or equal *> to VL, or greater than VU, will not be returned. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. @@ -102,14 +107,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -254,7 +264,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -263,10 +273,10 @@ $ M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER ORDER, RANGE diff --git a/lapack-netlib/SRC/sstegr.f b/lapack-netlib/SRC/sstegr.f index d98c451fe..4c8350e6b 100644 --- a/lapack-netlib/SRC/sstegr.f +++ b/lapack-netlib/SRC/sstegr.f @@ -48,7 +48,7 @@ *> either an interval (VL,VU] or a range of indices IL:IU for the desired *> eigenvalues. *> -*> SSTEGR is a compatability wrapper around the improved SSTEMR routine. +*> SSTEGR is a compatibility wrapper around the improved SSTEMR routine. *> See SSTEMR for further details. *> *> One important change is that the ABSTOL parameter no longer provides any @@ -105,13 +105,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -119,14 +123,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -240,7 +249,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHERcomputational * @@ -256,10 +265,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/sstemr.f b/lapack-netlib/SRC/sstemr.f index 2e995802e..5ffe96d43 100644 --- a/lapack-netlib/SRC/sstemr.f +++ b/lapack-netlib/SRC/sstemr.f @@ -136,13 +136,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -150,14 +154,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -294,7 +303,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup realOTHERcomputational * @@ -312,10 +321,10 @@ $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/sstevr.f b/lapack-netlib/SRC/sstevr.f index e8b52a221..2dec8695d 100644 --- a/lapack-netlib/SRC/sstevr.f +++ b/lapack-netlib/SRC/sstevr.f @@ -128,12 +128,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -141,13 +144,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -280,7 +287,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -299,10 +306,10 @@ $ M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/sstevx.f b/lapack-netlib/SRC/sstevx.f index 58f86f2e3..427ad742b 100644 --- a/lapack-netlib/SRC/sstevx.f +++ b/lapack-netlib/SRC/sstevx.f @@ -89,12 +89,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -102,13 +105,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -212,7 +219,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -220,10 +227,10 @@ SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/ssyevr.f b/lapack-netlib/SRC/ssyevr.f index bfe4258c7..7e274b4e6 100644 --- a/lapack-netlib/SRC/ssyevr.f +++ b/lapack-netlib/SRC/ssyevr.f @@ -153,12 +153,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -166,13 +169,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -308,7 +315,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realSYeigen * @@ -327,10 +334,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/ssyevx.f b/lapack-netlib/SRC/ssyevx.f index cbc8b1d0e..611f4f243 100644 --- a/lapack-netlib/SRC/ssyevx.f +++ b/lapack-netlib/SRC/ssyevx.f @@ -98,12 +98,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -111,13 +114,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -237,7 +244,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realSYeigen * @@ -246,10 +253,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/ssygvx.f b/lapack-netlib/SRC/ssygvx.f index bbe922201..8c909946d 100644 --- a/lapack-netlib/SRC/ssygvx.f +++ b/lapack-netlib/SRC/ssygvx.f @@ -131,12 +131,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -144,13 +147,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -276,7 +283,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realSYeigen * @@ -290,10 +297,10 @@ $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, $ LWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/ssytrf_rook.f b/lapack-netlib/SRC/ssytrf_rook.f index 6467be457..3281fbe7f 100644 --- a/lapack-netlib/SRC/ssytrf_rook.f +++ b/lapack-netlib/SRC/ssytrf_rook.f @@ -146,7 +146,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realSYcomputational * @@ -195,7 +195,7 @@ *> *> \verbatim *> -*> November 2015, Igor Kozachenko, +*> June 2016, Igor Kozachenko, *> Computer Science Division, *> University of California, Berkeley *> @@ -208,10 +208,10 @@ * ===================================================================== SUBROUTINE SSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -261,7 +261,7 @@ * Determine the block size * NB = ILAENV( 1, 'SSYTRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/stgsen.f b/lapack-netlib/SRC/stgsen.f index 90e1d9451..13997be31 100644 --- a/lapack-netlib/SRC/stgsen.f +++ b/lapack-netlib/SRC/stgsen.f @@ -304,7 +304,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHERcomputational * @@ -451,10 +451,10 @@ $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL WANTQ, WANTZ @@ -541,6 +541,7 @@ * M = 0 PAIR = .FALSE. + IF( .NOT.LQUERY .OR. IJOB.NE.0 ) THEN DO 10 K = 1, N IF( PAIR ) THEN PAIR = .FALSE. @@ -560,6 +561,7 @@ END IF END IF 10 CONTINUE + END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN LWMIN = MAX( 1, 4*N+16, 2*M*(N-M) ) diff --git a/lapack-netlib/SRC/strevc3.f b/lapack-netlib/SRC/strevc3.f new file mode 100644 index 000000000..95ac0f6d0 --- /dev/null +++ b/lapack-netlib/SRC/strevc3.f @@ -0,0 +1,1303 @@ +*> \brief \b STREVC3 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download STREVC3 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, +* VR, LDVR, MM, M, WORK, LWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER HOWMNY, SIDE +* INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. +* LOGICAL SELECT( * ) +* REAL T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), +* $ WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> STREVC3 computes some or all of the right and/or left eigenvectors of +*> a real upper quasi-triangular matrix T. +*> Matrices of this type are produced by the Schur factorization of +*> a real general matrix: A = Q*T*Q**T, as computed by SHSEQR. +*> +*> The right eigenvector x and the left eigenvector y of T corresponding +*> to an eigenvalue w are defined by: +*> +*> T*x = w*x, (y**T)*T = w*(y**T) +*> +*> where y**T denotes the transpose of the vector y. +*> The eigenvalues are not input to this routine, but are read directly +*> from the diagonal blocks of T. +*> +*> This routine returns the matrices X and/or Y of right and left +*> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an +*> input matrix. If Q is the orthogonal factor that reduces a matrix +*> A to Schur form T, then Q*X and Q*Y are the matrices of right and +*> left eigenvectors of A. +*> +*> This uses a Level 3 BLAS version of the back transformation. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'R': compute right eigenvectors only; +*> = 'L': compute left eigenvectors only; +*> = 'B': compute both right and left eigenvectors. +*> \endverbatim +*> +*> \param[in] HOWMNY +*> \verbatim +*> HOWMNY is CHARACTER*1 +*> = 'A': compute all right and/or left eigenvectors; +*> = 'B': compute all right and/or left eigenvectors, +*> backtransformed by the matrices in VR and/or VL; +*> = 'S': compute selected right and/or left eigenvectors, +*> as indicated by the logical array SELECT. +*> \endverbatim +*> +*> \param[in,out] SELECT +*> \verbatim +*> SELECT is LOGICAL array, dimension (N) +*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be +*> computed. +*> If w(j) is a real eigenvalue, the corresponding real +*> eigenvector is computed if SELECT(j) is .TRUE.. +*> If w(j) and w(j+1) are the real and imaginary parts of a +*> complex eigenvalue, the corresponding complex eigenvector is +*> computed if either SELECT(j) or SELECT(j+1) is .TRUE., and +*> on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to +*> .FALSE.. +*> Not referenced if HOWMNY = 'A' or 'B'. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the matrix T. N >= 0. +*> \endverbatim +*> +*> \param[in] T +*> \verbatim +*> T is REAL array, dimension (LDT,N) +*> The upper quasi-triangular matrix T in Schur canonical form. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= max(1,N). +*> \endverbatim +*> +*> \param[in,out] VL +*> \verbatim +*> VL is REAL array, dimension (LDVL,MM) +*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must +*> contain an N-by-N matrix Q (usually the orthogonal matrix Q +*> of Schur vectors returned by SHSEQR). +*> On exit, if SIDE = 'L' or 'B', VL contains: +*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*Y; +*> if HOWMNY = 'S', the left eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VL, in the same order as their +*> eigenvalues. +*> A complex eigenvector corresponding to a complex eigenvalue +*> is stored in two consecutive columns, the first holding the +*> real part, and the second the imaginary part. +*> Not referenced if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDVL +*> \verbatim +*> LDVL is INTEGER +*> The leading dimension of the array VL. +*> LDVL >= 1, and if SIDE = 'L' or 'B', LDVL >= N. +*> \endverbatim +*> +*> \param[in,out] VR +*> \verbatim +*> VR is REAL array, dimension (LDVR,MM) +*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must +*> contain an N-by-N matrix Q (usually the orthogonal matrix Q +*> of Schur vectors returned by SHSEQR). +*> On exit, if SIDE = 'R' or 'B', VR contains: +*> if HOWMNY = 'A', the matrix X of right eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*X; +*> if HOWMNY = 'S', the right eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VR, in the same order as their +*> eigenvalues. +*> A complex eigenvector corresponding to a complex eigenvalue +*> is stored in two consecutive columns, the first holding the +*> real part and the second the imaginary part. +*> Not referenced if SIDE = 'L'. +*> \endverbatim +*> +*> \param[in] LDVR +*> \verbatim +*> LDVR is INTEGER +*> The leading dimension of the array VR. +*> LDVR >= 1, and if SIDE = 'R' or 'B', LDVR >= N. +*> \endverbatim +*> +*> \param[in] MM +*> \verbatim +*> MM is INTEGER +*> The number of columns in the arrays VL and/or VR. MM >= M. +*> \endverbatim +*> +*> \param[out] M +*> \verbatim +*> M is INTEGER +*> The number of columns in the arrays VL and/or VR actually +*> used to store the eigenvectors. +*> If HOWMNY = 'A' or 'B', M is set to N. +*> Each selected real eigenvector occupies one column and each +*> selected complex eigenvector occupies two columns. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is REAL array, dimension (MAX(1,LWORK)) +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of array WORK. LWORK >= max(1,3*N). +*> For optimum performance, LWORK >= N + 2*N*NB, 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. +* +*> \date November 2011 +* +* @generated from dtrevc3.f, fortran d -> s, Tue Apr 19 01:47:44 2016 +* +*> \ingroup realOTHERcomputational +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The algorithm used in this program is basically backward (forward) +*> substitution, with scaling to make the the code robust against +*> possible overflow. +*> +*> Each eigenvector is normalized so that the element of largest +*> magnitude has magnitude 1; here the magnitude of a complex number +*> (x,y) is taken to be |x| + |y|. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, LDVR, MM, M, WORK, LWORK, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2011 +* +* .. Scalar Arguments .. + CHARACTER HOWMNY, SIDE + INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. + LOGICAL SELECT( * ) + REAL T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), + $ WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) + INTEGER NBMIN, NBMAX + PARAMETER ( NBMIN = 8, NBMAX = 128 ) +* .. +* .. Local Scalars .. + LOGICAL ALLV, BOTHV, LEFTV, LQUERY, OVER, PAIR, + $ RIGHTV, SOMEV + INTEGER I, IERR, II, IP, IS, J, J1, J2, JNXT, K, KI, + $ IV, MAXWRK, NB, KI2 + REAL BETA, BIGNUM, EMAX, OVFL, REC, REMAX, SCALE, + $ SMIN, SMLNUM, ULP, UNFL, VCRIT, VMAX, WI, WR, + $ XNORM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ISAMAX, ILAENV + REAL SDOT, SLAMCH + EXTERNAL LSAME, ISAMAX, ILAENV, SDOT, SLAMCH +* .. +* .. External Subroutines .. + EXTERNAL SAXPY, SCOPY, SGEMV, SLALN2, SSCAL, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. +* .. Local Arrays .. + REAL X( 2, 2 ) + INTEGER ISCOMPLEX( NBMAX ) +* .. +* .. Executable Statements .. +* +* Decode and test the input parameters +* + BOTHV = LSAME( SIDE, 'B' ) + RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV + LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV +* + ALLV = LSAME( HOWMNY, 'A' ) + OVER = LSAME( HOWMNY, 'B' ) + SOMEV = LSAME( HOWMNY, 'S' ) +* + INFO = 0 + NB = ILAENV( 1, 'STREVC', SIDE // HOWMNY, N, -1, -1, -1 ) + MAXWRK = N + 2*N*NB + WORK(1) = MAXWRK + LQUERY = ( LWORK.EQ.-1 ) + IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN + INFO = -1 + ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDT.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN + INFO = -8 + ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN + INFO = -10 + ELSE IF( LWORK.LT.MAX( 1, 3*N ) .AND. .NOT.LQUERY ) THEN + INFO = -14 + ELSE +* +* Set M to the number of columns required to store the selected +* eigenvectors, standardize the array SELECT if necessary, and +* test MM. +* + IF( SOMEV ) THEN + M = 0 + PAIR = .FALSE. + DO 10 J = 1, N + IF( PAIR ) THEN + PAIR = .FALSE. + SELECT( J ) = .FALSE. + ELSE + IF( J.LT.N ) THEN + IF( T( J+1, J ).EQ.ZERO ) THEN + IF( SELECT( J ) ) + $ M = M + 1 + ELSE + PAIR = .TRUE. + IF( SELECT( J ) .OR. SELECT( J+1 ) ) THEN + SELECT( J ) = .TRUE. + M = M + 2 + END IF + END IF + ELSE + IF( SELECT( N ) ) + $ M = M + 1 + END IF + END IF + 10 CONTINUE + ELSE + M = N + END IF +* + IF( MM.LT.M ) THEN + INFO = -11 + END IF + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'STREVC3', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible. +* + IF( N.EQ.0 ) + $ RETURN +* +* Use blocked version of back-transformation if sufficient workspace. +* Zero-out the workspace to avoid potential NaN propagation. +* + IF( OVER .AND. LWORK .GE. N + 2*N*NBMIN ) THEN + NB = (LWORK - N) / (2*N) + NB = MIN( NB, NBMAX ) + CALL SLASET( 'F', N, 1+2*NB, ZERO, ZERO, WORK, N ) + ELSE + NB = 1 + END IF +* +* Set the constants to control overflow. +* + UNFL = SLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL SLABAD( UNFL, OVFL ) + ULP = SLAMCH( 'Precision' ) + SMLNUM = UNFL*( N / ULP ) + BIGNUM = ( ONE-ULP ) / SMLNUM +* +* Compute 1-norm of each column of strictly upper triangular +* part of T to control overflow in triangular solver. +* + WORK( 1 ) = ZERO + DO 30 J = 2, N + WORK( J ) = ZERO + DO 20 I = 1, J - 1 + WORK( J ) = WORK( J ) + ABS( T( I, J ) ) + 20 CONTINUE + 30 CONTINUE +* +* Index IP is used to specify the real or complex eigenvalue: +* IP = 0, real eigenvalue, +* 1, first of conjugate complex pair: (wr,wi) +* -1, second of conjugate complex pair: (wr,wi) +* ISCOMPLEX array stores IP for each column in current block. +* + IF( RIGHTV ) THEN +* +* ============================================================ +* Compute right eigenvectors. +* +* IV is index of column in current block. +* For complex right vector, uses IV-1 for real part and IV for complex part. +* Non-blocked version always uses IV=2; +* blocked version starts with IV=NB, goes down to 1 or 2. +* (Note the "0-th" column is used for 1-norms computed above.) + IV = 2 + IF( NB.GT.2 ) THEN + IV = NB + END IF + + IP = 0 + IS = M + DO 140 KI = N, 1, -1 + IF( IP.EQ.-1 ) THEN +* previous iteration (ki+1) was second of conjugate pair, +* so this ki is first of conjugate pair; skip to end of loop + IP = 1 + GO TO 140 + ELSE IF( KI.EQ.1 ) THEN +* last column, so this ki must be real eigenvalue + IP = 0 + ELSE IF( T( KI, KI-1 ).EQ.ZERO ) THEN +* zero on sub-diagonal, so this ki is real eigenvalue + IP = 0 + ELSE +* non-zero on sub-diagonal, so this ki is second of conjugate pair + IP = -1 + END IF + + IF( SOMEV ) THEN + IF( IP.EQ.0 ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 140 + ELSE + IF( .NOT.SELECT( KI-1 ) ) + $ GO TO 140 + END IF + END IF +* +* Compute the KI-th eigenvalue (WR,WI). +* + WR = T( KI, KI ) + WI = ZERO + IF( IP.NE.0 ) + $ WI = SQRT( ABS( T( KI, KI-1 ) ) )* + $ SQRT( ABS( T( KI-1, KI ) ) ) + SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM ) +* + IF( IP.EQ.0 ) THEN +* +* -------------------------------------------------------- +* Real right eigenvector +* + WORK( KI + IV*N ) = ONE +* +* Form right-hand side. +* + DO 50 K = 1, KI - 1 + WORK( K + IV*N ) = -T( K, KI ) + 50 CONTINUE +* +* Solve upper quasi-triangular system: +* [ T(1:KI-1,1:KI-1) - WR ]*X = SCALE*WORK. +* + JNXT = KI - 1 + DO 60 J = KI - 1, 1, -1 + IF( J.GT.JNXT ) + $ GO TO 60 + J1 = J + J2 = J + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + J1 = J - 1 + JNXT = J - 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* + CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale X(1,1) to avoid overflow when updating +* the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL SSCAL( KI, SCALE, WORK( 1+IV*N ), 1 ) + WORK( J+IV*N ) = X( 1, 1 ) +* +* Update right-hand side +* + CALL SAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1, + $ WORK( 1+IV*N ), 1 ) +* + ELSE +* +* 2-by-2 diagonal block +* + CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, + $ T( J-1, J-1 ), LDT, ONE, ONE, + $ WORK( J-1+IV*N ), N, WR, ZERO, X, 2, + $ SCALE, XNORM, IERR ) +* +* Scale X(1,1) and X(2,1) to avoid overflow when +* updating the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + BETA = MAX( WORK( J-1 ), WORK( J ) ) + IF( BETA.GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + X( 2, 1 ) = X( 2, 1 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL SSCAL( KI, SCALE, WORK( 1+IV*N ), 1 ) + WORK( J-1+IV*N ) = X( 1, 1 ) + WORK( J +IV*N ) = X( 2, 1 ) +* +* Update right-hand side +* + CALL SAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, + $ WORK( 1+IV*N ), 1 ) + CALL SAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1, + $ WORK( 1+IV*N ), 1 ) + END IF + 60 CONTINUE +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL SCOPY( KI, WORK( 1 + IV*N ), 1, VR( 1, IS ), 1 ) +* + II = ISAMAX( KI, VR( 1, IS ), 1 ) + REMAX = ONE / ABS( VR( II, IS ) ) + CALL SSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 70 K = KI + 1, N + VR( K, IS ) = ZERO + 70 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.1 ) + $ CALL SGEMV( 'N', N, KI-1, ONE, VR, LDVR, + $ WORK( 1 + IV*N ), 1, WORK( KI + IV*N ), + $ VR( 1, KI ), 1 ) +* + II = ISAMAX( N, VR( 1, KI ), 1 ) + REMAX = ONE / ABS( VR( II, KI ) ) + CALL SSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + IV*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP +* back-transform and normalization is done below + END IF + ELSE +* +* -------------------------------------------------------- +* Complex right eigenvector. +* +* Initial solve +* [ ( T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I*WI) ]*X = 0. +* [ ( T(KI, KI-1) T(KI, KI) ) ] +* + IF( ABS( T( KI-1, KI ) ).GE.ABS( T( KI, KI-1 ) ) ) THEN + WORK( KI-1 + (IV-1)*N ) = ONE + WORK( KI + (IV )*N ) = WI / T( KI-1, KI ) + ELSE + WORK( KI-1 + (IV-1)*N ) = -WI / T( KI, KI-1 ) + WORK( KI + (IV )*N ) = ONE + END IF + WORK( KI + (IV-1)*N ) = ZERO + WORK( KI-1 + (IV )*N ) = ZERO +* +* Form right-hand side. +* + DO 80 K = 1, KI - 2 + WORK( K+(IV-1)*N ) = -WORK( KI-1+(IV-1)*N )*T(K,KI-1) + WORK( K+(IV )*N ) = -WORK( KI +(IV )*N )*T(K,KI ) + 80 CONTINUE +* +* Solve upper quasi-triangular system: +* [ T(1:KI-2,1:KI-2) - (WR+i*WI) ]*X = SCALE*(WORK+i*WORK2) +* + JNXT = KI - 2 + DO 90 J = KI - 2, 1, -1 + IF( J.GT.JNXT ) + $ GO TO 90 + J1 = J + J2 = J + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + J1 = J - 1 + JNXT = J - 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* + CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+(IV-1)*N ), N, + $ WR, WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale X(1,1) and X(1,2) to avoid overflow when +* updating the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + X( 1, 2 ) = X( 1, 2 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( KI, SCALE, WORK( 1+(IV-1)*N ), 1 ) + CALL SSCAL( KI, SCALE, WORK( 1+(IV )*N ), 1 ) + END IF + WORK( J+(IV-1)*N ) = X( 1, 1 ) + WORK( J+(IV )*N ) = X( 1, 2 ) +* +* Update the right-hand side +* + CALL SAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL SAXPY( J-1, -X( 1, 2 ), T( 1, J ), 1, + $ WORK( 1+(IV )*N ), 1 ) +* + ELSE +* +* 2-by-2 diagonal block +* + CALL SLALN2( .FALSE., 2, 2, SMIN, ONE, + $ T( J-1, J-1 ), LDT, ONE, ONE, + $ WORK( J-1+(IV-1)*N ), N, WR, WI, X, 2, + $ SCALE, XNORM, IERR ) +* +* Scale X to avoid overflow when updating +* the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + BETA = MAX( WORK( J-1 ), WORK( J ) ) + IF( BETA.GT.BIGNUM / XNORM ) THEN + REC = ONE / XNORM + X( 1, 1 ) = X( 1, 1 )*REC + X( 1, 2 ) = X( 1, 2 )*REC + X( 2, 1 ) = X( 2, 1 )*REC + X( 2, 2 ) = X( 2, 2 )*REC + SCALE = SCALE*REC + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( KI, SCALE, WORK( 1+(IV-1)*N ), 1 ) + CALL SSCAL( KI, SCALE, WORK( 1+(IV )*N ), 1 ) + END IF + WORK( J-1+(IV-1)*N ) = X( 1, 1 ) + WORK( J +(IV-1)*N ) = X( 2, 1 ) + WORK( J-1+(IV )*N ) = X( 1, 2 ) + WORK( J +(IV )*N ) = X( 2, 2 ) +* +* Update the right-hand side +* + CALL SAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL SAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL SAXPY( J-2, -X( 1, 2 ), T( 1, J-1 ), 1, + $ WORK( 1+(IV )*N ), 1 ) + CALL SAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1, + $ WORK( 1+(IV )*N ), 1 ) + END IF + 90 CONTINUE +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL SCOPY( KI, WORK( 1+(IV-1)*N ), 1, VR(1,IS-1), 1 ) + CALL SCOPY( KI, WORK( 1+(IV )*N ), 1, VR(1,IS ), 1 ) +* + EMAX = ZERO + DO 100 K = 1, KI + EMAX = MAX( EMAX, ABS( VR( K, IS-1 ) )+ + $ ABS( VR( K, IS ) ) ) + 100 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( KI, REMAX, VR( 1, IS-1 ), 1 ) + CALL SSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 110 K = KI + 1, N + VR( K, IS-1 ) = ZERO + VR( K, IS ) = ZERO + 110 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.2 ) THEN + CALL SGEMV( 'N', N, KI-2, ONE, VR, LDVR, + $ WORK( 1 + (IV-1)*N ), 1, + $ WORK( KI-1 + (IV-1)*N ), VR(1,KI-1), 1) + CALL SGEMV( 'N', N, KI-2, ONE, VR, LDVR, + $ WORK( 1 + (IV)*N ), 1, + $ WORK( KI + (IV)*N ), VR( 1, KI ), 1 ) + ELSE + CALL SSCAL( N, WORK(KI-1+(IV-1)*N), VR(1,KI-1), 1) + CALL SSCAL( N, WORK(KI +(IV )*N), VR(1,KI ), 1) + END IF +* + EMAX = ZERO + DO 120 K = 1, N + EMAX = MAX( EMAX, ABS( VR( K, KI-1 ) )+ + $ ABS( VR( K, KI ) ) ) + 120 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( N, REMAX, VR( 1, KI-1 ), 1 ) + CALL SSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + (IV-1)*N ) = ZERO + WORK( K + (IV )*N ) = ZERO + END DO + ISCOMPLEX( IV-1 ) = -IP + ISCOMPLEX( IV ) = IP + IV = IV - 1 +* back-transform and normalization is done below + END IF + END IF + + IF( NB.GT.1 ) THEN +* -------------------------------------------------------- +* Blocked version of back-transform +* For complex case, KI2 includes both vectors (KI-1 and KI) + IF( IP.EQ.0 ) THEN + KI2 = KI + ELSE + KI2 = KI - 1 + END IF + +* Columns IV:NB of work are valid vectors. +* When the number of vectors stored reaches NB-1 or NB, +* or if this was last vector, do the GEMM + IF( (IV.LE.2) .OR. (KI2.EQ.1) ) THEN + CALL SGEMM( 'N', 'N', N, NB-IV+1, KI2+NB-IV, ONE, + $ VR, LDVR, + $ WORK( 1 + (IV)*N ), N, + $ ZERO, + $ WORK( 1 + (NB+IV)*N ), N ) +* normalize vectors + DO K = IV, NB + IF( ISCOMPLEX(K).EQ.0 ) THEN +* real eigenvector + II = ISAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / ABS( WORK( II + (NB+K)*N ) ) + ELSE IF( ISCOMPLEX(K).EQ.1 ) THEN +* first eigenvector of conjugate pair + EMAX = ZERO + DO II = 1, N + EMAX = MAX( EMAX, + $ ABS( WORK( II + (NB+K )*N ) )+ + $ ABS( WORK( II + (NB+K+1)*N ) ) ) + END DO + REMAX = ONE / EMAX +* else if ISCOMPLEX(K).EQ.-1 +* second eigenvector of conjugate pair +* reuse same REMAX as previous K + END IF + CALL SSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL SLACPY( 'F', N, NB-IV+1, + $ WORK( 1 + (NB+IV)*N ), N, + $ VR( 1, KI2 ), LDVR ) + IV = NB + ELSE + IV = IV - 1 + END IF + END IF ! blocked back-transform +* + IS = IS - 1 + IF( IP.NE.0 ) + $ IS = IS - 1 + 140 CONTINUE + END IF + + IF( LEFTV ) THEN +* +* ============================================================ +* Compute left eigenvectors. +* +* IV is index of column in current block. +* For complex left vector, uses IV for real part and IV+1 for complex part. +* Non-blocked version always uses IV=1; +* blocked version starts with IV=1, goes up to NB-1 or NB. +* (Note the "0-th" column is used for 1-norms computed above.) + IV = 1 + IP = 0 + IS = 1 + DO 260 KI = 1, N + IF( IP.EQ.1 ) THEN +* previous iteration (ki-1) was first of conjugate pair, +* so this ki is second of conjugate pair; skip to end of loop + IP = -1 + GO TO 260 + ELSE IF( KI.EQ.N ) THEN +* last column, so this ki must be real eigenvalue + IP = 0 + ELSE IF( T( KI+1, KI ).EQ.ZERO ) THEN +* zero on sub-diagonal, so this ki is real eigenvalue + IP = 0 + ELSE +* non-zero on sub-diagonal, so this ki is first of conjugate pair + IP = 1 + END IF +* + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 260 + END IF +* +* Compute the KI-th eigenvalue (WR,WI). +* + WR = T( KI, KI ) + WI = ZERO + IF( IP.NE.0 ) + $ WI = SQRT( ABS( T( KI, KI+1 ) ) )* + $ SQRT( ABS( T( KI+1, KI ) ) ) + SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM ) +* + IF( IP.EQ.0 ) THEN +* +* -------------------------------------------------------- +* Real left eigenvector +* + WORK( KI + IV*N ) = ONE +* +* Form right-hand side. +* + DO 160 K = KI + 1, N + WORK( K + IV*N ) = -T( KI, K ) + 160 CONTINUE +* +* Solve transposed quasi-triangular system: +* [ T(KI+1:N,KI+1:N) - WR ]**T * X = SCALE*WORK +* + VMAX = ONE + VCRIT = BIGNUM +* + JNXT = KI + 1 + DO 170 J = KI + 1, N + IF( J.LT.JNXT ) + $ GO TO 170 + J1 = J + J2 = J + JNXT = J + 1 + IF( J.LT.N ) THEN + IF( T( J+1, J ).NE.ZERO ) THEN + J2 = J + 1 + JNXT = J + 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side. +* + IF( WORK( J ).GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK( KI+IV*N ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+IV*N ) = WORK( J+IV*N ) - + $ SDOT( J-KI-1, T( KI+1, J ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* +* Solve [ T(J,J) - WR ]**T * X = WORK +* + CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL SSCAL( N-KI+1, SCALE, WORK( KI+IV*N ), 1 ) + WORK( J+IV*N ) = X( 1, 1 ) + VMAX = MAX( ABS( WORK( J+IV*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + ELSE +* +* 2-by-2 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side. +* + BETA = MAX( WORK( J ), WORK( J+1 ) ) + IF( BETA.GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK( KI+IV*N ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+IV*N ) = WORK( J+IV*N ) - + $ SDOT( J-KI-1, T( KI+1, J ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* + WORK( J+1+IV*N ) = WORK( J+1+IV*N ) - + $ SDOT( J-KI-1, T( KI+1, J+1 ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* +* Solve +* [ T(J,J)-WR T(J,J+1) ]**T * X = SCALE*( WORK1 ) +* [ T(J+1,J) T(J+1,J+1)-WR ] ( WORK2 ) +* + CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL SSCAL( N-KI+1, SCALE, WORK( KI+IV*N ), 1 ) + WORK( J +IV*N ) = X( 1, 1 ) + WORK( J+1+IV*N ) = X( 2, 1 ) +* + VMAX = MAX( ABS( WORK( J +IV*N ) ), + $ ABS( WORK( J+1+IV*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + END IF + 170 CONTINUE +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL SCOPY( N-KI+1, WORK( KI + IV*N ), 1, + $ VL( KI, IS ), 1 ) +* + II = ISAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 + REMAX = ONE / ABS( VL( II, IS ) ) + CALL SSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) +* + DO 180 K = 1, KI - 1 + VL( K, IS ) = ZERO + 180 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N ) + $ CALL SGEMV( 'N', N, N-KI, ONE, + $ VL( 1, KI+1 ), LDVL, + $ WORK( KI+1 + IV*N ), 1, + $ WORK( KI + IV*N ), VL( 1, KI ), 1 ) +* + II = ISAMAX( N, VL( 1, KI ), 1 ) + REMAX = ONE / ABS( VL( II, KI ) ) + CALL SSCAL( N, REMAX, VL( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + IV*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP +* back-transform and normalization is done below + END IF + ELSE +* +* -------------------------------------------------------- +* Complex left eigenvector. +* +* Initial solve: +* [ ( T(KI,KI) T(KI,KI+1) )**T - (WR - I* WI) ]*X = 0. +* [ ( T(KI+1,KI) T(KI+1,KI+1) ) ] +* + IF( ABS( T( KI, KI+1 ) ).GE.ABS( T( KI+1, KI ) ) ) THEN + WORK( KI + (IV )*N ) = WI / T( KI, KI+1 ) + WORK( KI+1 + (IV+1)*N ) = ONE + ELSE + WORK( KI + (IV )*N ) = ONE + WORK( KI+1 + (IV+1)*N ) = -WI / T( KI+1, KI ) + END IF + WORK( KI+1 + (IV )*N ) = ZERO + WORK( KI + (IV+1)*N ) = ZERO +* +* Form right-hand side. +* + DO 190 K = KI + 2, N + WORK( K+(IV )*N ) = -WORK( KI +(IV )*N )*T(KI, K) + WORK( K+(IV+1)*N ) = -WORK( KI+1+(IV+1)*N )*T(KI+1,K) + 190 CONTINUE +* +* Solve transposed quasi-triangular system: +* [ T(KI+2:N,KI+2:N)**T - (WR-i*WI) ]*X = WORK1+i*WORK2 +* + VMAX = ONE + VCRIT = BIGNUM +* + JNXT = KI + 2 + DO 200 J = KI + 2, N + IF( J.LT.JNXT ) + $ GO TO 200 + J1 = J + J2 = J + JNXT = J + 1 + IF( J.LT.N ) THEN + IF( T( J+1, J ).NE.ZERO ) THEN + J2 = J + 1 + JNXT = J + 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* +* Scale if necessary to avoid overflow when +* forming the right-hand side elements. +* + IF( WORK( J ).GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK(KI+(IV )*N), 1 ) + CALL SSCAL( N-KI+1, REC, WORK(KI+(IV+1)*N), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+(IV )*N ) = WORK( J+(IV)*N ) - + $ SDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) + WORK( J+(IV+1)*N ) = WORK( J+(IV+1)*N ) - + $ SDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* +* Solve [ T(J,J)-(WR-i*WI) ]*(X11+i*X12)= WK+I*WK2 +* + CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ -WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( N-KI+1, SCALE, WORK(KI+(IV )*N), 1) + CALL SSCAL( N-KI+1, SCALE, WORK(KI+(IV+1)*N), 1) + END IF + WORK( J+(IV )*N ) = X( 1, 1 ) + WORK( J+(IV+1)*N ) = X( 1, 2 ) + VMAX = MAX( ABS( WORK( J+(IV )*N ) ), + $ ABS( WORK( J+(IV+1)*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + ELSE +* +* 2-by-2 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side elements. +* + BETA = MAX( WORK( J ), WORK( J+1 ) ) + IF( BETA.GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK(KI+(IV )*N), 1 ) + CALL SSCAL( N-KI+1, REC, WORK(KI+(IV+1)*N), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J +(IV )*N ) = WORK( J+(IV)*N ) - + $ SDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) +* + WORK( J +(IV+1)*N ) = WORK( J+(IV+1)*N ) - + $ SDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* + WORK( J+1+(IV )*N ) = WORK( J+1+(IV)*N ) - + $ SDOT( J-KI-2, T( KI+2, J+1 ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) +* + WORK( J+1+(IV+1)*N ) = WORK( J+1+(IV+1)*N ) - + $ SDOT( J-KI-2, T( KI+2, J+1 ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* +* Solve 2-by-2 complex linear equation +* [ (T(j,j) T(j,j+1) )**T - (wr-i*wi)*I ]*X = SCALE*B +* [ (T(j+1,j) T(j+1,j+1)) ] +* + CALL SLALN2( .TRUE., 2, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ -WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( N-KI+1, SCALE, WORK(KI+(IV )*N), 1) + CALL SSCAL( N-KI+1, SCALE, WORK(KI+(IV+1)*N), 1) + END IF + WORK( J +(IV )*N ) = X( 1, 1 ) + WORK( J +(IV+1)*N ) = X( 1, 2 ) + WORK( J+1+(IV )*N ) = X( 2, 1 ) + WORK( J+1+(IV+1)*N ) = X( 2, 2 ) + VMAX = MAX( ABS( X( 1, 1 ) ), ABS( X( 1, 2 ) ), + $ ABS( X( 2, 1 ) ), ABS( X( 2, 2 ) ), + $ VMAX ) + VCRIT = BIGNUM / VMAX +* + END IF + 200 CONTINUE +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL SCOPY( N-KI+1, WORK( KI + (IV )*N ), 1, + $ VL( KI, IS ), 1 ) + CALL SCOPY( N-KI+1, WORK( KI + (IV+1)*N ), 1, + $ VL( KI, IS+1 ), 1 ) +* + EMAX = ZERO + DO 220 K = KI, N + EMAX = MAX( EMAX, ABS( VL( K, IS ) )+ + $ ABS( VL( K, IS+1 ) ) ) + 220 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) + CALL SSCAL( N-KI+1, REMAX, VL( KI, IS+1 ), 1 ) +* + DO 230 K = 1, KI - 1 + VL( K, IS ) = ZERO + VL( K, IS+1 ) = ZERO + 230 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N-1 ) THEN + CALL SGEMV( 'N', N, N-KI-1, ONE, + $ VL( 1, KI+2 ), LDVL, + $ WORK( KI+2 + (IV)*N ), 1, + $ WORK( KI + (IV)*N ), + $ VL( 1, KI ), 1 ) + CALL SGEMV( 'N', N, N-KI-1, ONE, + $ VL( 1, KI+2 ), LDVL, + $ WORK( KI+2 + (IV+1)*N ), 1, + $ WORK( KI+1 + (IV+1)*N ), + $ VL( 1, KI+1 ), 1 ) + ELSE + CALL SSCAL( N, WORK(KI+ (IV )*N), VL(1, KI ), 1) + CALL SSCAL( N, WORK(KI+1+(IV+1)*N), VL(1, KI+1), 1) + END IF +* + EMAX = ZERO + DO 240 K = 1, N + EMAX = MAX( EMAX, ABS( VL( K, KI ) )+ + $ ABS( VL( K, KI+1 ) ) ) + 240 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( N, REMAX, VL( 1, KI ), 1 ) + CALL SSCAL( N, REMAX, VL( 1, KI+1 ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + (IV )*N ) = ZERO + WORK( K + (IV+1)*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP + ISCOMPLEX( IV+1 ) = -IP + IV = IV + 1 +* back-transform and normalization is done below + END IF + END IF + + IF( NB.GT.1 ) THEN +* -------------------------------------------------------- +* Blocked version of back-transform +* For complex case, KI2 includes both vectors (KI and KI+1) + IF( IP.EQ.0 ) THEN + KI2 = KI + ELSE + KI2 = KI + 1 + END IF + +* Columns 1:IV of work are valid vectors. +* When the number of vectors stored reaches NB-1 or NB, +* or if this was last vector, do the GEMM + IF( (IV.GE.NB-1) .OR. (KI2.EQ.N) ) THEN + CALL SGEMM( 'N', 'N', N, IV, N-KI2+IV, ONE, + $ VL( 1, KI2-IV+1 ), LDVL, + $ WORK( KI2-IV+1 + (1)*N ), N, + $ ZERO, + $ WORK( 1 + (NB+1)*N ), N ) +* normalize vectors + DO K = 1, IV + IF( ISCOMPLEX(K).EQ.0) THEN +* real eigenvector + II = ISAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / ABS( WORK( II + (NB+K)*N ) ) + ELSE IF( ISCOMPLEX(K).EQ.1) THEN +* first eigenvector of conjugate pair + EMAX = ZERO + DO II = 1, N + EMAX = MAX( EMAX, + $ ABS( WORK( II + (NB+K )*N ) )+ + $ ABS( WORK( II + (NB+K+1)*N ) ) ) + END DO + REMAX = ONE / EMAX +* else if ISCOMPLEX(K).EQ.-1 +* second eigenvector of conjugate pair +* reuse same REMAX as previous K + END IF + CALL SSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL SLACPY( 'F', N, IV, + $ WORK( 1 + (NB+1)*N ), N, + $ VL( 1, KI2-IV+1 ), LDVL ) + IV = 1 + ELSE + IV = IV + 1 + END IF + END IF ! blocked back-transform +* + IS = IS + 1 + IF( IP.NE.0 ) + $ IS = IS + 1 + 260 CONTINUE + END IF +* + RETURN +* +* End of STREVC3 +* + END diff --git a/lapack-netlib/SRC/zbbcsd.f b/lapack-netlib/SRC/zbbcsd.f index 0d6e218bb..18c4db0d0 100644 --- a/lapack-netlib/SRC/zbbcsd.f +++ b/lapack-netlib/SRC/zbbcsd.f @@ -149,7 +149,7 @@ *> \param[in,out] U1 *> \verbatim *> U1 is COMPLEX*16 array, dimension (LDU1,P) -*> On entry, an LDU1-by-P matrix. On exit, U1 is postmultiplied +*> On entry, a P-by-P matrix. On exit, U1 is postmultiplied *> by the left singular vector matrix common to [ B11 ; 0 ] and *> [ B12 0 0 ; 0 -I 0 0 ]. *> \endverbatim @@ -157,13 +157,13 @@ *> \param[in] LDU1 *> \verbatim *> LDU1 is INTEGER -*> The leading dimension of the array U1. +*> The leading dimension of the array U1, LDU1 >= MAX(1,P). *> \endverbatim *> *> \param[in,out] U2 *> \verbatim *> U2 is COMPLEX*16 array, dimension (LDU2,M-P) -*> On entry, an LDU2-by-(M-P) matrix. On exit, U2 is +*> On entry, an (M-P)-by-(M-P) matrix. On exit, U2 is *> postmultiplied by the left singular vector matrix common to *> [ B21 ; 0 ] and [ B22 0 0 ; 0 0 I ]. *> \endverbatim @@ -171,13 +171,13 @@ *> \param[in] LDU2 *> \verbatim *> LDU2 is INTEGER -*> The leading dimension of the array U2. +*> The leading dimension of the array U2, LDU2 >= MAX(1,M-P). *> \endverbatim *> *> \param[in,out] V1T *> \verbatim *> V1T is COMPLEX*16 array, dimension (LDV1T,Q) -*> On entry, a LDV1T-by-Q matrix. On exit, V1T is premultiplied +*> On entry, a Q-by-Q matrix. On exit, V1T is premultiplied *> by the conjugate transpose of the right singular vector *> matrix common to [ B11 ; 0 ] and [ B21 ; 0 ]. *> \endverbatim @@ -185,13 +185,13 @@ *> \param[in] LDV1T *> \verbatim *> LDV1T is INTEGER -*> The leading dimension of the array V1T. +*> The leading dimension of the array V1T, LDV1T >= MAX(1,Q). *> \endverbatim *> *> \param[in,out] V2T *> \verbatim *> V2T is COMPLEX*16 array, dimenison (LDV2T,M-Q) -*> On entry, a LDV2T-by-(M-Q) matrix. On exit, V2T is +*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is *> premultiplied by the conjugate transpose of the right *> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and *> [ B22 0 0 ; 0 0 I ]. @@ -200,7 +200,7 @@ *> \param[in] LDV2T *> \verbatim *> LDV2T is INTEGER -*> The leading dimension of the array V2T. +*> The leading dimension of the array V2T, LDV2T >= MAX(1,M-Q). *> \endverbatim *> *> \param[out] B11D @@ -322,7 +322,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -332,10 +332,10 @@ $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, RWORK, LRWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS diff --git a/lapack-netlib/SRC/zcgesv.f b/lapack-netlib/SRC/zcgesv.f index d7d0a9d28..493cc4164 100644 --- a/lapack-netlib/SRC/zcgesv.f +++ b/lapack-netlib/SRC/zcgesv.f @@ -170,7 +170,7 @@ *> -3 : failure of CGETRF *> -31: stop the iterative refinement after the 30th *> iterations -*> > 0: iterative refinement has been sucessfully used. +*> > 0: iterative refinement has been successfully used. *> Returns the number of iterations *> \endverbatim *> @@ -193,7 +193,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16GEsolve * @@ -201,10 +201,10 @@ SUBROUTINE ZCGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, $ SWORK, RWORK, ITER, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, ITER, LDA, LDB, LDX, N, NRHS diff --git a/lapack-netlib/SRC/zcposv.f b/lapack-netlib/SRC/zcposv.f index dfa114d96..4cf9f61e0 100644 --- a/lapack-netlib/SRC/zcposv.f +++ b/lapack-netlib/SRC/zcposv.f @@ -178,7 +178,7 @@ *> -3 : failure of CPOTRF *> -31: stop the iterative refinement after the 30th *> iterations -*> > 0: iterative refinement has been sucessfully used. +*> > 0: iterative refinement has been successfully used. *> Returns the number of iterations *> \endverbatim *> @@ -201,7 +201,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16POsolve * @@ -209,10 +209,10 @@ SUBROUTINE ZCPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, $ SWORK, RWORK, ITER, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/zgbequb.f b/lapack-netlib/SRC/zgbequb.f index 3dce529cd..3c53046bf 100644 --- a/lapack-netlib/SRC/zgbequb.f +++ b/lapack-netlib/SRC/zgbequb.f @@ -84,7 +84,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) +*> AB is COMPLEX*16 array, dimension (LDAB,N) *> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. *> The j-th column of A is stored in the j-th column of the *> array AB as follows: @@ -153,7 +153,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16GBcomputational * @@ -161,10 +161,10 @@ SUBROUTINE ZGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, $ AMAX, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, KL, KU, LDAB, M, N diff --git a/lapack-netlib/SRC/zgbrfsx.f b/lapack-netlib/SRC/zgbrfsx.f index 2b81d403b..14972ebb1 100644 --- a/lapack-netlib/SRC/zgbrfsx.f +++ b/lapack-netlib/SRC/zgbrfsx.f @@ -195,7 +195,7 @@ *> *> \param[in] B *> \verbatim -*> B is DOUBLE PRECISION array, dimension (LDB,NRHS) +*> B is COMPLEX*16 array, dimension (LDB,NRHS) *> The right hand side matrix B. *> \endverbatim *> @@ -232,7 +232,7 @@ *> *> \param[out] BERR *> \verbatim -*> BERR is COMPLEX*16 array, dimension (NRHS) +*> BERR is DOUBLE PRECISION array, dimension (NRHS) *> Componentwise relative backward error. This is the *> componentwise relative backward error of each solution vector X(j) *> (i.e., the smallest relative change in any element of A or B that @@ -440,7 +440,7 @@ $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.1) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -642,7 +642,7 @@ * * Perform refinement on each right-hand side * - IF ( REF_TYPE .NE. 0 ) THEN + IF ( REF_TYPE .NE. 0 .AND. INFO .EQ. 0 ) THEN PREC_TYPE = ILAPREC( 'E' ) diff --git a/lapack-netlib/SRC/zgeesx.f b/lapack-netlib/SRC/zgeesx.f index 4cf4ef319..7868245e7 100644 --- a/lapack-netlib/SRC/zgeesx.f +++ b/lapack-netlib/SRC/zgeesx.f @@ -83,7 +83,7 @@ *> *> \param[in] SELECT *> \verbatim -*> SELECT is procedure) LOGICAL FUNCTION of one COMPLEX*16 argument +*> SELECT is a LOGICAL FUNCTION of one COMPLEX*16 argument *> SELECT must be declared EXTERNAL in the calling subroutine. *> If SORT = 'S', SELECT is used to select eigenvalues to order *> to the top left of the Schur form. @@ -230,7 +230,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16GEeigen * @@ -239,10 +239,10 @@ $ VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, $ BWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVS, SENSE, SORT diff --git a/lapack-netlib/SRC/zgeev.f b/lapack-netlib/SRC/zgeev.f index a518b4cd9..1fb35a175 100644 --- a/lapack-netlib/SRC/zgeev.f +++ b/lapack-netlib/SRC/zgeev.f @@ -169,18 +169,21 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 +* +* @precisions fortran z -> c * *> \ingroup complex16GEeigen * * ===================================================================== SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, $ WORK, LWORK, RWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVL, JOBVR @@ -202,7 +205,7 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU, - $ IWRK, K, MAXWRK, MINWRK, NOUT + $ IWRK, K, LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM COMPLEX*16 TMP * .. @@ -212,7 +215,7 @@ * .. * .. External Subroutines .. EXTERNAL DLABAD, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, - $ ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, ZUNGHR + $ ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZUNGHR * .. * .. External Functions .. LOGICAL LSAME @@ -221,7 +224,7 @@ EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE * .. * .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, DCONJG, DIMAG, MAX, SQRT + INTRINSIC DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * @@ -266,18 +269,28 @@ IF( WANTVL ) THEN MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR', $ ' ', N, 1, N, -1 ) ) + CALL ZTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR', $ ' ', N, 1, N, -1 ) ) + CALL ZTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) ELSE CALL ZHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, HSWORK, MINWRK ) END IF WORK( 1 ) = MAXWRK @@ -412,12 +425,13 @@ IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (CWorkspace: need 2*N) +* (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need 2*N) * IRWORK = IBAL + N - CALL ZTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), RWORK( IRWORK ), IERR ) + CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, + $ RWORK( IRWORK ), N, IERR ) END IF * IF( WANTVL ) THEN @@ -436,10 +450,10 @@ CALL ZDSCAL( N, SCL, VL( 1, I ), 1 ) DO 10 K = 1, N RWORK( IRWORK+K-1 ) = DBLE( VL( K, I ) )**2 + - $ DIMAG( VL( K, I ) )**2 + $ AIMAG( VL( K, I ) )**2 10 CONTINUE K = IDAMAX( N, RWORK( IRWORK ), 1 ) - TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) + TMP = CONJG( VL( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) CALL ZSCAL( N, TMP, VL( 1, I ), 1 ) VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO ) 20 CONTINUE @@ -461,10 +475,10 @@ CALL ZDSCAL( N, SCL, VR( 1, I ), 1 ) DO 30 K = 1, N RWORK( IRWORK+K-1 ) = DBLE( VR( K, I ) )**2 + - $ DIMAG( VR( K, I ) )**2 + $ AIMAG( VR( K, I ) )**2 30 CONTINUE K = IDAMAX( N, RWORK( IRWORK ), 1 ) - TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) + TMP = CONJG( VR( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) CALL ZSCAL( N, TMP, VR( 1, I ), 1 ) VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO ) 40 CONTINUE diff --git a/lapack-netlib/SRC/zgeevx.f b/lapack-netlib/SRC/zgeevx.f index 402eec799..752d0328e 100644 --- a/lapack-netlib/SRC/zgeevx.f +++ b/lapack-netlib/SRC/zgeevx.f @@ -276,7 +276,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 +* +* @precisions fortran z -> c * *> \ingroup complex16GEeigen * @@ -284,11 +286,12 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, $ LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, $ RCONDV, WORK, LWORK, RWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER BALANC, JOBVL, JOBVR, SENSE @@ -312,8 +315,8 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK, - $ MINWRK, NOUT + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM COMPLEX*16 TMP * .. @@ -323,7 +326,7 @@ * .. * .. External Subroutines .. EXTERNAL DLABAD, DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, - $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, + $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, $ ZTRSNA, ZUNGHR * .. * .. External Functions .. @@ -333,7 +336,7 @@ EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE * .. * .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, DCONJG, DIMAG, MAX, SQRT + INTRINSIC DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * @@ -387,9 +390,19 @@ MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 ) * IF( WANTVL ) THEN + CALL ZTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, LWORK_TREVC ) CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN + CALL ZTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, LWORK_TREVC ) CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR, $ WORK, -1, INFO ) ELSE @@ -401,7 +414,7 @@ $ WORK, -1, INFO ) END IF END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) * IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN MINWRK = 2*N @@ -559,19 +572,20 @@ $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * -* If INFO > 0 from ZHSEQR, then quit +* If INFO .NE. 0 from ZHSEQR, then quit * - IF( INFO.GT.0 ) + IF( INFO.NE.0 ) $ GO TO 50 * IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (CWorkspace: need 2*N) +* (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need N) * - CALL ZTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), RWORK, IERR ) + CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, + $ RWORK, N, IERR ) END IF * * Compute condition numbers if desired @@ -598,10 +612,10 @@ CALL ZDSCAL( N, SCL, VL( 1, I ), 1 ) DO 10 K = 1, N RWORK( K ) = DBLE( VL( K, I ) )**2 + - $ DIMAG( VL( K, I ) )**2 + $ AIMAG( VL( K, I ) )**2 10 CONTINUE K = IDAMAX( N, RWORK, 1 ) - TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( K ) ) + TMP = CONJG( VL( K, I ) ) / SQRT( RWORK( K ) ) CALL ZSCAL( N, TMP, VL( 1, I ), 1 ) VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO ) 20 CONTINUE @@ -621,10 +635,10 @@ CALL ZDSCAL( N, SCL, VR( 1, I ), 1 ) DO 30 K = 1, N RWORK( K ) = DBLE( VR( K, I ) )**2 + - $ DIMAG( VR( K, I ) )**2 + $ AIMAG( VR( K, I ) )**2 30 CONTINUE K = IDAMAX( N, RWORK, 1 ) - TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( K ) ) + TMP = CONJG( VR( K, I ) ) / SQRT( RWORK( K ) ) CALL ZSCAL( N, TMP, VR( 1, I ), 1 ) VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO ) 40 CONTINUE diff --git a/lapack-netlib/SRC/zgejsv.f b/lapack-netlib/SRC/zgejsv.f index 62274f3a2..ad47a4079 100644 --- a/lapack-netlib/SRC/zgejsv.f +++ b/lapack-netlib/SRC/zgejsv.f @@ -27,7 +27,7 @@ * INTEGER INFO, LDA, LDU, LDV, LWORK, M, N * .. * .. Array Arguments .. -* DOUBLE COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK ) +* COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK ) * DOUBLE PRECISION SVA( N ), RWORK( LRWORK ) * INTEGER IWORK( * ) * CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV @@ -39,21 +39,22 @@ *> *> \verbatim *> -* ZGEJSV computes the singular value decomposition (SVD) of a real M-by-N -* matrix [A], where M >= N. The SVD of [A] is written as -* -* [A] = [U] * [SIGMA] * [V]^*, -* -* where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N -* diagonal elements, [U] is an M-by-N (or M-by-M) orthonormal matrix, and -* [V] is an N-by-N orthogonal matrix. The diagonal elements of [SIGMA] are -* the singular values of [A]. The columns of [U] and [V] are the left and -* the right singular vectors of [A], respectively. The matrices [U] and [V] -* are computed and stored in the arrays U and V, respectively. The diagonal -* of [SIGMA] is computed and stored in the array SVA. -* -* Arguments: -* ========== +*> ZGEJSV computes the singular value decomposition (SVD) of a complex M-by-N +*> matrix [A], where M >= N. The SVD of [A] is written as +*> +*> [A] = [U] * [SIGMA] * [V]^*, +*> +*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N +*> diagonal elements, [U] is an M-by-N (or M-by-M) unitary matrix, and +*> [V] is an N-by-N unitary matrix. The diagonal elements of [SIGMA] are +*> the singular values of [A]. The columns of [U] and [V] are the left and +*> the right singular vectors of [A], respectively. The matrices [U] and [V] +*> are computed and stored in the arrays U and V, respectively. The diagonal +*> of [SIGMA] is computed and stored in the array SVA. +*> \endverbatim +*> +*> Arguments: +*> ========== *> *> \param[in] JOBA *> \verbatim @@ -193,7 +194,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is DOUBLE COMPLEX array, dimension (LDA,N) +*> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> \endverbatim *> @@ -221,7 +222,7 @@ *> *> \param[out] U *> \verbatim -*> U is DOUBLE COMPLEX array, dimension ( LDU, N ) +*> U is COMPLEX*16 array, dimension ( LDU, N ) *> If JOBU = 'U', then U contains on exit the M-by-N matrix of *> the left singular vectors. *> If JOBU = 'F', then U contains on exit the M-by-M matrix of @@ -234,7 +235,7 @@ *> copied back to the V array. This 'W' option is just *> a reminder to the caller that in this case U is *> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced. +*> If JOBU = 'N' U is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDU @@ -246,7 +247,7 @@ *> *> \param[out] V *> \verbatim -*> V is DOUBLE COMPLEX array, dimension ( LDV, N ) +*> V is COMPLEX*16 array, dimension ( LDV, N ) *> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of *> the right singular vectors; *> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N), @@ -256,7 +257,7 @@ *> copied back to the U array. This 'W' option is just *> a reminder to the caller that in this case V is *> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced. +*> If JOBV = 'N' V is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDV @@ -268,8 +269,7 @@ *> *> \param[out] CWORK *> \verbatim -*> CWORK (workspace) -*> CWORK is DOUBLE COMPLEX array, dimension at least LWORK. +*> CWORK is COMPLEX*16 array, dimension at least LWORK. *> \endverbatim *> *> \param[in] LWORK @@ -279,7 +279,7 @@ *> LWORK depends on the job: *> *> 1. If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and -*> 1.1 .. no scaled condition estimate required (JOBE.EQ.'N'): +*> 1.1 .. no scaled condition estimate required (JOBA.NE.'E'.AND.JOBA.NE.'G'): *> LWORK >= 2*N+1. This is the minimal requirement. *> ->> For optimal performance (blocked code) the optimal value *> is LWORK >= N + (N+1)*NB. Here NB is the optimal @@ -293,33 +293,33 @@ *> is LWORK >= max(N+(N+1)*NB, N*N+3*N). *> In general, the optimal length LWORK is computed as *> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZGEQRF), -*> N+N*N+LWORK(CPOCON)). +*> N+N*N+LWORK(ZPOCON)). *> *> 2. If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'), *> (JOBU.EQ.'N') *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance, LWORK >= max(N+(N+1)*NB, 3*N,2*N+N*NB), -*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZGELQ, -*> CUNMLQ. In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(ZGEQP3), N+LWORK(CPOCON), N+LWORK(ZGESVJ), -*> N+LWORK(ZGELQF), 2*N+LWORK(ZGEQRF), N+LWORK(CUNMLQ)). +*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZGELQF, +*> ZUNMLQ. In general, the optimal length LWORK is computed as +*> LWORK >= max(N+LWORK(ZGEQP3), N+LWORK(ZPOCON), N+LWORK(ZGESVJ), +*> N+LWORK(ZGELQF), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMLQ)). *> *> 3. If SIGMA and the left singular vectors are needed *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance: *> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB), -*> where NB is the optimal block size for ZGEQP3, ZGEQRF, CUNMQR. +*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZUNMQR. *> In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(CPOCON), -*> 2*N+LWORK(ZGEQRF), N+LWORK(CUNMQR)). +*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZPOCON), +*> 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMQR)). *> *> 4. If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and *> 4.1. if JOBV.EQ.'V' *> the minimal requirement is LWORK >= 5*N+2*N*N. *> 4.2. if JOBV.EQ.'J' the minimal requirement is *> LWORK >= 4*N+N*N. -*> In both cases, the allocated CWORK can accomodate blocked runs -*> of ZGEQP3, ZGEQRF, ZGELQF, SUNMQR, CUNMLQ. +*> In both cases, the allocated CWORK can accommodate blocked runs +*> of ZGEQP3, ZGEQRF, ZGELQF, ZUNMQR, ZUNMLQ. *> \endverbatim *> *> \param[out] RWORK @@ -433,7 +433,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16GEsing * @@ -491,19 +491,19 @@ *> *> \verbatim *> -* [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I. -* SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342. -* LAPACK Working note 169. -* [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II. -* SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362. -* LAPACK Working note 170. -* [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR -* factorization software - a case study. -* ACM Trans. math. Softw. Vol. 35, No 2 (2008), pp. 1-28. -* LAPACK Working note 176. -* [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, -* QSVD, (H,K)-SVD computations. -* Department of Mathematics, University of Zagreb, 2008. +*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I. +*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342. +*> LAPACK Working note 169. +*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II. +*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362. +*> LAPACK Working note 170. +*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR +*> factorization software - a case study. +*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28. +*> LAPACK Working note 176. +*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, +*> QSVD, (H,K)-SVD computations. +*> Department of Mathematics, University of Zagreb, 2008. *> \endverbatim * *> \par Bugs, examples and comments: @@ -517,17 +517,17 @@ $ M, N, A, LDA, SVA, U, LDU, V, LDV, $ CWORK, LWORK, RWORK, LRWORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. IMPLICIT NONE INTEGER INFO, LDA, LDU, LDV, LWORK, LRWORK, M, N * .. * .. Array Arguments .. - DOUBLE COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), + COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ), $ CWORK( LWORK ) DOUBLE PRECISION SVA( N ), RWORK( * ) INTEGER IWORK( * ) @@ -539,11 +539,11 @@ * .. Local Parameters .. DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) - DOUBLE COMPLEX CZERO, CONE + COMPLEX*16 CZERO, CONE PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ), CONE = ( 1.0D0, 0.0D0 ) ) * .. * .. Local Scalars .. - DOUBLE COMPLEX CTEMP + COMPLEX*16 CTEMP DOUBLE PRECISION AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1, $ COND_OK, CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN, $ MAXPRJ, SCALEM, SCONDA, SFMIN, SMALL, TEMP1, @@ -554,18 +554,18 @@ $ NOSCAL, ROWPIV, RSVEC, TRANSP * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DCMPLX, DCONJG, DLOG, DMAX1, DMIN1, DFLOAT, + INTRINSIC ABS, DCMPLX, DCONJG, DLOG, DMAX1, DMIN1, DBLE, $ MAX0, MIN0, NINT, DSQRT * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, DZNRM2 - INTEGER IDAMAX + INTEGER IDAMAX, IZAMAX LOGICAL LSAME - EXTERNAL IDAMAX, LSAME, DLAMCH, DZNRM2 + EXTERNAL IDAMAX, IZAMAX, LSAME, DLAMCH, DZNRM2 * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZGELQF, ZGEQP3, ZGEQRF, ZLACPY, ZLASCL, - $ ZLASET, ZLASSQ, ZLASWP, ZUNGQR, ZUNMLQ, + EXTERNAL DLASSQ, ZCOPY, ZGELQF, ZGEQP3, ZGEQRF, ZLACPY, ZLASCL, + $ DLASCL, ZLASET, ZLASSQ, ZLASWP, ZUNGQR, ZUNMLQ, $ ZUNMQR, ZPOCON, DSCAL, ZDSCAL, ZSWAP, ZTRSM, XERBLA * EXTERNAL ZGESVJ @@ -640,7 +640,11 @@ * * Quick return for void matrix (Y3K safe) * #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) RETURN + IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN + IWORK(1:3) = 0 + RWORK(1:7) = 0 + RETURN + ENDIF * * Determine whether the matrix U should be M x N or M x M * @@ -665,7 +669,7 @@ * overflow. It is possible that this scaling pushes the smallest * column norm left from the underflow threshold (extreme case). * - SCALEM = ONE / DSQRT(DFLOAT(M)*DFLOAT(N)) + SCALEM = ONE / DSQRT(DBLE(M)*DBLE(N)) NOSCAL = .TRUE. GOSCAL = .TRUE. DO 1874 p = 1, N @@ -807,7 +811,7 @@ 1950 CONTINUE ELSE DO 1904 p = 1, M - RWORK(M+N+p) = SCALEM*ABS( A(p,IDAMAX(N,A(p,1),LDA)) ) + RWORK(M+N+p) = SCALEM*ABS( A(p,IZAMAX(N,A(p,1),LDA)) ) AATMAX = DMAX1( AATMAX, RWORK(M+N+p) ) AATMIN = DMIN1( AATMIN, RWORK(M+N+p) ) 1904 CONTINUE @@ -828,7 +832,7 @@ * XSC = ZERO TEMP1 = ONE - CALL ZLASSQ( N, SVA, 1, XSC, TEMP1 ) + CALL DLASSQ( N, SVA, 1, XSC, TEMP1 ) TEMP1 = ONE / TEMP1 * ENTRA = ZERO @@ -836,7 +840,7 @@ BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1 IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * DLOG(BIG1) 1113 CONTINUE - ENTRA = - ENTRA / DLOG(DFLOAT(N)) + ENTRA = - ENTRA / DLOG(DBLE(N)) * * Now, SVA().^2/Trace(A^* * A) is a point in the probability simplex. * It is derived from the diagonal of A^* * A. Do the same with the @@ -849,7 +853,7 @@ BIG1 = ( ( RWORK(p) / XSC )**2 ) * TEMP1 IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * DLOG(BIG1) 1114 CONTINUE - ENTRAT = - ENTRAT / DLOG(DFLOAT(M)) + ENTRAT = - ENTRAT / DLOG(DBLE(M)) * * Analyze the entropies and decide A or A^*. Smaller entropy * usually means better input for the algorithm. @@ -905,9 +909,9 @@ * one should use ZGESVJ instead of ZGEJSV. * BIG1 = DSQRT( BIG ) - TEMP1 = DSQRT( BIG / DFLOAT(N) ) + TEMP1 = DSQRT( BIG / DBLE(N) ) * - CALL ZLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) + CALL DLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN AAQQ = ( AAQQ / AAPP ) * TEMP1 ELSE @@ -1009,7 +1013,7 @@ * sigma_i < N*EPSLN*||A|| are flushed to zero. This is an * agressive enforcement of lower numerical rank by introducing a * backward error of the order of N*EPSLN*||A||. - TEMP1 = DSQRT(DFLOAT(N))*EPSLN + TEMP1 = DSQRT(DBLE(N))*EPSLN DO 3001 p = 2, N IF ( ABS(A(p,p)) .GE. (TEMP1*ABS(A(1,1))) ) THEN NR = NR + 1 @@ -1056,7 +1060,7 @@ TEMP1 = ABS(A(p,p)) / SVA(IWORK(p)) MAXPRJ = DMIN1( MAXPRJ, TEMP1 ) 3051 CONTINUE - IF ( MAXPRJ**2 .GE. ONE - DFLOAT(N)*EPSLN ) ALMORT = .TRUE. + IF ( MAXPRJ**2 .GE. ONE - DBLE(N)*EPSLN ) ALMORT = .TRUE. END IF * * @@ -1136,7 +1140,7 @@ * IF ( L2PERT ) THEN * XSC = SQRT(SMALL) - XSC = EPSLN / DFLOAT(N) + XSC = EPSLN / DBLE(N) DO 4947 q = 1, NR CTEMP = DCMPLX(XSC*ABS(A(q,q)),ZERO) DO 4949 p = 1, N @@ -1168,7 +1172,7 @@ * to drown denormals IF ( L2PERT ) THEN * XSC = SQRT(SMALL) - XSC = EPSLN / DFLOAT(N) + XSC = EPSLN / DBLE(N) DO 1947 q = 1, NR CTEMP = DCMPLX(XSC*ABS(A(q,q)),ZERO) DO 1949 p = 1, NR @@ -1226,7 +1230,7 @@ CALL ZCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 ) CALL ZLACGV( NR-p+1, V(p,p), 1 ) 8998 CONTINUE - CALL ZLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL ZLASET('Upper', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV) * CALL ZGESVJ( 'Lower', 'U','N', NR, NR, V,LDV, SVA, NR, U, $ LDU, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO ) @@ -1363,10 +1367,10 @@ CONDR1 = ONE / DSQRT(TEMP1) * .. here need a second oppinion on the condition number * .. then assume worst case scenario -* R1 is OK for inverse <=> CONDR1 .LT. DFLOAT(N) -* more conservative <=> CONDR1 .LT. SQRT(DFLOAT(N)) +* R1 is OK for inverse <=> CONDR1 .LT. DBLE(N) +* more conservative <=> CONDR1 .LT. SQRT(DBLE(N)) * - COND_OK = DSQRT(DSQRT(DFLOAT(NR))) + COND_OK = DSQRT(DSQRT(DBLE(NR))) *[TP] COND_OK is a tuning parameter. * IF ( CONDR1 .LT. COND_OK ) THEN @@ -1521,9 +1525,9 @@ CALL ZTRSM('L','U','C','N',NR,NR,CONE,CWORK(2*N+1), $ N,V,LDV) IF ( NR .LT. N ) THEN - CALL ZLASET('A',N-NR,NR,ZERO,CZERO,V(NR+1,1),LDV) - CALL ZLASET('A',NR,N-NR,ZERO,CZERO,V(1,NR+1),LDV) - CALL ZLASET('A',N-NR,N-NR,ZERO,CONE,V(NR+1,NR+1),LDV) + CALL ZLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV) + CALL ZLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV) + CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) END IF CALL ZUNMQR('L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR) @@ -1605,7 +1609,7 @@ * first QRF. Also, scale the columns to make them unit in * Euclidean norm. This applies to all cases. * - TEMP1 = DSQRT(DFLOAT(N)) * EPSLN + TEMP1 = DSQRT(DBLE(N)) * EPSLN DO 1972 q = 1, N DO 972 p = 1, N CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q) @@ -1635,7 +1639,7 @@ $ LDU, CWORK(N+1), LWORK-N, IERR ) * The columns of U are normalized. The cost is O(M*N) flops. - TEMP1 = DSQRT(DFLOAT(M)) * EPSLN + TEMP1 = DSQRT(DBLE(M)) * EPSLN DO 1973 p = 1, NR XSC = ONE / DZNRM2( M, U(1,p), 1 ) IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) @@ -1684,7 +1688,7 @@ DO 6972 p = 1, N CALL ZCOPY( N, CWORK(N+p), N, V(IWORK(p),1), LDV ) 6972 CONTINUE - TEMP1 = DSQRT(DFLOAT(N))*EPSLN + TEMP1 = DSQRT(DBLE(N))*EPSLN DO 6971 p = 1, N XSC = ONE / DZNRM2( N, V(1,p), 1 ) IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) @@ -1702,7 +1706,7 @@ END IF CALL ZUNMQR( 'Left', 'No Tr', M, N1, N, A, LDA, CWORK, U, $ LDU, CWORK(N+1), LWORK-N, IERR ) - TEMP1 = DSQRT(DFLOAT(M))*EPSLN + TEMP1 = DSQRT(DBLE(M))*EPSLN DO 6973 p = 1, N1 XSC = ONE / DZNRM2( M, U(1,p), 1 ) IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) @@ -1779,9 +1783,9 @@ NUMRANK = NINT(RWORK(2)) IF ( NR .LT. N ) THEN - CALL ZLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) - CALL ZLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL ZLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) + CALL ZLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV ) + CALL ZLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV ) + CALL ZLASET( 'A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV ) END IF CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), @@ -1791,7 +1795,7 @@ * first QRF. Also, scale the columns to make them unit in * Euclidean norm. This applies to all cases. * - TEMP1 = DSQRT(DFLOAT(N)) * EPSLN + TEMP1 = DSQRT(DBLE(N)) * EPSLN DO 7972 q = 1, N DO 8972 p = 1, N CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q) @@ -1836,7 +1840,7 @@ * Undo scaling, if necessary (and possible) * IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL ZLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) + CALL DLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) USCAL1 = ONE USCAL2 = ONE END IF diff --git a/lapack-netlib/SRC/zgelss.f b/lapack-netlib/SRC/zgelss.f index 56e58ddfe..b99535a64 100644 --- a/lapack-netlib/SRC/zgelss.f +++ b/lapack-netlib/SRC/zgelss.f @@ -170,7 +170,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16GEsolve * @@ -178,10 +178,10 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK @@ -285,8 +285,8 @@ * Path 1 - overdetermined or exactly determined * * Compute space needed for ZGEBRD - CALL ZGEBRD( MM, N, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL ZGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), DUM(1), + $ -1, INFO ) LWORK_ZGEBRD=DUM(1) * Compute space needed for ZUNMBR CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, DUM(1), @@ -315,8 +315,8 @@ $ -1, INFO ) LWORK_ZGELQF=DUM(1) * Compute space needed for ZGEBRD - CALL ZGEBRD( M, M, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL ZGEBRD( M, M, A, LDA, S, S, DUM(1), DUM(1), + $ DUM(1), -1, INFO ) LWORK_ZGEBRD=DUM(1) * Compute space needed for ZUNMBR CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, @@ -346,8 +346,8 @@ * Path 2 - underdetermined * * Compute space needed for ZGEBRD - CALL ZGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL ZGEBRD( M, N, A, LDA, S, S, DUM(1), DUM(1), + $ DUM(1), -1, INFO ) LWORK_ZGEBRD=DUM(1) * Compute space needed for ZUNMBR CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, M, A, LDA, diff --git a/lapack-netlib/SRC/zgeqrt3.f b/lapack-netlib/SRC/zgeqrt3.f index 8926b9980..6995a289c 100644 --- a/lapack-netlib/SRC/zgeqrt3.f +++ b/lapack-netlib/SRC/zgeqrt3.f @@ -100,7 +100,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16GEcomputational * @@ -132,10 +132,10 @@ * ===================================================================== RECURSIVE SUBROUTINE ZGEQRT3( M, N, A, LDA, T, LDT, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, LDT @@ -177,7 +177,7 @@ * * Compute Householder transform when N=1 * - CALL ZLARFG( M, A, A( MIN( 2, M ), 1 ), 1, T ) + CALL ZLARFG( M, A(1,1), A( MIN( 2, M ), 1 ), 1, T(1,1) ) * ELSE * diff --git a/lapack-netlib/SRC/zgesdd.f b/lapack-netlib/SRC/zgesdd.f index ea08dbc6d..4f3201756 100644 --- a/lapack-netlib/SRC/zgesdd.f +++ b/lapack-netlib/SRC/zgesdd.f @@ -18,8 +18,8 @@ * Definition: * =========== * -* SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, -* LWORK, RWORK, IWORK, INFO ) +* SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, +* WORK, LWORK, RWORK, IWORK, INFO ) * * .. Scalar Arguments .. * CHARACTER JOBZ @@ -135,8 +135,8 @@ *> \param[in] LDU *> \verbatim *> LDU is INTEGER -*> The leading dimension of the array U. LDU >= 1; if -*> JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M. +*> The leading dimension of the array U. LDU >= 1; +*> if JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M. *> \endverbatim *> *> \param[out] VT @@ -152,8 +152,8 @@ *> \param[in] LDVT *> \verbatim *> LDVT is INTEGER -*> The leading dimension of the array VT. LDVT >= 1; if -*> JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; +*> The leading dimension of the array VT. LDVT >= 1; +*> if JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; *> if JOBZ = 'S', LDVT >= min(M,N). *> \endverbatim *> @@ -167,24 +167,28 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 1. -*> if JOBZ = 'N', LWORK >= 2*min(M,N)+max(M,N). -*> if JOBZ = 'O', -*> LWORK >= 2*min(M,N)*min(M,N)+2*min(M,N)+max(M,N). -*> if JOBZ = 'S' or 'A', -*> LWORK >= min(M,N)*min(M,N)+2*min(M,N)+max(M,N). -*> For good performance, LWORK should generally be larger. -*> *> If LWORK = -1, a workspace query is assumed. The optimal *> size for the WORK array is calculated and stored in WORK(1), *> and no other work except argument checking is performed. +*> +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LWORK >= 2*mn + mx. +*> If JOBZ = 'O', LWORK >= 2*mn*mn + 2*mn + mx. +*> If JOBZ = 'S', LWORK >= mn*mn + 3*mn. +*> If JOBZ = 'A', LWORK >= mn*mn + 2*mn + mx. +*> These are not tight minimums in all cases; see comments inside code. +*> For good performance, LWORK should generally be larger; +*> a query is recommended. *> \endverbatim *> *> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK)) -*> If JOBZ = 'N', LRWORK >= 7*min(M,N). -*> Otherwise, -*> LRWORK >= min(M,N)*max(5*min(M,N)+7,2*max(M,N)+2*min(M,N)+1) +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LRWORK >= 5*mn (LAPACK <= 3.6 needs 7*mn); +*> else if mx >> mn, LRWORK >= 5*mn*mn + 5*mn; +*> else LRWORK >= max( 5*mn*mn + 5*mn, +*> 2*mx*mn + 2*mn*mn + mn ). *> \endverbatim *> *> \param[out] IWORK @@ -208,7 +212,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16GEsing * @@ -218,14 +222,16 @@ *> Ming Gu and Huan Ren, Computer Science Division, University of *> California at Berkeley, USA *> +*> @precisions fortran z -> c * ===================================================================== - SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, - $ LWORK, RWORK, IWORK, INFO ) + SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, + $ WORK, LWORK, RWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ @@ -241,8 +247,6 @@ * ===================================================================== * * .. Parameters .. - INTEGER LQUERV - PARAMETER ( LQUERV = -1 ) COMPLEX*16 CZERO, CONE PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), $ CONE = ( 1.0D+0, 0.0D+0 ) ) @@ -250,16 +254,27 @@ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) * .. * .. Local Scalars .. - LOGICAL WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS + LOGICAL LQUERY, WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS INTEGER BLK, CHUNK, I, IE, IERR, IL, IR, IRU, IRVT, $ ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT, $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK, $ MNTHR1, MNTHR2, NRWORK, NWORK, WRKBL + INTEGER LWORK_ZGEBRD_MN, LWORK_ZGEBRD_MM, + $ LWORK_ZGEBRD_NN, LWORK_ZGELQF_MN, + $ LWORK_ZGEQRF_MN, + $ LWORK_ZUNGBR_P_MN, LWORK_ZUNGBR_P_NN, + $ LWORK_ZUNGBR_Q_MN, LWORK_ZUNGBR_Q_MM, + $ LWORK_ZUNGLQ_MN, LWORK_ZUNGLQ_NN, + $ LWORK_ZUNGQR_MM, LWORK_ZUNGQR_MN, + $ LWORK_ZUNMBR_PRC_MM, LWORK_ZUNMBR_QLN_MM, + $ LWORK_ZUNMBR_PRC_MN, LWORK_ZUNMBR_QLN_MN, + $ LWORK_ZUNMBR_PRC_NN, LWORK_ZUNMBR_QLN_NN DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. INTEGER IDUM( 1 ) DOUBLE PRECISION DUM( 1 ) + COMPLEX*16 CDUM( 1 ) * .. * .. External Subroutines .. EXTERNAL DBDSDC, DLASCL, XERBLA, ZGEBRD, ZGELQF, ZGEMM, @@ -268,9 +283,8 @@ * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV DOUBLE PRECISION DLAMCH, ZLANGE - EXTERNAL LSAME, ILAENV, DLAMCH, ZLANGE + EXTERNAL LSAME, DLAMCH, ZLANGE * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -279,15 +293,16 @@ * * Test the input arguments * - INFO = 0 - MINMN = MIN( M, N ) + INFO = 0 + MINMN = MIN( M, N ) MNTHR1 = INT( MINMN*17.0D0 / 9.0D0 ) MNTHR2 = INT( MINMN*5.0D0 / 3.0D0 ) - WNTQA = LSAME( JOBZ, 'A' ) - WNTQS = LSAME( JOBZ, 'S' ) + WNTQA = LSAME( JOBZ, 'A' ) + WNTQS = LSAME( JOBZ, 'S' ) WNTQAS = WNTQA .OR. WNTQS - WNTQO = LSAME( JOBZ, 'O' ) - WNTQN = LSAME( JOBZ, 'N' ) + WNTQO = LSAME( JOBZ, 'O' ) + WNTQN = LSAME( JOBZ, 'N' ) + LQUERY = ( LWORK.EQ.-1 ) MINWRK = 1 MAXWRK = 1 * @@ -309,8 +324,8 @@ END IF * * Compute workspace -* (Note: Comments in the code beginning "Workspace:" describe the -* minimal amount of workspace needed at that point in the code, +* Note: Comments in the code beginning "Workspace:" describe the +* minimal amount of workspace allocated at that point in the code, * as well as the preferred amount for good performance. * CWorkspace refers to complex workspace, and RWorkspace to * real workspace. NB refers to the optimal block size for the @@ -320,233 +335,283 @@ IF( M.GE.N ) THEN * * There is no complex work space needed for bidiagonal SVD -* The real work space needed for bidiagonal SVD is BDSPAC -* for computing singular values and singular vectors; BDSPAN -* for computing singular values only. -* BDSPAC = 5*N*N + 7*N -* BDSPAN = MAX(7*N+4, 3*N+2+SMLSIZ*(SMLSIZ+8)) +* The real work space needed for bidiagonal SVD (dbdsdc) is +* BDSPAC = 3*N*N + 4*N for singular values and vectors; +* BDSPAC = 4*N for singular values only; +* not including e, RU, and RVT matrices. +* +* Compute space preferred for each routine + CALL ZGEBRD( M, N, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGEBRD_MN = INT( CDUM(1) ) +* + CALL ZGEBRD( N, N, CDUM(1), N, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGEBRD_NN = INT( CDUM(1) ) +* + CALL ZGEQRF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGEQRF_MN = INT( CDUM(1) ) +* + CALL ZUNGBR( 'P', N, N, N, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_P_NN = INT( CDUM(1) ) +* + CALL ZUNGBR( 'Q', M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_Q_MM = INT( CDUM(1) ) +* + CALL ZUNGBR( 'Q', M, N, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_Q_MN = INT( CDUM(1) ) +* + CALL ZUNGQR( M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGQR_MM = INT( CDUM(1) ) +* + CALL ZUNGQR( M, N, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGQR_MN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'P', 'R', 'C', N, N, N, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_PRC_NN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'Q', 'L', 'N', M, M, N, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_QLN_MM = INT( CDUM(1) ) +* + CALL ZUNMBR( 'Q', 'L', 'N', M, N, N, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_QLN_MN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_QLN_NN = INT( CDUM(1) ) * IF( M.GE.MNTHR1 ) THEN IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * - MAXWRK = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, - $ -1 ) - MAXWRK = MAX( MAXWRK, 2*N+2*N* - $ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) ) + MAXWRK = N + LWORK_ZGEQRF_MN + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZGEBRD_NN ) MINWRK = 3*N ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') +* Path 2 (M >> N, JOBZ='O') * - WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'PRC', N, N, N, -1 ) ) + WRKBL = N + LWORK_ZGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_ZUNGQR_MN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_PRC_NN ) MAXWRK = M*N + N*N + WRKBL MINWRK = 2*N*N + 3*N ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * - WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'PRC', N, N, N, -1 ) ) + WRKBL = N + LWORK_ZGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_ZUNGQR_MN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_PRC_NN ) MAXWRK = N*N + WRKBL MINWRK = N*N + 3*N ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * - WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'ZUNGQR', ' ', M, - $ M, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'PRC', N, N, N, -1 ) ) + WRKBL = N + LWORK_ZGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_ZUNGQR_MM ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_PRC_NN ) MAXWRK = N*N + WRKBL - MINWRK = N*N + 2*N + M + MINWRK = N*N + MAX( 3*N, N + M ) END IF ELSE IF( M.GE.MNTHR2 ) THEN * -* Path 5 (M much larger than N, but not as much as MNTHR1) +* Path 5 (M >> N, but not as much as MNTHR1) * - MAXWRK = 2*N + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*N + LWORK_ZGEBRD_MN MINWRK = 2*N + M IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, N, N, -1 ) ) +* Path 5o (M >> N, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_Q_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + N*N ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, N, N, -1 ) ) +* Path 5s (M >> N, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_Q_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+M* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5a (M >> N, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_Q_MM ) END IF ELSE * -* Path 6 (M at least N, but not much larger) +* Path 6 (M >= N, but not much larger) * - MAXWRK = 2*N + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*N + LWORK_ZGEBRD_MN MINWRK = 2*N + M IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, N, N, -1 ) ) +* Path 6o (M >= N, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_PRC_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_QLN_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + N*N ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, N, N, -1 ) ) +* Path 6s (M >= N, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_QLN_MN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_PRC_NN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+M* - $ ILAENV( 1, 'ZUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6a (M >= N, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_PRC_NN ) END IF END IF ELSE * * There is no complex work space needed for bidiagonal SVD -* The real work space needed for bidiagonal SVD is BDSPAC -* for computing singular values and singular vectors; BDSPAN -* for computing singular values only. -* BDSPAC = 5*M*M + 7*M -* BDSPAN = MAX(7*M+4, 3*M+2+SMLSIZ*(SMLSIZ+8)) +* The real work space needed for bidiagonal SVD (dbdsdc) is +* BDSPAC = 3*M*M + 4*M for singular values and vectors; +* BDSPAC = 4*M for singular values only; +* not including e, RU, and RVT matrices. +* +* Compute space preferred for each routine + CALL ZGEBRD( M, N, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGEBRD_MN = INT( CDUM(1) ) +* + CALL ZGEBRD( M, M, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGEBRD_MM = INT( CDUM(1) ) +* + CALL ZGELQF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGELQF_MN = INT( CDUM(1) ) +* + CALL ZUNGBR( 'P', M, N, M, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_P_MN = INT( CDUM(1) ) +* + CALL ZUNGBR( 'P', N, N, M, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_P_NN = INT( CDUM(1) ) +* + CALL ZUNGBR( 'Q', M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_Q_MM = INT( CDUM(1) ) +* + CALL ZUNGLQ( M, N, M, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGLQ_MN = INT( CDUM(1) ) +* + CALL ZUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGLQ_NN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'P', 'R', 'C', M, M, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_PRC_MM = INT( CDUM(1) ) +* + CALL ZUNMBR( 'P', 'R', 'C', M, N, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_PRC_MN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'P', 'R', 'C', N, N, M, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_PRC_NN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_QLN_MM = INT( CDUM(1) ) * IF( N.GE.MNTHR1 ) THEN IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * - MAXWRK = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, - $ -1 ) - MAXWRK = MAX( MAXWRK, 2*M+2*M* - $ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) ) + MAXWRK = M + LWORK_ZGELQF_MN + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZGEBRD_MM ) MINWRK = 3*M ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * - WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, M, M, -1 ) ) + WRKBL = M + LWORK_ZGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_ZUNGLQ_MN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_PRC_MM ) MAXWRK = M*N + M*M + WRKBL MINWRK = 2*M*M + 3*M ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') +* Path 3t (N >> M, JOBZ='S') * - WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, M, M, -1 ) ) + WRKBL = M + LWORK_ZGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_ZUNGLQ_MN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_PRC_MM ) MAXWRK = M*M + WRKBL MINWRK = M*M + 3*M ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * - WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'ZUNGLQ', ' ', N, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, M, M, -1 ) ) + WRKBL = M + LWORK_ZGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_ZUNGLQ_NN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_PRC_MM ) MAXWRK = M*M + WRKBL - MINWRK = M*M + 2*M + N + MINWRK = M*M + MAX( 3*M, M + N ) END IF ELSE IF( N.GE.MNTHR2 ) THEN * -* Path 5t (N much larger than M, but not as much as MNTHR1) +* Path 5t (N >> M, but not as much as MNTHR1) * - MAXWRK = 2*M + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*M + LWORK_ZGEBRD_MN MINWRK = 2*M + N IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'P', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5to (N >> M, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_P_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + M*M ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'P', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5ts (N >> M, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_P_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*M+N* - $ ILAENV( 1, 'ZUNGBR', 'P', N, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5ta (N >> M, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_P_NN ) END IF ELSE * -* Path 6t (N greater than M, but not much larger) +* Path 6t (N > M, but not much larger) * - MAXWRK = 2*M + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*M + LWORK_ZGEBRD_MN MINWRK = 2*M + N IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'PRC', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, M, N, -1 ) ) +* Path 6to (N > M, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_PRC_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + M*M ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'PRC', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6ts (N > M, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_PRC_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*M+N* - $ ILAENV( 1, 'ZUNGBR', 'PRC', N, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6ta (N > M, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_PRC_NN ) END IF END IF END IF @@ -554,18 +619,20 @@ END IF IF( INFO.EQ.0 ) THEN WORK( 1 ) = MAXWRK - IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV ) - $ INFO = -13 + IF( LWORK.LT.MINWRK .AND. .NOT. LQUERY ) THEN + INFO = -12 + END IF END IF -* -* Quick returns * IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZGESDD', -INFO ) RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF - IF( LWORK.EQ.LQUERV ) - $ RETURN +* +* Quick return if possible +* IF( M.EQ.0 .OR. N.EQ.0 ) THEN RETURN END IF @@ -598,15 +665,16 @@ * IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: need 0) +* CWorkspace: need N [tau] + N [work] +* CWorkspace: prefer N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -621,8 +689,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -630,15 +699,15 @@ NRWORK = IE + N * * Perform bidiagonal SVD, compute singular values only -* (CWorkspace: 0) -* (RWorkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') +* Path 2 (M >> N, JOBZ='O') * N left singular vectors to be overwritten on A and * N right singular vectors to be computed in VT * @@ -648,20 +717,21 @@ * LDWRKU = N IR = IU + LDWRKU*N - IF( LWORK.GE.M*N+N*N+3*N ) THEN + IF( LWORK .GE. M*N + N*N + 3*N ) THEN * * WORK(IR) is M by N * LDWRKR = M ELSE - LDWRKR = ( LWORK-N*N-3*N ) / N + LDWRKR = ( LWORK - N*N - 3*N ) / N END IF ITAU = IR + LDWRKR*N NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need N*N+2*N, prefer M*N+N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -673,8 +743,9 @@ $ LDWRKR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -684,8 +755,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -694,8 +766,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of R in WORK(IRU) and computing right singular vectors * of R in WORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = IE + N IRVT = IRU + N*N @@ -706,8 +778,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by the left singular vectors of R -* (CWorkspace: need 2*N*N+3*N, prefer M*N+N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), $ LDWRKU ) @@ -717,8 +790,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by the right singular vectors of R -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, @@ -727,8 +801,9 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IU), storing result in WORK(IR) and copying to A -* (CWorkspace: need 2*N*N, prefer N*N+M*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] +* CWorkspace: prefer N*N [U] + M*N [R] +* RWorkspace: need 0 * DO 10 I = 1, M, LDWRKR CHUNK = MIN( M-I+1, LDWRKR ) @@ -741,7 +816,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * N left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -754,8 +829,9 @@ NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -767,8 +843,9 @@ $ LDWRKR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -778,8 +855,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -788,8 +866,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = IE + N IRVT = IRU + N*N @@ -800,8 +878,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, @@ -810,8 +889,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, @@ -820,8 +900,8 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in U -* (CWorkspace: need N*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] +* RWorkspace: need 0 * CALL ZLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR ) CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA, WORK( IR ), @@ -829,7 +909,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * M left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -842,16 +922,18 @@ NWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL ZLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (CWorkspace: need N+M, prefer N+M*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N [tau] + M [work] +* CWorkspace: prefer N*N [U] + N [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -866,8 +948,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -879,8 +962,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -888,8 +971,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by left singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), $ LDWRKU ) @@ -899,8 +983,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of R -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -909,8 +994,8 @@ * * Multiply Q in U by left singular vectors of R in * WORK(IU), storing result in A -* (CWorkspace: need N*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] +* RWorkspace: need 0 * CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU, WORK( IU ), $ LDWRKU, CZERO, A, LDA ) @@ -925,7 +1010,7 @@ * * MNTHR2 <= M < MNTHR1 * -* Path 5 (M much larger than N, but not as much as MNTHR1) +* Path 5 (M >> N, but not as much as MNTHR1) * Reduce to bidiagonal form without QR decomposition, use * ZUNGBR and matrix multiplication to compute singular vectors * @@ -936,19 +1021,21 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5n (M >> N, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IU = NWORK @@ -956,22 +1043,25 @@ IRVT = IRU + N*N NRWORK = IRVT + N*N * +* Path 5o (M >> N, JOBZ='O') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * * WORK( IU ) is M by N * @@ -980,15 +1070,15 @@ * * WORK(IU) is LDWRKU by N * - LDWRKU = ( LWORK-3*N ) / N + LDWRKU = ( LWORK - 3*N ) / N END IF NWORK = IU + LDWRKU*N * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -996,8 +1086,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in WORK(IU), copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL ZLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, $ WORK( IU ), LDWRKU, RWORK( NRWORK ) ) @@ -1005,8 +1095,10 @@ * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need N*N, prefer M*N) -* (Rworkspace: need 3*N*N, prefer N*N+2*M*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] +* RWorkspace: need N [e] + N*N [RU] + 2*N*N [rwork] +* RWorkspace: prefer N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT DO 20 I = 1, M, LDWRKU @@ -1019,17 +1111,20 @@ * ELSE IF( WNTQS ) THEN * +* Path 5s (M >> N, JOBZ='S') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to U, generate Q -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'L', M, N, A, LDA, U, LDU ) CALL ZUNGBR( 'Q', M, N, N, U, LDU, WORK( ITAUQ ), @@ -1038,8 +1133,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1050,8 +1145,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL ZLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) @@ -1059,8 +1154,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need N*N+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT CALL ZLACRM( M, N, U, LDU, RWORK( IRU ), N, A, LDA, @@ -1068,17 +1163,20 @@ CALL ZLACPY( 'F', M, N, A, LDA, U, LDU ) ELSE * +* Path 5a (M >> N, JOBZ='A') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to U, generate Q -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'L', M, N, A, LDA, U, LDU ) CALL ZUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), @@ -1087,8 +1185,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1099,8 +1197,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL ZLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) @@ -1108,8 +1206,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT CALL ZLACRM( M, N, U, LDU, RWORK( IRU ), N, A, LDA, @@ -1121,7 +1219,7 @@ * * M .LT. MNTHR2 * -* Path 6 (M at least N, but not much larger) +* Path 6 (M >= N, but not much larger) * Reduce to bidiagonal form without QR decomposition * Use ZUNMBR to compute singular vectors * @@ -1132,26 +1230,28 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 6n (M >= N, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IU = NWORK IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * * WORK( IU ) is M by N * @@ -1160,15 +1260,16 @@ * * WORK( IU ) is LDWRKU by N * - LDWRKU = ( LWORK-3*N ) / N + LDWRKU = ( LWORK - 3*N ) / N END IF NWORK = IU + LDWRKU*N * +* Path 6o (M >= N, JOBZ='O') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -1176,21 +1277,24 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*N [U] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * -* Copy real matrix RWORK(IRU) to complex matrix WORK(IU) -* Overwrite WORK(IU) by left singular vectors of A, copying -* to A -* (Cworkspace: need M*N+2*N, prefer M*N+N+N*NB) -* (Rworkspace: need 0) +* Path 6o-fast +* Copy real matrix RWORK(IRU) to complex matrix WORK(IU) +* Overwrite WORK(IU) by left singular vectors of A, copying +* to A +* CWorkspace: need 2*N [tauq, taup] + M*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] * CALL ZLASET( 'F', M, N, CZERO, CZERO, WORK( IU ), $ LDWRKU ) @@ -1202,17 +1306,21 @@ CALL ZLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) ELSE * +* Path 6o-slow * Generate Q in A -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*N [U] + N*NB [work] +* RWorkspace: need 0 * CALL ZUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need N*N, prefer M*N) -* (Rworkspace: need 3*N*N, prefer N*N+2*M*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] +* RWorkspace: need N [e] + N*N [RU] + 2*N*N [rwork] +* RWorkspace: prefer N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT DO 30 I = 1, M, LDWRKU @@ -1227,11 +1335,12 @@ * ELSE IF( WNTQS ) THEN * +* Path 6s (M >= N, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1242,8 +1351,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL ZLASET( 'F', M, N, CZERO, CZERO, U, LDU ) CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) @@ -1253,8 +1363,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -1262,11 +1373,12 @@ $ LWORK-NWORK+1, IERR ) ELSE * +* Path 6a (M >= N, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1285,8 +1397,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -1295,8 +1408,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -1316,15 +1430,16 @@ * IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M [tau] + M [work] +* CWorkspace: prefer M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1339,8 +1454,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1348,15 +1464,15 @@ NRWORK = IE + M * * Perform bidiagonal SVD, compute singular values only -* (CWorkspace: 0) -* (RWorkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL DBDSDC( 'U', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'U', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * M right singular vectors to be overwritten on A and * M left singular vectors to be computed in U * @@ -1366,7 +1482,7 @@ * WORK(IVT) is M by M * IL = IVT + LDWKVT*M - IF( LWORK.GE.M*N+M*M+3*M ) THEN + IF( LWORK .GE. M*N + M*M + 3*M ) THEN * * WORK(IL) M by N * @@ -1377,14 +1493,15 @@ * WORK(IL) is M by CHUNK * LDWRKL = M - CHUNK = ( LWORK-M*M-3*M ) / M + CHUNK = ( LWORK - M*M - 3*M ) / M END IF ITAU = IL + LDWRKL*CHUNK NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1396,8 +1513,9 @@ $ WORK( IL+LDWRKL ), LDWRKL ) * * Generate Q in A -* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1407,8 +1525,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, M, WORK( IL ), LDWRKL, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -1417,8 +1536,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1429,8 +1548,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by the left singular vectors of L -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, @@ -1439,8 +1559,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) * Overwrite WORK(IVT) by the right singular vectors of L -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1450,8 +1571,9 @@ * * Multiply right singular vectors of L in WORK(IL) by Q * in A, storing result in WORK(IL) and copying to A -* (CWorkspace: need 2*M*M, prefer M*M+M*N)) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] +* CWorkspace: prefer M*M [VT] + M*N [L] +* RWorkspace: need 0 * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) @@ -1464,9 +1586,9 @@ * ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') -* M right singular vectors to be computed in VT and -* M left singular vectors to be computed in U +* Path 3t (N >> M, JOBZ='S') +* M right singular vectors to be computed in VT and +* M left singular vectors to be computed in U * IL = 1 * @@ -1477,8 +1599,9 @@ NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1490,8 +1613,9 @@ $ WORK( IL+LDWRKL ), LDWRKL ) * * Generate Q in A -* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1501,8 +1625,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, M, WORK( IL ), LDWRKL, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -1511,8 +1636,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1523,8 +1648,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, @@ -1533,8 +1659,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by left singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), LDWRKL, @@ -1543,8 +1670,8 @@ * * Copy VT to WORK(IL), multiply right singular vectors of L * in WORK(IL) by Q in A, storing result in VT -* (CWorkspace: need M*M) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] +* RWorkspace: need 0 * CALL ZLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL ) CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IL ), LDWRKL, @@ -1552,7 +1679,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 9t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * N right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1565,16 +1692,18 @@ NWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (CWorkspace: need M+N, prefer M+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M [tau] + N [work] +* CWorkspace: prefer M*M [VT] + M [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1589,8 +1718,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1599,8 +1729,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1611,8 +1741,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of L -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, A, LDA, @@ -1621,8 +1752,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) * Overwrite WORK(IVT) by right singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1632,8 +1764,8 @@ * * Multiply right singular vectors of L in WORK(IVT) by * Q in VT, storing result in A -* (CWorkspace: need M*M) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] +* RWorkspace: need 0 * CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), LDWKVT, $ VT, LDVT, CZERO, A, LDA ) @@ -1648,10 +1780,9 @@ * * MNTHR2 <= N < MNTHR1 * -* Path 5t (N much larger than M, but not as much as MNTHR1) +* Path 5t (N >> M, but not as much as MNTHR1) * Reduce to bidiagonal form without QR decomposition, use * ZUNGBR and matrix multiplication to compute singular vectors -* * IE = 1 NRWORK = IE + M @@ -1660,8 +1791,9 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB) -* (RWorkspace: M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1669,11 +1801,12 @@ * IF( WNTQN ) THEN * +* Path 5tn (N >> M, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL DBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IRVT = NRWORK @@ -1681,23 +1814,26 @@ NRWORK = IRU + M*M IVT = NWORK * +* Path 5to (N >> M, JOBZ='O') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'L', M, M, A, LDA, U, LDU ) CALL ZUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Generate P**H in A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * LDWKVT = M - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * * WORK( IVT ) is M by N * @@ -1707,15 +1843,15 @@ * * WORK( IVT ) is M by CHUNK * - CHUNK = ( LWORK-3*M ) / M + CHUNK = ( LWORK - 3*M ) / M NWORK = IVT + LDWKVT*CHUNK END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, @@ -1723,8 +1859,8 @@ * * Multiply Q in U by real matrix RWORK(IRVT) * storing the result in WORK(IVT), copying to U -* (Cworkspace: need 0) -* (Rworkspace: need 2*M*M) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL ZLACRM( M, M, U, LDU, RWORK( IRU ), M, WORK( IVT ), $ LDWKVT, RWORK( NRWORK ) ) @@ -1732,8 +1868,10 @@ * * Multiply RWORK(IRVT) by P**H in A, storing the * result in WORK(IVT), copying to A -* (CWorkspace: need M*M, prefer M*N) -* (Rworkspace: need 2*M*M, prefer 2*M*N) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] +* RWorkspace: need M [e] + M*M [RVT] + 2*M*M [rwork] +* RWorkspace: prefer M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU DO 50 I = 1, N, CHUNK @@ -1745,17 +1883,20 @@ 50 CONTINUE ELSE IF( WNTQS ) THEN * +* Path 5ts (N >> M, JOBZ='S') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'L', M, M, A, LDA, U, LDU ) CALL ZUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to VT, generate P**H -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT ) CALL ZUNGBR( 'P', M, N, M, VT, LDVT, WORK( ITAUP ), @@ -1764,8 +1905,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1776,8 +1917,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need 3*M*M) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL ZLACRM( M, M, U, LDU, RWORK( IRU ), M, A, LDA, $ RWORK( NRWORK ) ) @@ -1785,8 +1926,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need M*M+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU CALL ZLARCM( M, N, RWORK( IRVT ), M, VT, LDVT, A, LDA, @@ -1794,17 +1935,20 @@ CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT ) ELSE * +* Path 5ta (N >> M, JOBZ='A') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'L', M, M, A, LDA, U, LDU ) CALL ZUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to VT, generate P**H -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT ) CALL ZUNGBR( 'P', N, N, M, VT, LDVT, WORK( ITAUP ), @@ -1813,8 +1957,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1825,8 +1969,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need 3*M*M) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL ZLACRM( M, M, U, LDU, RWORK( IRU ), M, A, LDA, $ RWORK( NRWORK ) ) @@ -1834,9 +1978,10 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need M*M+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * + NRWORK = IRU CALL ZLARCM( M, N, RWORK( IRVT ), M, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT ) @@ -1846,7 +1991,7 @@ * * N .LT. MNTHR2 * -* Path 6t (N greater than M, but not much larger) +* Path 6t (N > M, but not much larger) * Reduce to bidiagonal form without LQ decomposition * Use ZUNMBR to compute singular vectors * @@ -1857,24 +2002,27 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB) -* (RWorkspace: M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 6tn (N > M, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL DBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 6to (N > M, JOBZ='O') LDWKVT = M IVT = NWORK - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * * WORK( IVT ) is M by N * @@ -1885,15 +2033,15 @@ * * WORK( IVT ) is M by CHUNK * - CHUNK = ( LWORK-3*M ) / M + CHUNK = ( LWORK - 3*M ) / M NWORK = IVT + LDWKVT*CHUNK END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1904,21 +2052,24 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*M [VT] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * -* Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) -* Overwrite WORK(IVT) by right singular vectors of A, -* copying to A -* (Cworkspace: need M*N+2*M, prefer M*N+M+M*NB) -* (Rworkspace: need 0) +* Path 6to-fast +* Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) +* Overwrite WORK(IVT) by right singular vectors of A, +* copying to A +* CWorkspace: need 2*M [tauq, taup] + M*N [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1928,17 +2079,21 @@ CALL ZLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) ELSE * +* Path 6to-slow * Generate P**H in A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*M [VT] + M*NB [work] +* RWorkspace: need 0 * CALL ZUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need M*M, prefer M*N) -* (Rworkspace: need 3*M*M, prefer M*M+2*M*N) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] +* RWorkspace: need M [e] + M*M [RVT] + 2*M*M [rwork] +* RWorkspace: prefer M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU DO 60 I = 1, N, CHUNK @@ -1952,11 +2107,12 @@ END IF ELSE IF( WNTQS ) THEN * +* Path 6ts (N > M, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1967,8 +2123,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -1977,8 +2134,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL ZLASET( 'F', M, N, CZERO, CZERO, VT, LDVT ) CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) @@ -1987,11 +2145,12 @@ $ LWORK-NWORK+1, IERR ) ELSE * +* Path 6ta (N > M, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -2003,8 +2162,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -2017,8 +2177,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + N*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, M, A, LDA, diff --git a/lapack-netlib/SRC/zgesvd.f b/lapack-netlib/SRC/zgesvd.f index 966e02273..5f66bcb1e 100644 --- a/lapack-netlib/SRC/zgesvd.f +++ b/lapack-netlib/SRC/zgesvd.f @@ -214,7 +214,7 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, $ VT, LDVT, WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -322,23 +322,23 @@ MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 ) * Compute space needed for ZGEQRF CALL ZGEQRF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGEQRF=CDUM(1) + LWORK_ZGEQRF = INT( CDUM(1) ) * Compute space needed for ZUNGQR CALL ZUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZUNGQR_N=CDUM(1) + LWORK_ZUNGQR_N = INT( CDUM(1) ) CALL ZUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZUNGQR_M=CDUM(1) + LWORK_ZUNGQR_M = INT( CDUM(1) ) * Compute space needed for ZGEBRD CALL ZGEBRD( N, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGEBRD=CDUM(1) + LWORK_ZGEBRD = INT( CDUM(1) ) * Compute space needed for ZUNGBR CALL ZUNGBR( 'P', N, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_P=CDUM(1) + LWORK_ZUNGBR_P = INT( CDUM(1) ) CALL ZUNGBR( 'Q', N, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_Q=CDUM(1) + LWORK_ZUNGBR_Q = INT( CDUM(1) ) * IF( M.GE.MNTHR ) THEN IF( WNTUN ) THEN @@ -445,24 +445,24 @@ * CALL ZGEBRD( M, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGEBRD=CDUM(1) + LWORK_ZGEBRD = INT( CDUM(1) ) MAXWRK = 2*N + LWORK_ZGEBRD IF( WNTUS .OR. WNTUO ) THEN CALL ZUNGBR( 'Q', M, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_Q=CDUM(1) + LWORK_ZUNGBR_Q = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_Q ) END IF IF( WNTUA ) THEN CALL ZUNGBR( 'Q', M, M, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_Q=CDUM(1) + LWORK_ZUNGBR_Q = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_Q ) END IF IF( .NOT.WNTVN ) THEN MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_P ) - MINWRK = 2*N + M END IF + MINWRK = 2*N + M END IF ELSE IF( MINMN.GT.0 ) THEN * @@ -471,25 +471,25 @@ MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 ) * Compute space needed for ZGELQF CALL ZGELQF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGELQF=CDUM(1) + LWORK_ZGELQF = INT( CDUM(1) ) * Compute space needed for ZUNGLQ CALL ZUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), -1, $ IERR ) - LWORK_ZUNGLQ_N=CDUM(1) + LWORK_ZUNGLQ_N = INT( CDUM(1) ) CALL ZUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZUNGLQ_M=CDUM(1) + LWORK_ZUNGLQ_M = INT( CDUM(1) ) * Compute space needed for ZGEBRD CALL ZGEBRD( M, M, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGEBRD=CDUM(1) + LWORK_ZGEBRD = INT( CDUM(1) ) * Compute space needed for ZUNGBR P CALL ZUNGBR( 'P', M, M, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_P=CDUM(1) + LWORK_ZUNGBR_P = INT( CDUM(1) ) * Compute space needed for ZUNGBR Q CALL ZUNGBR( 'Q', M, M, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_Q=CDUM(1) + LWORK_ZUNGBR_Q = INT( CDUM(1) ) IF( N.GE.MNTHR ) THEN IF( WNTVN ) THEN * @@ -595,25 +595,25 @@ * CALL ZGEBRD( M, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGEBRD=CDUM(1) + LWORK_ZGEBRD = INT( CDUM(1) ) MAXWRK = 2*M + LWORK_ZGEBRD IF( WNTVS .OR. WNTVO ) THEN * Compute space needed for ZUNGBR P CALL ZUNGBR( 'P', M, N, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_P=CDUM(1) + LWORK_ZUNGBR_P = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_P ) END IF IF( WNTVA ) THEN CALL ZUNGBR( 'P', N, N, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_P=CDUM(1) + LWORK_ZUNGBR_P = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_P ) END IF IF( .NOT.WNTUN ) THEN MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_Q ) - MINWRK = 2*M + N END IF + MINWRK = 2*M + N END IF END IF MAXWRK = MAX( MAXWRK, MINWRK ) @@ -680,8 +680,10 @@ * * Zero out below R * - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ), + $ LDA ) + END IF IE = 1 ITAUQ = 1 ITAUP = ITAUQ + N @@ -1144,8 +1146,10 @@ * * Zero out below R in A * - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1321,8 +1325,10 @@ * * Zero out below R in A * - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1649,8 +1655,10 @@ * * Zero out below R in A * - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1830,8 +1838,10 @@ * * Zero out below R in A * - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) diff --git a/lapack-netlib/SRC/zgesvdx.f b/lapack-netlib/SRC/zgesvdx.f index 6f7d5ba04..27428732c 100644 --- a/lapack-netlib/SRC/zgesvdx.f +++ b/lapack-netlib/SRC/zgesvdx.f @@ -36,27 +36,30 @@ * .. * * -* Purpose -* ======= -* -* ZGESVDX computes the singular value decomposition (SVD) of a complex -* M-by-N matrix A, optionally computing the left and/or right singular -* vectors. The SVD is written -* -* A = U * SIGMA * transpose(V) -* -* where SIGMA is an M-by-N matrix which is zero except for its -* min(m,n) diagonal elements, U is an M-by-M unitary matrix, and -* V is an N-by-N unitary matrix. The diagonal elements of SIGMA -* are the singular values of A; they are real and non-negative, and -* are returned in descending order. The first min(m,n) columns of -* U and V are the left and right singular vectors of A. -* -* ZGESVDX uses an eigenvalue problem for obtaining the SVD, which -* allows for the computation of a subset of singular values and -* vectors. See DBDSVDX for details. -* -* Note that the routine returns V**T, not V. +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZGESVDX computes the singular value decomposition (SVD) of a complex +*> M-by-N matrix A, optionally computing the left and/or right singular +*> vectors. The SVD is written +*> +*> A = U * SIGMA * transpose(V) +*> +*> where SIGMA is an M-by-N matrix which is zero except for its +*> min(m,n) diagonal elements, U is an M-by-M unitary matrix, and +*> V is an N-by-N unitary matrix. The diagonal elements of SIGMA +*> are the singular values of A; they are real and non-negative, and +*> are returned in descending order. The first min(m,n) columns of +*> U and V are the left and right singular vectors of A. +*> +*> ZGESVDX uses an eigenvalue problem for obtaining the SVD, which +*> allows for the computation of a subset of singular values and +*> vectors. See DBDSVDX for details. +*> +*> Note that the routine returns V**T, not V. +*> \endverbatim * * Arguments: * ========== @@ -107,7 +110,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is COMPLEX array, dimension (LDA,N) +*> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> On exit, the contents of A are destroyed. *> \endverbatim @@ -121,13 +124,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION -*> VL >=0. +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -135,13 +140,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -167,7 +176,7 @@ *> vectors, stored columnwise) as specified by RANGE; if *> JOBU = 'N', U is not referenced. *> Note: The user must ensure that UCOL >= NS; if RANGE = 'V', -*> the exact value of NS is not known ILQFin advance and an upper +*> the exact value of NS is not known in advance and an upper *> bound must be used. *> \endverbatim *> @@ -252,7 +261,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16GEsing * @@ -261,10 +270,10 @@ $ IL, IU, NS, S, U, LDU, VT, LDVT, WORK, $ LWORK, RWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU, JOBVT, RANGE @@ -291,8 +300,8 @@ CHARACTER JOBZ, RNGTGK LOGICAL ALLS, INDS, LQUERY, VALS, WANTU, WANTVT INTEGER I, ID, IE, IERR, ILQF, ILTGK, IQRF, ISCL, - $ ITAU, ITAUP, ITAUQ, ITEMP, ITGKZ, IUTGK, - $ J, K, MAXWRK, MINMN, MINWRK, MNTHR + $ ITAU, ITAUP, ITAUQ, ITEMP, ITEMPR, ITGKZ, + $ IUTGK, J, K, MAXWRK, MINMN, MINWRK, MNTHR DOUBLE PRECISION ABSTOL, ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. @@ -364,8 +373,14 @@ IF( INFO.EQ.0 ) THEN IF( WANTU .AND. LDU.LT.M ) THEN INFO = -15 - ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN - INFO = -16 + ELSE IF( WANTVT ) THEN + IF( INDS ) THEN + IF( LDVT.LT.IU-IL+1 ) THEN + INFO = -17 + END IF + ELSE IF( LDVT.LT.MINMN ) THEN + INFO = -17 + END IF END IF END IF END IF @@ -387,18 +402,24 @@ * * Path 1 (M much larger than N) * - MAXWRK = N + N* - $ ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, N*N + N + 2*N* - $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - MINWRK = N*(N+4) + MINWRK = N*(N+5) + MAXWRK = N + N*ILAENV(1,'ZGEQRF',' ',M,N,-1,-1) + MAXWRK = MAX(MAXWRK, + $ N*N+2*N+2*N*ILAENV(1,'ZGEBRD',' ',N,N,-1,-1)) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ N*N+2*N+N*ILAENV(1,'ZUNMQR','LN',N,N,N,-1)) + END IF ELSE * * Path 2 (M at least N, but not much larger) * - MAXWRK = 2*N + ( M+N )* - $ ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) - MINWRK = 2*N + M + MINWRK = 3*N + M + MAXWRK = 2*N + (M+N)*ILAENV(1,'ZGEBRD',' ',M,N,-1,-1) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ 2*N+N*ILAENV(1,'ZUNMQR','LN',N,N,N,-1)) + END IF END IF ELSE MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 ) @@ -406,18 +427,25 @@ * * Path 1t (N much larger than M) * - MAXWRK = M + M* - $ ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, M*M + M + 2*M* - $ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) ) - MINWRK = M*(M+4) + MINWRK = M*(M+5) + MAXWRK = M + M*ILAENV(1,'ZGELQF',' ',M,N,-1,-1) + MAXWRK = MAX(MAXWRK, + $ M*M+2*M+2*M*ILAENV(1,'ZGEBRD',' ',M,M,-1,-1)) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ M*M+2*M+M*ILAENV(1,'ZUNMQR','LN',M,M,M,-1)) + END IF ELSE * * Path 2t (N greater than M, but not much larger) * - MAXWRK = M*(M*2+19) + ( M+N )* - $ ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) - MINWRK = 2*M + N +* + MINWRK = 3*M + N + MAXWRK = 2*M + (M+N)*ILAENV(1,'ZGEBRD',' ',M,N,-1,-1) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ 2*M+M*ILAENV(1,'ZUNMQR','LN',M,M,M,-1)) + END IF END IF END IF END IF @@ -444,8 +472,6 @@ * * Set singular values indices accord to RANGE='A'. * - ALLS = LSAME( RANGE, 'A' ) - INDS = LSAME( RANGE, 'I' ) IF( ALLS ) THEN RNGTGK = 'I' ILTGK = 1 @@ -515,14 +541,14 @@ CALL ZGEBRD( N, N, WORK( IQRF ), N, RWORK( ID ), $ RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), $ WORK( ITEMP ), LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + N*(N*2+1) + ITEMPR = ITGKZ + N*(N*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*N*N+14*N) * CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), N*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), N*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -536,7 +562,7 @@ END DO K = K + N END DO - CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU ) + CALL ZLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU) * * Call ZUNMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -591,14 +617,14 @@ CALL ZGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + N*(N*2+1) + ITEMPR = ITGKZ + N*(N*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*N*N+14*N) * CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), N*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), N*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -612,7 +638,7 @@ END DO K = K + N END DO - CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU ) + CALL ZLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU) * * Call ZUNMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -678,14 +704,14 @@ CALL ZGEBRD( M, M, WORK( ILQF ), M, RWORK( ID ), $ RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), $ WORK( ITEMP ), LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + M*(M*2+1) + ITEMPR = ITGKZ + M*(M*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*M*M+14*M) * CALL DBDSVDX( 'U', JOBZ, RNGTGK, M, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), M*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -719,7 +745,7 @@ END DO K = K + M END DO - CALL ZLASET( 'A', M, N-M, CZERO, CZERO, + CALL ZLASET( 'A', NS, N-M, CZERO, CZERO, $ VT( 1,M+1 ), LDVT ) * * Call ZUNMBR to compute (VB**T)*(PB**T) @@ -755,14 +781,14 @@ CALL ZGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + M*(M*2+1) + ITEMPR = ITGKZ + M*(M*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*M*M+14*M) * CALL DBDSVDX( 'L', JOBZ, RNGTGK, M, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), M*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -796,7 +822,7 @@ END DO K = K + M END DO - CALL ZLASET( 'A', M, N-M, CZERO, CZERO, + CALL ZLASET( 'A', NS, N-M, CZERO, CZERO, $ VT( 1,M+1 ), LDVT ) * * Call ZUNMBR to compute VB**T * PB**T diff --git a/lapack-netlib/SRC/zgesvj.f b/lapack-netlib/SRC/zgesvj.f index 930a35309..e4b6969f7 100644 --- a/lapack-netlib/SRC/zgesvj.f +++ b/lapack-netlib/SRC/zgesvj.f @@ -270,7 +270,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleGEcomputational * @@ -342,10 +342,10 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ LDV, CWORK, LWORK, RWORK, LRWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * IMPLICIT NONE * .. Scalar Arguments .. @@ -381,7 +381,7 @@ * .. * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DMAX1, DMIN1, DCONJG, DFLOAT, MIN0, MAX0, + INTRINSIC ABS, DMAX1, DMIN1, DCONJG, DBLE, MIN0, MAX0, $ DSIGN, DSQRT * .. * .. External Functions .. @@ -403,7 +403,7 @@ * from BLAS EXTERNAL ZCOPY, ZROT, ZDSCAL, ZSWAP * from LAPACK - EXTERNAL ZLASCL, ZLASET, ZLASSQ, XERBLA + EXTERNAL DLASCL, ZLASCL, ZLASET, ZLASSQ, XERBLA EXTERNAL ZGSVJ0, ZGSVJ1 * .. * .. Executable Statements .. @@ -467,9 +467,9 @@ ELSE * ... default IF( LSVEC .OR. RSVEC .OR. APPLV ) THEN - CTOL = DSQRT( DFLOAT( M ) ) + CTOL = DSQRT( DBLE( M ) ) ELSE - CTOL = DFLOAT( M ) + CTOL = DBLE( M ) END IF END IF * ... and the machine dependent parameters are @@ -483,13 +483,13 @@ BIG = DLAMCH( 'Overflow' ) * BIG = ONE / SFMIN ROOTBIG = ONE / ROOTSFMIN - LARGE = BIG / DSQRT( DFLOAT( M*N ) ) + LARGE = BIG / DSQRT( DBLE( M*N ) ) BIGTHETA = ONE / ROOTEPS * TOL = CTOL*EPSLN ROOTTOL = DSQRT( TOL ) * - IF( DFLOAT( M )*EPSLN.GE.ONE ) THEN + IF( DBLE( M )*EPSLN.GE.ONE ) THEN INFO = -4 CALL XERBLA( 'ZGESVJ', -INFO ) RETURN @@ -514,7 +514,7 @@ * SQRT(N)*max_i SVA(i) does not overflow. If INFinite entries * in A are detected, the procedure returns with INFO=-6. * - SKL = ONE / DSQRT( DFLOAT( M )*DFLOAT( N ) ) + SKL = ONE / DSQRT( DBLE( M )*DBLE( N ) ) NOSCALE = .TRUE. GOSCALE = .TRUE. * @@ -643,14 +643,14 @@ * avoid underflows/overflows in computing Jacobi rotations. * SN = DSQRT( SFMIN / EPSLN ) - TEMP1 = DSQRT( BIG / DFLOAT( N ) ) + TEMP1 = DSQRT( BIG / DBLE( N ) ) IF( ( AAPP.LE.SN ) .OR. ( AAQQ.GE.TEMP1 ) .OR. $ ( ( SN.LE.AAQQ ) .AND. ( AAPP.LE.TEMP1 ) ) ) THEN TEMP1 = DMIN1( BIG, TEMP1 / AAPP ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.LE.TEMP1 ) ) THEN - TEMP1 = DMIN1( SN / AAQQ, BIG / (AAPP*DSQRT( DFLOAT(N)) ) ) + TEMP1 = DMIN1( SN / AAQQ, BIG / (AAPP*DSQRT( DBLE(N)) ) ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE IF( ( AAQQ.GE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN @@ -658,7 +658,7 @@ * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN - TEMP1 = DMIN1( SN / AAQQ, BIG / ( DSQRT( DFLOAT( N ) )*AAPP ) ) + TEMP1 = DMIN1( SN / AAQQ, BIG / ( DSQRT( DBLE( N ) )*AAPP ) ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE @@ -668,7 +668,7 @@ * Scale, if necessary * IF( TEMP1.NE.ONE ) THEN - CALL ZLASCL( 'G', 0, 0, ONE, TEMP1, N, 1, SVA, N, IERR ) + CALL DLASCL( 'G', 0, 0, ONE, TEMP1, N, 1, SVA, N, IERR ) END IF SKL = TEMP1*SKL IF( SKL.NE.ONE ) THEN @@ -905,7 +905,6 @@ END IF END IF * - OMPQ = AAPQ / ABS(AAPQ) * AAPQ = AAPQ * DCONJG( CWORK(p) ) * CWORK(q) AAPQ1 = -ABS(AAPQ) MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 ) @@ -925,7 +924,8 @@ * IF( ROTOK ) THEN * - AQOAP = AAQQ / AAPP + OMPQ = AAPQ / ABS(AAPQ) + AQOAP = AAQQ / AAPP APOAQ = AAPP / AAQQ THETA = -HALF*ABS( AQOAP-APOAQ )/AAPQ1 * @@ -1126,7 +1126,6 @@ END IF END IF * - OMPQ = AAPQ / ABS(AAPQ) * AAPQ = AAPQ * DCONJG(CWORK(p))*CWORK(q) AAPQ1 = -ABS(AAPQ) MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 ) @@ -1141,6 +1140,7 @@ * IF( ROTOK ) THEN * + OMPQ = AAPQ / ABS(AAPQ) AQOAP = AAQQ / AAPP APOAQ = AAPP / AAQQ THETA = -HALF*ABS( AQOAP-APOAQ )/ AAPQ1 @@ -1322,8 +1322,8 @@ IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR. $ ( ISWROT.LE.N ) ) )SWBAND = i * - IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DFLOAT( N ) )* - $ TOL ) .AND. ( DFLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN + IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DBLE( N ) )* + $ TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN GO TO 1994 END IF * @@ -1400,15 +1400,15 @@ * then some of the singular values may overflow or underflow and * the spectrum is given in this factored representation. * - RWORK( 2 ) = DFLOAT( N4 ) + RWORK( 2 ) = DBLE( N4 ) * N4 is the number of computed nonzero singular values of A. * - RWORK( 3 ) = DFLOAT( N2 ) + RWORK( 3 ) = DBLE( N2 ) * N2 is the number of singular values of A greater than SFMIN. * If N2 \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complex16GEauxiliary * @@ -111,10 +111,10 @@ * ===================================================================== SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO ) * -* -- LAPACK auxiliary routine (version 3.5.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, N diff --git a/lapack-netlib/SRC/zgetrf2.f b/lapack-netlib/SRC/zgetrf2.f index 7d28b5812..9b2e956c8 100644 --- a/lapack-netlib/SRC/zgetrf2.f +++ b/lapack-netlib/SRC/zgetrf2.f @@ -37,7 +37,7 @@ *> the matrix into four submatrices: *> *> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2 -*> A = [ -----|----- ] with n1 = min(m,n) +*> A = [ -----|----- ] with n1 = min(m,n)/2 *> [ A21 | A22 ] n2 = n-n1 *> *> [ A11 ] @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16GEcomputational * * ===================================================================== RECURSIVE SUBROUTINE ZGETRF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/zggbal.f b/lapack-netlib/SRC/zggbal.f index 7298da397..7771c4c16 100644 --- a/lapack-netlib/SRC/zggbal.f +++ b/lapack-netlib/SRC/zggbal.f @@ -140,7 +140,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (lwork) +*> WORK is DOUBLE PRECISION array, dimension (lwork) *> lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and *> at least 1 when JOB = 'N' or 'P'. *> \endverbatim @@ -160,7 +160,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16GBcomputational * @@ -177,10 +177,10 @@ SUBROUTINE ZGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, $ RSCALE, WORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOB diff --git a/lapack-netlib/SRC/zgges3.f b/lapack-netlib/SRC/zgges3.f index 1a7dbccc7..08557b134 100644 --- a/lapack-netlib/SRC/zgges3.f +++ b/lapack-netlib/SRC/zgges3.f @@ -269,7 +269,7 @@ $ LDB, SDIM, ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, $ WORK, LWORK, RWORK, BWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -392,8 +392,8 @@ $ LDVSL, VSR, LDVSR, WORK, -1, IERR ) LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) CALL ZHGEQZ( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, - $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, - $ -1, RWORK, IERR ) + $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, -1, + $ RWORK, IERR ) LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) ) IF( WANTST ) THEN CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, diff --git a/lapack-netlib/SRC/zggev3.f b/lapack-netlib/SRC/zggev3.f index 78337fd07..2e88adedc 100644 --- a/lapack-netlib/SRC/zggev3.f +++ b/lapack-netlib/SRC/zggev3.f @@ -216,7 +216,7 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, $ VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 diff --git a/lapack-netlib/SRC/zgghd3.f b/lapack-netlib/SRC/zgghd3.f index 9d6e36285..94ae93b98 100644 --- a/lapack-netlib/SRC/zgghd3.f +++ b/lapack-netlib/SRC/zgghd3.f @@ -227,7 +227,7 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -277,7 +277,7 @@ * INFO = 0 NB = ILAENV( 1, 'ZGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = 6*N*NB + LWKOPT = MAX( 6*N*NB, 1 ) WORK( 1 ) = DCMPLX( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) diff --git a/lapack-netlib/SRC/zggsvd3.f b/lapack-netlib/SRC/zggsvd3.f index d478d2922..da479793d 100644 --- a/lapack-netlib/SRC/zggsvd3.f +++ b/lapack-netlib/SRC/zggsvd3.f @@ -353,7 +353,7 @@ $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, $ WORK, LWORK, RWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * August 2015 @@ -383,7 +383,7 @@ EXTERNAL LSAME, DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, XERBLA, ZGGSVP, ZTGSJA + EXTERNAL DCOPY, XERBLA, ZGGSVP3, ZTGSJA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN diff --git a/lapack-netlib/SRC/zggsvp3.f b/lapack-netlib/SRC/zggsvp3.f index b397651cc..88566f750 100644 --- a/lapack-netlib/SRC/zggsvp3.f +++ b/lapack-netlib/SRC/zggsvp3.f @@ -278,7 +278,7 @@ $ TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, $ IWORK, RWORK, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * August 2015 @@ -308,7 +308,6 @@ * .. Local Scalars .. LOGICAL FORWRD, WANTQ, WANTU, WANTV, LQUERY INTEGER I, J, LWKOPT - COMPLEX*16 T * .. * .. External Functions .. LOGICAL LSAME diff --git a/lapack-netlib/SRC/zgsvj0.f b/lapack-netlib/SRC/zgsvj0.f index a9e663d4b..e547eebb2 100644 --- a/lapack-netlib/SRC/zgsvj0.f +++ b/lapack-netlib/SRC/zgsvj0.f @@ -1,4 +1,4 @@ -*> \brief \b ZGSVJ0 pre-processor for the routine dgesvj. +*> \brief \b ZGSVJ0 pre-processor for the routine zgesvj. * * =========== DOCUMENTATION =========== * @@ -192,7 +192,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational *> @@ -217,10 +217,10 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ SFMIN, TOL, NSWEEP, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * IMPLICIT NONE * .. Scalar Arguments .. @@ -254,7 +254,7 @@ * .. * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DMAX1, DCONJG, DFLOAT, MIN0, DSIGN, DSQRT + INTRINSIC ABS, DMAX1, DCONJG, DBLE, MIN0, DSIGN, DSQRT * .. * .. External Functions .. DOUBLE PRECISION DZNRM2 @@ -889,8 +889,8 @@ IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR. $ ( ISWROT.LE.N ) ) )SWBAND = i * - IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DFLOAT( N ) )* - $ TOL ) .AND. ( DFLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN + IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DBLE( N ) )* + $ TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN GO TO 1994 END IF * diff --git a/lapack-netlib/SRC/zgsvj1.f b/lapack-netlib/SRC/zgsvj1.f index 54410cc0f..65b383b78 100644 --- a/lapack-netlib/SRC/zgsvj1.f +++ b/lapack-netlib/SRC/zgsvj1.f @@ -1,4 +1,4 @@ -*> \brief \b ZGSVJ1 pre-processor for the routine sgesvj, applies Jacobi rotations targeting only particular pivots. +*> \brief \b ZGSVJ1 pre-processor for the routine zgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== * @@ -105,7 +105,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is DOUBLE PRECISION array, dimension (LDA,N) +*> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, M-by-N matrix A, such that A*diag(D) represents *> the input matrix. *> On exit, @@ -124,7 +124,7 @@ *> *> \param[in,out] D *> \verbatim -*> D is DOUBLE PRECISION array, dimension (N) +*> D is COMPLEX*16 array, dimension (N) *> The array D accumulates the scaling factors from the fast scaled *> Jacobi rotations. *> On entry, A*diag(D) represents the input matrix. @@ -154,7 +154,7 @@ *> *> \param[in,out] V *> \verbatim -*> V is DOUBLE PRECISION array, dimension (LDV,N) +*> V is COMPLEX*16 array, dimension (LDV,N) *> If JOBV .EQ. 'V' then N rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a @@ -199,7 +199,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (LWORK) +*> WORK is COMPLEX*16 array, dimension (LWORK) *> \endverbatim *> *> \param[in] LWORK @@ -223,7 +223,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -236,10 +236,10 @@ SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * IMPLICIT NONE * .. Scalar Arguments .. @@ -271,7 +271,7 @@ * .. * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DCONJG, DMAX1, DFLOAT, MIN0, DSIGN, DSQRT + INTRINSIC ABS, DCONJG, DMAX1, DBLE, MIN0, DSIGN, DSQRT * .. * .. External Functions .. DOUBLE PRECISION DZNRM2 @@ -335,7 +335,7 @@ SMALL = SFMIN / EPS BIG = ONE / SFMIN ROOTBIG = ONE / ROOTSFMIN - LARGE = BIG / DSQRT( DFLOAT( M*N ) ) + LARGE = BIG / DSQRT( DBLE( M*N ) ) BIGTHETA = ONE / ROOTEPS ROOTTOL = DSQRT( TOL ) * @@ -660,8 +660,8 @@ IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR. $ ( ISWROT.LE.N ) ) )SWBAND = i * - IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DFLOAT( N ) )* - $ TOL ) .AND. ( DFLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN + IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DBLE( N ) )* + $ TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN GO TO 1994 END IF * diff --git a/lapack-netlib/SRC/zhbevx.f b/lapack-netlib/SRC/zhbevx.f index f060029ec..09322be40 100644 --- a/lapack-netlib/SRC/zhbevx.f +++ b/lapack-netlib/SRC/zhbevx.f @@ -123,12 +123,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -136,13 +139,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -251,7 +258,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHEReigen * @@ -260,10 +267,10 @@ $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zhbgvd.f b/lapack-netlib/SRC/zhbgvd.f index f60d6b017..333e4377f 100644 --- a/lapack-netlib/SRC/zhbgvd.f +++ b/lapack-netlib/SRC/zhbgvd.f @@ -238,7 +238,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHEReigen * @@ -252,10 +252,10 @@ $ Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO @@ -372,7 +372,7 @@ LLWK2 = LWORK - INDWK2 + 2 LLRWK = LRWORK - INDWRK + 2 CALL ZHBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ, - $ WORK, RWORK( INDWRK ), IINFO ) + $ WORK, RWORK, IINFO ) * * Reduce Hermitian band matrix to tridiagonal form. * diff --git a/lapack-netlib/SRC/zhbgvx.f b/lapack-netlib/SRC/zhbgvx.f index e8596e451..4d42b503e 100644 --- a/lapack-netlib/SRC/zhbgvx.f +++ b/lapack-netlib/SRC/zhbgvx.f @@ -153,13 +153,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -167,14 +171,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -277,7 +286,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHEReigen * @@ -291,10 +300,10 @@ $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, $ LDZ, WORK, RWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zheevr.f b/lapack-netlib/SRC/zheevr.f index 86e05b065..1ea82200f 100644 --- a/lapack-netlib/SRC/zheevr.f +++ b/lapack-netlib/SRC/zheevr.f @@ -155,12 +155,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -168,13 +171,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -329,7 +336,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16HEeigen * @@ -348,10 +355,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zheevx.f b/lapack-netlib/SRC/zheevx.f index 376d4c1b9..fe4422f6c 100644 --- a/lapack-netlib/SRC/zheevx.f +++ b/lapack-netlib/SRC/zheevx.f @@ -99,12 +99,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -112,13 +115,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -243,7 +250,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16HEeigen * @@ -252,10 +259,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zhegvx.f b/lapack-netlib/SRC/zhegvx.f index 932e070e2..2aaa33590 100644 --- a/lapack-netlib/SRC/zhegvx.f +++ b/lapack-netlib/SRC/zhegvx.f @@ -132,13 +132,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -146,14 +150,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -284,7 +293,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16HEeigen * @@ -298,10 +307,10 @@ $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, $ LWORK, RWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zhetrf_rook.f b/lapack-netlib/SRC/zhetrf_rook.f index 64e59aab5..afbad21c3 100644 --- a/lapack-netlib/SRC/zhetrf_rook.f +++ b/lapack-netlib/SRC/zhetrf_rook.f @@ -150,7 +150,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complex16HEcomputational * @@ -199,7 +199,7 @@ *> *> \verbatim *> -*> November 2013, Igor Kozachenko, +*> June 2016, Igor Kozachenko, *> Computer Science Division, *> University of California, Berkeley *> @@ -212,10 +212,10 @@ * ===================================================================== SUBROUTINE ZHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -265,7 +265,7 @@ * Determine the block size * NB = ILAENV( 1, 'ZHETRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/zhetrs2.f b/lapack-netlib/SRC/zhetrs2.f index 15b460b44..7f72c18fe 100644 --- a/lapack-netlib/SRC/zhetrs2.f +++ b/lapack-netlib/SRC/zhetrs2.f @@ -101,7 +101,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (N) +*> WORK is COMPLEX*16 array, dimension (N) *> \endverbatim *> *> \param[out] INFO @@ -119,7 +119,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16HEcomputational * @@ -127,10 +127,10 @@ SUBROUTINE ZHETRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/zhgeqz.f b/lapack-netlib/SRC/zhgeqz.f index 98d1fb06d..fb2df81ef 100644 --- a/lapack-netlib/SRC/zhgeqz.f +++ b/lapack-netlib/SRC/zhgeqz.f @@ -190,12 +190,12 @@ *> \param[in,out] Q *> \verbatim *> Q is COMPLEX*16 array, dimension (LDQ, N) -*> On entry, if COMPZ = 'V', the unitary matrix Q1 used in the +*> On entry, if COMPQ = 'V', the unitary matrix Q1 used in the *> reduction of (A,B) to generalized Hessenberg form. -*> On exit, if COMPZ = 'I', the unitary matrix of left Schur -*> vectors of (H,T), and if COMPZ = 'V', the unitary matrix of +*> On exit, if COMPQ = 'I', the unitary matrix of left Schur +*> vectors of (H,T), and if COMPQ = 'V', the unitary matrix of *> left Schur vectors of (A,B). -*> Not referenced if COMPZ = 'N'. +*> Not referenced if COMPQ = 'N'. *> \endverbatim *> *> \param[in] LDQ @@ -284,7 +284,7 @@ $ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, $ RWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 diff --git a/lapack-netlib/SRC/zhpevx.f b/lapack-netlib/SRC/zhpevx.f index e80435567..a7a6abc4d 100644 --- a/lapack-netlib/SRC/zhpevx.f +++ b/lapack-netlib/SRC/zhpevx.f @@ -97,12 +97,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -110,13 +113,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -224,7 +231,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHEReigen * @@ -233,10 +240,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zhpgvx.f b/lapack-netlib/SRC/zhpgvx.f index 5495c0034..ef7e11977 100644 --- a/lapack-netlib/SRC/zhpgvx.f +++ b/lapack-netlib/SRC/zhpgvx.f @@ -118,13 +118,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,14 +136,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -254,7 +263,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHEReigen * @@ -268,10 +277,10 @@ $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zla_gerpvgrw.f b/lapack-netlib/SRC/zla_gerpvgrw.f index aae5e6667..096ab3733 100644 --- a/lapack-netlib/SRC/zla_gerpvgrw.f +++ b/lapack-netlib/SRC/zla_gerpvgrw.f @@ -61,7 +61,7 @@ *> *> \param[in] A *> \verbatim -*> A is DOUBLE PRECISION array, dimension (LDA,N) +*> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the N-by-N matrix A. *> \endverbatim *> @@ -73,7 +73,7 @@ *> *> \param[in] AF *> \verbatim -*> AF is DOUBLE PRECISION array, dimension (LDAF,N) +*> AF is COMPLEX*16 array, dimension (LDAF,N) *> The factors L and U from the factorization *> A = P*L*U as computed by ZGETRF. *> \endverbatim @@ -92,7 +92,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16GEcomputational * @@ -100,10 +100,10 @@ DOUBLE PRECISION FUNCTION ZLA_GERPVGRW( N, NCOLS, A, LDA, AF, $ LDAF ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER N, NCOLS, LDA, LDAF diff --git a/lapack-netlib/SRC/zla_herpvgrw.f b/lapack-netlib/SRC/zla_herpvgrw.f index e1fb5c4dc..8d9e2a23f 100644 --- a/lapack-netlib/SRC/zla_herpvgrw.f +++ b/lapack-netlib/SRC/zla_herpvgrw.f @@ -104,7 +104,7 @@ *> *> \param[in] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension (2*N) +*> WORK is DOUBLE PRECISION array, dimension (2*N) *> \endverbatim * * Authors: @@ -115,7 +115,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16HEcomputational * @@ -123,10 +123,10 @@ DOUBLE PRECISION FUNCTION ZLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, $ LDAF, IPIV, WORK ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER*1 UPLO diff --git a/lapack-netlib/SRC/zla_lin_berr.f b/lapack-netlib/SRC/zla_lin_berr.f index 161eed970..212c3582f 100644 --- a/lapack-netlib/SRC/zla_lin_berr.f +++ b/lapack-netlib/SRC/zla_lin_berr.f @@ -67,7 +67,7 @@ *> *> \param[in] RES *> \verbatim -*> RES is DOUBLE PRECISION array, dimension (N,NRHS) +*> RES is COMPLEX*16 array, dimension (N,NRHS) *> The residual matrix, i.e., the matrix R in the relative backward *> error formula above. *> \endverbatim @@ -82,7 +82,7 @@ *> *> \param[out] BERR *> \verbatim -*> BERR is COMPLEX*16 array, dimension (NRHS) +*> BERR is DOUBLE PRECISION array, dimension (NRHS) *> The componentwise relative backward error from the formula above. *> \endverbatim * @@ -94,17 +94,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZLA_LIN_BERR ( N, NZ, NRHS, RES, AYB, BERR ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER N, NZ, NRHS diff --git a/lapack-netlib/SRC/zla_porpvgrw.f b/lapack-netlib/SRC/zla_porpvgrw.f index 682a670a9..1cf63cdba 100644 --- a/lapack-netlib/SRC/zla_porpvgrw.f +++ b/lapack-netlib/SRC/zla_porpvgrw.f @@ -88,7 +88,7 @@ *> *> \param[in] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension (2*N) +*> WORK is DOUBLE PRECISION array, dimension (2*N) *> \endverbatim * * Authors: @@ -99,7 +99,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16POcomputational * @@ -107,10 +107,10 @@ DOUBLE PRECISION FUNCTION ZLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, $ LDAF, WORK ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER*1 UPLO diff --git a/lapack-netlib/SRC/zlaed7.f b/lapack-netlib/SRC/zlaed7.f index ae6e9a36a..26a0534f6 100644 --- a/lapack-netlib/SRC/zlaed7.f +++ b/lapack-netlib/SRC/zlaed7.f @@ -57,7 +57,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine DLAED2. *> @@ -239,7 +239,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -249,10 +249,10 @@ $ GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER CURLVL, CURPBM, CUTPNT, INFO, LDQ, N, QSIZ, diff --git a/lapack-netlib/SRC/zlaqr3.f b/lapack-netlib/SRC/zlaqr3.f index 398801471..b09c3ef7c 100644 --- a/lapack-netlib/SRC/zlaqr3.f +++ b/lapack-netlib/SRC/zlaqr3.f @@ -138,7 +138,7 @@ *> Z is COMPLEX*16 array, dimension (LDZ,N) *> IF WANTZ is .TRUE., then on output, the unitary *> similarity transformation mentioned above has been -*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> accumulated into Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ is .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -252,7 +252,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * @@ -267,10 +267,10 @@ $ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, $ NV, WV, LDWV, WORK, LWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, diff --git a/lapack-netlib/SRC/zlaqr5.f b/lapack-netlib/SRC/zlaqr5.f index e33a30d65..66f550fce 100644 --- a/lapack-netlib/SRC/zlaqr5.f +++ b/lapack-netlib/SRC/zlaqr5.f @@ -142,10 +142,10 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is COMPLEX*16 array of size (LDZ,IHI) +*> Z is COMPLEX*16 array of size (LDZ,IHIZ) *> If WANTZ = .TRUE., then the QR Sweep unitary *> similarity transformation is accumulated into -*> Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ = .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -228,7 +228,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * @@ -251,10 +251,10 @@ $ H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV, $ WV, LDWV, NH, WH, LDWH ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, diff --git a/lapack-netlib/SRC/zlarcm.f b/lapack-netlib/SRC/zlarcm.f index e72c1061b..90af72ef7 100644 --- a/lapack-netlib/SRC/zlarcm.f +++ b/lapack-netlib/SRC/zlarcm.f @@ -72,7 +72,7 @@ *> *> \param[in] B *> \verbatim -*> B is DOUBLE PRECISION array, dimension (LDB, N) +*> B is COMPLEX*16 array, dimension (LDB, N) *> B contains the M by N matrix B. *> \endverbatim *> @@ -107,17 +107,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLARCM( M, N, A, LDA, B, LDB, C, LDC, RWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB, LDC, M, N diff --git a/lapack-netlib/SRC/zlarft.f b/lapack-netlib/SRC/zlarft.f index b9ac93976..7e1013f2f 100644 --- a/lapack-netlib/SRC/zlarft.f +++ b/lapack-netlib/SRC/zlarft.f @@ -130,7 +130,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * @@ -163,10 +163,10 @@ * ===================================================================== SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER DIRECT, STOREV @@ -303,7 +303,7 @@ * CALL ZGEMM( 'N', 'C', K-I, 1, N-K+I-J, -TAU( I ), $ V( I+1, J ), LDV, V( I, J ), LDV, - $ ONE, T( I+1, I ), LDT ) + $ ONE, T( I+1, I ), LDT ) END IF * * T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) diff --git a/lapack-netlib/SRC/zlarrv.f b/lapack-netlib/SRC/zlarrv.f index 3992f14d5..c29dda1bc 100644 --- a/lapack-netlib/SRC/zlarrv.f +++ b/lapack-netlib/SRC/zlarrv.f @@ -59,12 +59,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> Lower bound of the interval that contains the desired +*> eigenvalues. VL < VU. Needed to compute gaps on the left or right +*> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> Lower and upper bounds of the interval that contains the desired +*> Upper bound of the interval that contains the desired *> eigenvalues. VL < VU. Needed to compute gaps on the left or right *> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim @@ -81,7 +84,7 @@ *> L is DOUBLE PRECISION array, dimension (N) *> On entry, the (N-1) subdiagonal elements of the unit *> bidiagonal matrix L are in elements 1 to N-1 of L -*> (if the matrix is not splitted.) At the end of each block +*> (if the matrix is not split.) At the end of each block *> is stored the corresponding shift as given by DLARRE. *> On exit, L is overwritten. *> \endverbatim @@ -236,7 +239,7 @@ *> INFO is INTEGER *> = 0: successful exit *> -*> > 0: A problem occured in ZLARRV. +*> > 0: A problem occurred in ZLARRV. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -263,7 +266,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * @@ -283,10 +286,10 @@ $ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER DOL, DOU, INFO, LDZ, M, N diff --git a/lapack-netlib/SRC/zlarscl2.f b/lapack-netlib/SRC/zlarscl2.f index b54f02c98..2b47d6ba2 100644 --- a/lapack-netlib/SRC/zlarscl2.f +++ b/lapack-netlib/SRC/zlarscl2.f @@ -73,7 +73,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -84,17 +84,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZLARSCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/zlascl.f b/lapack-netlib/SRC/zlascl.f index 51a4f0f61..1618fdbaa 100644 --- a/lapack-netlib/SRC/zlascl.f +++ b/lapack-netlib/SRC/zlascl.f @@ -114,7 +114,11 @@ *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). +*> The leading dimension of the array A. +*> If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M); +*> TYPE = 'B', LDA >= KL+1; +*> TYPE = 'Q', LDA >= KU+1; +*> TYPE = 'Z', LDA >= 2*KL+KU+1. *> \endverbatim *> *> \param[out] INFO @@ -132,17 +136,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER TYPE diff --git a/lapack-netlib/SRC/zlascl2.f b/lapack-netlib/SRC/zlascl2.f index eebdebb4d..78b94b3d5 100644 --- a/lapack-netlib/SRC/zlascl2.f +++ b/lapack-netlib/SRC/zlascl2.f @@ -73,7 +73,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -84,17 +84,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZLASCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/zlatdf.f b/lapack-netlib/SRC/zlatdf.f index e90bfede0..8551ca4f1 100644 --- a/lapack-netlib/SRC/zlatdf.f +++ b/lapack-netlib/SRC/zlatdf.f @@ -58,7 +58,7 @@ *> Zx = +-e - f with the sign giving the greater value of *> 2-norm(x). About 5 times as expensive as Default. *> IJOB .ne. 2: Local look ahead strategy where -*> all entries of the r.h.s. b is choosen as either +1 or +*> all entries of the r.h.s. b is chosen as either +1 or *> -1. Default. *> \endverbatim *> @@ -70,7 +70,7 @@ *> *> \param[in] Z *> \verbatim -*> Z is DOUBLE PRECISION array, dimension (LDZ, N) +*> Z is COMPLEX*16 array, dimension (LDZ, N) *> On entry, the LU part of the factorization of the n-by-n *> matrix Z computed by ZGETC2: Z = P * L * U * Q *> \endverbatim @@ -83,7 +83,7 @@ *> *> \param[in,out] RHS *> \verbatim -*> RHS is DOUBLE PRECISION array, dimension (N). +*> RHS is COMPLEX*16 array, dimension (N). *> On entry, RHS contains contributions from other subsystems. *> On exit, RHS contains the solution of the subsystem with *> entries according to the value of IJOB (see above). @@ -134,7 +134,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * @@ -169,10 +169,10 @@ SUBROUTINE ZLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, $ JPIV ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IJOB, LDZ, N diff --git a/lapack-netlib/SRC/zpbrfs.f b/lapack-netlib/SRC/zpbrfs.f index a75f563ae..a47cd17a7 100644 --- a/lapack-netlib/SRC/zpbrfs.f +++ b/lapack-netlib/SRC/zpbrfs.f @@ -75,7 +75,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) +*> AB is COMPLEX*16 array, dimension (LDAB,N) *> The upper or lower triangle of the Hermitian band matrix A, *> stored in the first KD+1 rows of the array. The j-th column *> of A is stored in the j-th column of the array AB as follows: @@ -181,7 +181,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -189,10 +189,10 @@ SUBROUTINE ZPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, $ LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/zpftrf.f b/lapack-netlib/SRC/zpftrf.f index 179bcac00..de07310a6 100644 --- a/lapack-netlib/SRC/zpftrf.f +++ b/lapack-netlib/SRC/zpftrf.f @@ -69,7 +69,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is COMPLEX array, dimension ( N*(N+1)/2 ); +*> A is COMPLEX*16 array, dimension ( N*(N+1)/2 ); *> On entry, the Hermitian matrix A in RFP format. RFP format is *> described by TRANSR, UPLO, and N as follows: If TRANSR = 'N' *> then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is @@ -204,17 +204,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZPFTRF( TRANSR, UPLO, N, A, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER TRANSR, UPLO diff --git a/lapack-netlib/SRC/zpttrs.f b/lapack-netlib/SRC/zpttrs.f index 8d6aa3912..4940b3e00 100644 --- a/lapack-netlib/SRC/zpttrs.f +++ b/lapack-netlib/SRC/zpttrs.f @@ -87,7 +87,7 @@ *> *> \param[in,out] B *> \verbatim -*> B is DOUBLE PRECISION array, dimension (LDB,NRHS) +*> B is COMPLEX*16 array, dimension (LDB,NRHS) *> On entry, the right hand side vectors B for the system of *> linear equations. *> On exit, the solution vectors, X. @@ -114,17 +114,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16PTcomputational * * ===================================================================== SUBROUTINE ZPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/zptts2.f b/lapack-netlib/SRC/zptts2.f index 3be100a23..434dbceda 100644 --- a/lapack-netlib/SRC/zptts2.f +++ b/lapack-netlib/SRC/zptts2.f @@ -86,7 +86,7 @@ *> *> \param[in,out] B *> \verbatim -*> B is DOUBLE PRECISION array, dimension (LDB,NRHS) +*> B is COMPLEX*16 array, dimension (LDB,NRHS) *> On entry, the right hand side vectors B for the system of *> linear equations. *> On exit, the solution vectors, X. @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16PTcomputational * * ===================================================================== SUBROUTINE ZPTTS2( IUPLO, N, NRHS, D, E, B, LDB ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IUPLO, LDB, N, NRHS diff --git a/lapack-netlib/SRC/zstegr.f b/lapack-netlib/SRC/zstegr.f index 16a4e789c..b68a4c447 100644 --- a/lapack-netlib/SRC/zstegr.f +++ b/lapack-netlib/SRC/zstegr.f @@ -48,7 +48,7 @@ *> either an interval (VL,VU] or a range of indices IL:IU for the desired *> eigenvalues. *> -*> ZSTEGR is a compatability wrapper around the improved ZSTEMR routine. +*> ZSTEGR is a compatibility wrapper around the improved ZSTEMR routine. *> See DSTEMR for further details. *> *> One important change is that the ABSTOL parameter no longer provides any @@ -105,13 +105,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -119,14 +123,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -240,7 +249,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -256,10 +265,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/zstemr.f b/lapack-netlib/SRC/zstemr.f index cc815666a..0de085271 100644 --- a/lapack-netlib/SRC/zstemr.f +++ b/lapack-netlib/SRC/zstemr.f @@ -153,13 +153,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -167,14 +171,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -311,7 +320,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -329,10 +338,10 @@ $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/zsytrf_rook.f b/lapack-netlib/SRC/zsytrf_rook.f index f5d3e51bf..9ba446abc 100644 --- a/lapack-netlib/SRC/zsytrf_rook.f +++ b/lapack-netlib/SRC/zsytrf_rook.f @@ -146,7 +146,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16SYcomputational * @@ -195,7 +195,7 @@ *> *> \verbatim *> -*> November 2015, Igor Kozachenko, +*> June 2016, Igor Kozachenko, *> Computer Science Division, *> University of California, Berkeley *> @@ -208,10 +208,10 @@ * ===================================================================== SUBROUTINE ZSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -261,7 +261,7 @@ * Determine the block size * NB = ILAENV( 1, 'ZSYTRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/zsytrs2.f b/lapack-netlib/SRC/zsytrs2.f index 6321197f9..890c07a97 100644 --- a/lapack-netlib/SRC/zsytrs2.f +++ b/lapack-netlib/SRC/zsytrs2.f @@ -106,7 +106,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (N) +*> WORK is COMPLEX*16 array, dimension (N) *> \endverbatim *> *> \param[out] INFO @@ -124,7 +124,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16SYcomputational * @@ -132,10 +132,10 @@ SUBROUTINE ZSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/ztgsen.f b/lapack-netlib/SRC/ztgsen.f index 4c991ec40..87e0f99ac 100644 --- a/lapack-netlib/SRC/ztgsen.f +++ b/lapack-netlib/SRC/ztgsen.f @@ -290,7 +290,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -433,10 +433,10 @@ $ ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, $ WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL WANTQ, WANTZ @@ -518,6 +518,7 @@ * subspaces. * M = 0 + IF( .NOT.LQUERY .OR. IJOB.NE.0 ) THEN DO 10 K = 1, N ALPHA( K ) = A( K, K ) BETA( K ) = B( K, K ) @@ -529,6 +530,7 @@ $ M = M + 1 END IF 10 CONTINUE + END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN LWMIN = MAX( 1, 2*M*( N-M ) ) diff --git a/lapack-netlib/SRC/ztrevc3.f b/lapack-netlib/SRC/ztrevc3.f new file mode 100644 index 000000000..22654856a --- /dev/null +++ b/lapack-netlib/SRC/ztrevc3.f @@ -0,0 +1,630 @@ +*> \brief \b ZTREVC3 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZTREVC3 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, +* VR, LDVR, MM, M, WORK, LWORK, RWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER HOWMNY, SIDE +* INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. +* LOGICAL SELECT( * ) +* DOUBLE PRECISION RWORK( * ) +* COMPLEX*16 T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), +* $ WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZTREVC3 computes some or all of the right and/or left eigenvectors of +*> a complex upper triangular matrix T. +*> Matrices of this type are produced by the Schur factorization of +*> a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. +*> +*> The right eigenvector x and the left eigenvector y of T corresponding +*> to an eigenvalue w are defined by: +*> +*> T*x = w*x, (y**H)*T = w*(y**H) +*> +*> where y**H denotes the conjugate transpose of the vector y. +*> The eigenvalues are not input to this routine, but are read directly +*> from the diagonal of T. +*> +*> This routine returns the matrices X and/or Y of right and left +*> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an +*> input matrix. If Q is the unitary factor that reduces a matrix A to +*> Schur form T, then Q*X and Q*Y are the matrices of right and left +*> eigenvectors of A. +*> +*> This uses a Level 3 BLAS version of the back transformation. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'R': compute right eigenvectors only; +*> = 'L': compute left eigenvectors only; +*> = 'B': compute both right and left eigenvectors. +*> \endverbatim +*> +*> \param[in] HOWMNY +*> \verbatim +*> HOWMNY is CHARACTER*1 +*> = 'A': compute all right and/or left eigenvectors; +*> = 'B': compute all right and/or left eigenvectors, +*> backtransformed using the matrices supplied in +*> VR and/or VL; +*> = 'S': compute selected right and/or left eigenvectors, +*> as indicated by the logical array SELECT. +*> \endverbatim +*> +*> \param[in] SELECT +*> \verbatim +*> SELECT is LOGICAL array, dimension (N) +*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be +*> computed. +*> The eigenvector corresponding to the j-th eigenvalue is +*> computed if SELECT(j) = .TRUE.. +*> Not referenced if HOWMNY = 'A' or 'B'. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the matrix T. N >= 0. +*> \endverbatim +*> +*> \param[in,out] T +*> \verbatim +*> T is COMPLEX*16 array, dimension (LDT,N) +*> The upper triangular matrix T. T is modified, but restored +*> on exit. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= max(1,N). +*> \endverbatim +*> +*> \param[in,out] VL +*> \verbatim +*> VL is COMPLEX*16 array, dimension (LDVL,MM) +*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must +*> contain an N-by-N matrix Q (usually the unitary matrix Q of +*> Schur vectors returned by ZHSEQR). +*> On exit, if SIDE = 'L' or 'B', VL contains: +*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*Y; +*> if HOWMNY = 'S', the left eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VL, in the same order as their +*> eigenvalues. +*> Not referenced if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDVL +*> \verbatim +*> LDVL is INTEGER +*> The leading dimension of the array VL. +*> LDVL >= 1, and if SIDE = 'L' or 'B', LDVL >= N. +*> \endverbatim +*> +*> \param[in,out] VR +*> \verbatim +*> VR is COMPLEX*16 array, dimension (LDVR,MM) +*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must +*> contain an N-by-N matrix Q (usually the unitary matrix Q of +*> Schur vectors returned by ZHSEQR). +*> On exit, if SIDE = 'R' or 'B', VR contains: +*> if HOWMNY = 'A', the matrix X of right eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*X; +*> if HOWMNY = 'S', the right eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VR, in the same order as their +*> eigenvalues. +*> Not referenced if SIDE = 'L'. +*> \endverbatim +*> +*> \param[in] LDVR +*> \verbatim +*> LDVR is INTEGER +*> The leading dimension of the array VR. +*> LDVR >= 1, and if SIDE = 'R' or 'B', LDVR >= N. +*> \endverbatim +*> +*> \param[in] MM +*> \verbatim +*> MM is INTEGER +*> The number of columns in the arrays VL and/or VR. MM >= M. +*> \endverbatim +*> +*> \param[out] M +*> \verbatim +*> M is INTEGER +*> The number of columns in the arrays VL and/or VR actually +*> used to store the eigenvectors. +*> If HOWMNY = 'A' or 'B', M is set to N. +*> Each selected eigenvector occupies one column. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of array WORK. LWORK >= max(1,2*N). +*> For optimum performance, LWORK >= N + 2*N*NB, 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] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, dimension (LRWORK) +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER +*> The dimension of array RWORK. LRWORK >= max(1,N). +*> +*> If LRWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal size of the RWORK array, returns +*> this value as the first entry of the RWORK array, and no error +*> message related to LRWORK 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. +* +*> \date November 2011 +* +* @precisions fortran z -> c +* +*> \ingroup complex16OTHERcomputational +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The algorithm used in this program is basically backward (forward) +*> substitution, with scaling to make the the code robust against +*> possible overflow. +*> +*> Each eigenvector is normalized so that the element of largest +*> magnitude has magnitude 1; here the magnitude of a complex number +*> (x,y) is taken to be |x| + |y|. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + $ LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2011 +* +* .. Scalar Arguments .. + CHARACTER HOWMNY, SIDE + INTEGER INFO, LDT, LDVL, LDVR, LWORK, LRWORK, M, MM, N +* .. +* .. Array Arguments .. + LOGICAL SELECT( * ) + DOUBLE PRECISION RWORK( * ) + COMPLEX*16 T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), + $ WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) + COMPLEX*16 CZERO, CONE + PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), + $ CONE = ( 1.0D+0, 0.0D+0 ) ) + INTEGER NBMIN, NBMAX + PARAMETER ( NBMIN = 8, NBMAX = 128 ) +* .. +* .. Local Scalars .. + LOGICAL ALLV, BOTHV, LEFTV, LQUERY, OVER, RIGHTV, SOMEV + INTEGER I, II, IS, J, K, KI, IV, MAXWRK, NB + DOUBLE PRECISION OVFL, REMAX, SCALE, SMIN, SMLNUM, ULP, UNFL + COMPLEX*16 CDUM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV, IZAMAX + DOUBLE PRECISION DLAMCH, DZASUM + EXTERNAL LSAME, ILAENV, IZAMAX, DLAMCH, DZASUM +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, DCMPLX, CONJG, AIMAG, MAX +* .. +* .. Statement Functions .. + DOUBLE PRECISION CABS1 +* .. +* .. Statement Function definitions .. + CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( AIMAG( CDUM ) ) +* .. +* .. Executable Statements .. +* +* Decode and test the input parameters +* + BOTHV = LSAME( SIDE, 'B' ) + RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV + LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV +* + ALLV = LSAME( HOWMNY, 'A' ) + OVER = LSAME( HOWMNY, 'B' ) + SOMEV = LSAME( HOWMNY, 'S' ) +* +* Set M to the number of columns required to store the selected +* eigenvectors. +* + IF( SOMEV ) THEN + M = 0 + DO 10 J = 1, N + IF( SELECT( J ) ) + $ M = M + 1 + 10 CONTINUE + ELSE + M = N + END IF +* + INFO = 0 + NB = ILAENV( 1, 'ZTREVC', SIDE // HOWMNY, N, -1, -1, -1 ) + MAXWRK = N + 2*N*NB + WORK(1) = MAXWRK + RWORK(1) = N + LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 ) + IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN + INFO = -1 + ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDT.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN + INFO = -8 + ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN + INFO = -10 + ELSE IF( MM.LT.M ) THEN + INFO = -11 + ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + INFO = -14 + ELSE IF ( LRWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN + INFO = -16 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZTREVC3', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible. +* + IF( N.EQ.0 ) + $ RETURN +* +* Use blocked version of back-transformation if sufficient workspace. +* Zero-out the workspace to avoid potential NaN propagation. +* + IF( OVER .AND. LWORK .GE. N + 2*N*NBMIN ) THEN + NB = (LWORK - N) / (2*N) + NB = MIN( NB, NBMAX ) + CALL ZLASET( 'F', N, 1+2*NB, CZERO, CZERO, WORK, N ) + ELSE + NB = 1 + END IF +* +* Set the constants to control overflow. +* + UNFL = DLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL DLABAD( UNFL, OVFL ) + ULP = DLAMCH( 'Precision' ) + SMLNUM = UNFL*( N / ULP ) +* +* Store the diagonal elements of T in working array WORK. +* + DO 20 I = 1, N + WORK( I ) = T( I, I ) + 20 CONTINUE +* +* Compute 1-norm of each column of strictly upper triangular +* part of T to control overflow in triangular solver. +* + RWORK( 1 ) = ZERO + DO 30 J = 2, N + RWORK( J ) = DZASUM( J-1, T( 1, J ), 1 ) + 30 CONTINUE +* + IF( RIGHTV ) THEN +* +* ============================================================ +* Compute right eigenvectors. +* +* IV is index of column in current block. +* Non-blocked version always uses IV=NB=1; +* blocked version starts with IV=NB, goes down to 1. +* (Note the "0-th" column is used to store the original diagonal.) + IV = NB + IS = M + DO 80 KI = N, 1, -1 + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 80 + END IF + SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM ) +* +* -------------------------------------------------------- +* Complex right eigenvector +* + WORK( KI + IV*N ) = CONE +* +* Form right-hand side. +* + DO 40 K = 1, KI - 1 + WORK( K + IV*N ) = -T( K, KI ) + 40 CONTINUE +* +* Solve upper triangular system: +* [ T(1:KI-1,1:KI-1) - T(KI,KI) ]*X = SCALE*WORK. +* + DO 50 K = 1, KI - 1 + T( K, K ) = T( K, K ) - T( KI, KI ) + IF( CABS1( T( K, K ) ).LT.SMIN ) + $ T( K, K ) = SMIN + 50 CONTINUE +* + IF( KI.GT.1 ) THEN + CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', 'Y', + $ KI-1, T, LDT, WORK( 1 + IV*N ), SCALE, + $ RWORK, INFO ) + WORK( KI + IV*N ) = SCALE + END IF +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL ZCOPY( KI, WORK( 1 + IV*N ), 1, VR( 1, IS ), 1 ) +* + II = IZAMAX( KI, VR( 1, IS ), 1 ) + REMAX = ONE / CABS1( VR( II, IS ) ) + CALL ZDSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 60 K = KI + 1, N + VR( K, IS ) = CZERO + 60 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.1 ) + $ CALL ZGEMV( 'N', N, KI-1, CONE, VR, LDVR, + $ WORK( 1 + IV*N ), 1, DCMPLX( SCALE ), + $ VR( 1, KI ), 1 ) +* + II = IZAMAX( N, VR( 1, KI ), 1 ) + REMAX = ONE / CABS1( VR( II, KI ) ) + CALL ZDSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + IV*N ) = CZERO + END DO +* +* Columns IV:NB of work are valid vectors. +* When the number of vectors stored reaches NB, +* or if this was last vector, do the GEMM + IF( (IV.EQ.1) .OR. (KI.EQ.1) ) THEN + CALL ZGEMM( 'N', 'N', N, NB-IV+1, KI+NB-IV, CONE, + $ VR, LDVR, + $ WORK( 1 + (IV)*N ), N, + $ CZERO, + $ WORK( 1 + (NB+IV)*N ), N ) +* normalize vectors + DO K = IV, NB + II = IZAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / CABS1( WORK( II + (NB+K)*N ) ) + CALL ZDSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL ZLACPY( 'F', N, NB-IV+1, + $ WORK( 1 + (NB+IV)*N ), N, + $ VR( 1, KI ), LDVR ) + IV = NB + ELSE + IV = IV - 1 + END IF + END IF +* +* Restore the original diagonal elements of T. +* + DO 70 K = 1, KI - 1 + T( K, K ) = WORK( K ) + 70 CONTINUE +* + IS = IS - 1 + 80 CONTINUE + END IF +* + IF( LEFTV ) THEN +* +* ============================================================ +* Compute left eigenvectors. +* +* IV is index of column in current block. +* Non-blocked version always uses IV=1; +* blocked version starts with IV=1, goes up to NB. +* (Note the "0-th" column is used to store the original diagonal.) + IV = 1 + IS = 1 + DO 130 KI = 1, N +* + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 130 + END IF + SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM ) +* +* -------------------------------------------------------- +* Complex left eigenvector +* + WORK( KI + IV*N ) = CONE +* +* Form right-hand side. +* + DO 90 K = KI + 1, N + WORK( K + IV*N ) = -CONJG( T( KI, K ) ) + 90 CONTINUE +* +* Solve conjugate-transposed triangular system: +* [ T(KI+1:N,KI+1:N) - T(KI,KI) ]**H * X = SCALE*WORK. +* + DO 100 K = KI + 1, N + T( K, K ) = T( K, K ) - T( KI, KI ) + IF( CABS1( T( K, K ) ).LT.SMIN ) + $ T( K, K ) = SMIN + 100 CONTINUE +* + IF( KI.LT.N ) THEN + CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', + $ 'Y', N-KI, T( KI+1, KI+1 ), LDT, + $ WORK( KI+1 + IV*N ), SCALE, RWORK, INFO ) + WORK( KI + IV*N ) = SCALE + END IF +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL ZCOPY( N-KI+1, WORK( KI + IV*N ), 1, VL(KI,IS), 1 ) +* + II = IZAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 + REMAX = ONE / CABS1( VL( II, IS ) ) + CALL ZDSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) +* + DO 110 K = 1, KI - 1 + VL( K, IS ) = CZERO + 110 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N ) + $ CALL ZGEMV( 'N', N, N-KI, CONE, VL( 1, KI+1 ), LDVL, + $ WORK( KI+1 + IV*N ), 1, DCMPLX( SCALE ), + $ VL( 1, KI ), 1 ) +* + II = IZAMAX( N, VL( 1, KI ), 1 ) + REMAX = ONE / CABS1( VL( II, KI ) ) + CALL ZDSCAL( N, REMAX, VL( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + IV*N ) = CZERO + END DO +* +* Columns 1:IV of work are valid vectors. +* When the number of vectors stored reaches NB, +* or if this was last vector, do the GEMM + IF( (IV.EQ.NB) .OR. (KI.EQ.N) ) THEN + CALL ZGEMM( 'N', 'N', N, IV, N-KI+IV, ONE, + $ VL( 1, KI-IV+1 ), LDVL, + $ WORK( KI-IV+1 + (1)*N ), N, + $ CZERO, + $ WORK( 1 + (NB+1)*N ), N ) +* normalize vectors + DO K = 1, IV + II = IZAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / CABS1( WORK( II + (NB+K)*N ) ) + CALL ZDSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL ZLACPY( 'F', N, IV, + $ WORK( 1 + (NB+1)*N ), N, + $ VL( 1, KI-IV+1 ), LDVL ) + IV = 1 + ELSE + IV = IV + 1 + END IF + END IF +* +* Restore the original diagonal elements of T. +* + DO 120 K = KI + 1, N + T( K, K ) = WORK( K ) + 120 CONTINUE +* + IS = IS + 1 + 130 CONTINUE + END IF +* + RETURN +* +* End of ZTREVC3 +* + END diff --git a/lapack-netlib/SRC/zunbdb1.f b/lapack-netlib/SRC/zunbdb1.f index 4125450c7..02375224e 100644 --- a/lapack-netlib/SRC/zunbdb1.f +++ b/lapack-netlib/SRC/zunbdb1.f @@ -203,7 +203,7 @@ SUBROUTINE ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -308,9 +308,8 @@ CALL ZLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I, X21(I,I+1), LDX21 ) - C = SQRT( DZNRM2( P-I, X11(I+1,I+1), 1, X11(I+1,I+1), - $ 1 )**2 + DZNRM2( M-P-I, X21(I+1,I+1), 1, X21(I+1,I+1), - $ 1 )**2 ) + C = SQRT( DZNRM2( P-I, X11(I+1,I+1), 1 )**2 + $ + DZNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) PHI(I) = ATAN2( S, C ) CALL ZUNBDB5( P-I, M-P-I, Q-I-1, X11(I+1,I+1), 1, $ X21(I+1,I+1), 1, X11(I+1,I+2), LDX11, diff --git a/lapack-netlib/SRC/zunbdb2.f b/lapack-netlib/SRC/zunbdb2.f index 89104f650..65508ec1e 100644 --- a/lapack-netlib/SRC/zunbdb2.f +++ b/lapack-netlib/SRC/zunbdb2.f @@ -201,7 +201,7 @@ SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -295,8 +295,8 @@ CALL ZLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X21(I,I), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I+1, X11(I,I), LDX11 ) - S = SQRT( DZNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + DZNRM2( M-P-I+1, X21(I,I), 1, X21(I,I), 1 )**2 ) + S = SQRT( DZNRM2( P-I, X11(I+1,I), 1 )**2 + $ + DZNRM2( M-P-I+1, X21(I,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL ZUNBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1, diff --git a/lapack-netlib/SRC/zunbdb3.f b/lapack-netlib/SRC/zunbdb3.f index 37a5c89f4..c1336c48c 100644 --- a/lapack-netlib/SRC/zunbdb3.f +++ b/lapack-netlib/SRC/zunbdb3.f @@ -201,7 +201,7 @@ SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -295,8 +295,8 @@ CALL ZLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I+1, X21(I,I), LDX21 ) - C = SQRT( DZNRM2( P-I+1, X11(I,I), 1, X11(I,I), - $ 1 )**2 + DZNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), 1 )**2 ) + C = SQRT( DZNRM2( P-I+1, X11(I,I), 1 )**2 + $ + DZNRM2( M-P-I, X21(I+1,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL ZUNBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1, diff --git a/lapack-netlib/SRC/zunbdb4.f b/lapack-netlib/SRC/zunbdb4.f index 91ed9d052..17f529ee8 100644 --- a/lapack-netlib/SRC/zunbdb4.f +++ b/lapack-netlib/SRC/zunbdb4.f @@ -213,7 +213,7 @@ $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -344,9 +344,8 @@ $ X21(I+1,I), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I+1, X21(I,I), LDX21 ) IF( I .LT. M-Q ) THEN - S = SQRT( DZNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + DZNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), - $ 1 )**2 ) + S = SQRT( DZNRM2( P-I, X11(I+1,I), 1 )**2 + $ + DZNRM2( M-P-I, X21(I+1,I), 1 )**2 ) PHI(I) = ATAN2( S, C ) END IF * diff --git a/lapack-netlib/SRC/zuncsd2by1.f b/lapack-netlib/SRC/zuncsd2by1.f index 432471fe2..d4ab1eef5 100644 --- a/lapack-netlib/SRC/zuncsd2by1.f +++ b/lapack-netlib/SRC/zuncsd2by1.f @@ -253,7 +253,7 @@ $ LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -287,6 +287,10 @@ $ LWORKMIN, LWORKOPT, R LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. +* .. Local Arrays .. + DOUBLE PRECISION DUM( 1 ) + COMPLEX*16 CDUM( 1, 1 ) +* .. * .. External Subroutines .. EXTERNAL ZBBCSD, ZCOPY, ZLACPY, ZLAPMR, ZLAPMT, ZUNBDB1, $ ZUNBDB2, ZUNBDB3, ZUNBDB4, ZUNGLQ, ZUNGQR, @@ -319,11 +323,11 @@ INFO = -8 ELSE IF( LDX21 .LT. MAX( 1, M-P ) ) THEN INFO = -10 - ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN + ELSE IF( WANTU1 .AND. LDU1 .LT. MAX( 1, P ) ) THEN INFO = -13 - ELSE IF( WANTU2 .AND. LDU2 .LT. M - P ) THEN + ELSE IF( WANTU2 .AND. LDU2 .LT. MAX( 1, M - P ) ) THEN INFO = -15 - ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN + ELSE IF( WANTV1T .AND. LDV1T .LT. MAX( 1, Q ) ) THEN INFO = -17 END IF * @@ -379,99 +383,118 @@ IORBDB = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ1 + MAX( 1, Q ) IORGLQ = ITAUQ1 + MAX( 1, Q ) + LORGQRMIN = 1 + LORGQROPT = 1 + LORGLQMIN = 1 + LORGLQOPT = 1 IF( R .EQ. Q ) THEN - CALL ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK, -1, CHILDINFO ) + CALL ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK, -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL ZUNGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P, P, Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + ENDIF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, + $ CDUM, WORK(1), -1, CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q-1 ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( MAX(0,Q-1), MAX(0,Q-1), MAX(0,Q-1), V1T, LDV1T, - $ 0, WORK(1), -1, CHILDINFO ) - LORGLQMIN = MAX( 1, Q-1 ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, 0, 0, - $ 0, 0, 0, 0, 0, 0, RWORK(1), -1, CHILDINFO ) + $ DUM, U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM, 1, + $ DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE IF( R .EQ. P ) THEN - CALL ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P-1 .GE. M-P ) THEN - CALL ZUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, 0, WORK(1), + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, CDUM, WORK(1), $ -1, CHILDINFO ) - LORGQRMIN = MAX( 1, P-1 ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, - $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ 0, V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, 0, 0, - $ 0, 0, 0, 0, 0, 0, RWORK(1), -1, CHILDINFO ) + $ DUM, V1T, LDV1T, CDUM, 1, U1, LDU1, U2, LDU2, + $ DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE IF( R .EQ. M-P ) THEN - CALL ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P-1 ) THEN - CALL ZUNGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P, P, Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, 0, - $ WORK(1), -1, CHILDINFO ) - LORGQRMIN = MAX( 1, M-P-1 ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, CDUM, + $ WORK(1), -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, 0, 0, 1, V1T, LDV1T, U2, LDU2, U1, LDU1, - $ 0, 0, 0, 0, 0, 0, 0, 0, RWORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM, CDUM, 1, V1T, LDV1T, U2, LDU2, U1, + $ LDU1, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE - CALL ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, 0, WORK(1), -1, CHILDINFO ) + CALL ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO + $ ) LORBDB = M + INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL ZUNGQR( P, P, M-Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P, P, M-Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P, M-P, M-Q, U2, LDU2, 0, WORK(1), -1, - $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P, M-P, M-Q, U2, LDU2, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q, Q, Q, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( Q, Q, Q, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, 0, U2, LDU2, U1, LDU1, 0, 1, V1T, LDV1T, - $ 0, 0, 0, 0, 0, 0, 0, 0, RWORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM, U2, LDU2, U1, LDU1, CDUM, 1, V1T, + $ LDV1T, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) END IF LRWORKMIN = IBBCSD+LBBCSD-1 @@ -537,8 +560,8 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, - $ RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), + $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM, + $ 1, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -591,8 +614,8 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ RWORK(IPHI), V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, - $ RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), + $ RWORK(IPHI), V1T, LDV1T, CDUM, 1, U1, LDU1, U2, + $ LDU2, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -646,7 +669,7 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, RWORK(IPHI), 0, 1, V1T, LDV1T, U2, LDU2, + $ THETA, RWORK(IPHI), CDUM, 1, V1T, LDV1T, U2, LDU2, $ U1, LDU1, RWORK(IB11D), RWORK(IB11E), $ RWORK(IB12D), RWORK(IB12E), RWORK(IB21D), $ RWORK(IB21E), RWORK(IB22D), RWORK(IB22E), @@ -715,11 +738,11 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, RWORK(IPHI), U2, LDU2, U1, LDU1, 0, 1, V1T, - $ LDV1T, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), - $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), - $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, RWORK(IPHI), U2, LDU2, U1, LDU1, CDUM, 1, + $ V1T, LDV1T, RWORK(IB11D), RWORK(IB11E), + $ RWORK(IB12D), RWORK(IB12E), RWORK(IB21D), + $ RWORK(IB21E), RWORK(IB22D), RWORK(IB22E), + $ RWORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions diff --git a/lapack-netlib/TESTING/EIG/cchkbd.f b/lapack-netlib/TESTING/EIG/cchkbd.f index f5d998218..1d85866dc 100644 --- a/lapack-netlib/TESTING/EIG/cchkbd.f +++ b/lapack-netlib/TESTING/EIG/cchkbd.f @@ -405,7 +405,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_eig * @@ -415,10 +415,10 @@ $ Y, Z, Q, LDQ, PT, LDPT, U, VT, WORK, LWORK, $ RWORK, NOUT, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDPT, LDQ, LDX, LWORK, NOUT, NRHS, @@ -466,9 +466,10 @@ EXTERNAL SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL ALASUM, CBDSQR, CBDT01, CBDT02, CBDT03, CGEBRD, - $ CGEMM, CLACPY, CLASET, CLATMR, CLATMS, CUNGBR, - $ CUNT01, SCOPY, SLABAD, SLAHD2, SSVDCH, XERBLA + EXTERNAL ALASUM, CBDSQR, CBDT01, CBDT02, CBDT03, + $ CGEBRD, CGEMM, CLACPY, CLASET, CLATMR, + $ CLATMS, CUNGBR, CUNT01, SCOPY, SLABAD, + $ SLAHD2, SSVDCH, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, EXP, INT, LOG, MAX, MIN, SQRT @@ -483,9 +484,9 @@ COMMON / SRNAMC / SRNAMT * .. * .. Data statements .. - DATA KTYPE / 1, 2, 5*4, 5*6, 3*9, 10 / - DATA KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 / - DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, + DATA KTYPE / 1, 2, 5*4, 5*6, 3*9, 10 / + DATA KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 / + DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, $ 0, 0, 0 / * .. * .. Executable Statements .. diff --git a/lapack-netlib/TESTING/EIG/cchkee.f b/lapack-netlib/TESTING/EIG/cchkee.f index 91214b0cf..edea33b65 100644 --- a/lapack-netlib/TESTING/EIG/cchkee.f +++ b/lapack-netlib/TESTING/EIG/cchkee.f @@ -1027,17 +1027,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex_eig * * ===================================================================== PROGRAM CCHKEE * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * ===================================================================== * @@ -2098,6 +2098,7 @@ MAXTYP = 26 NTYPES = MIN( MAXTYP, NTYPES ) CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT ) + CALL XLAENV(1,1) IF( TSTCHK .AND. TSTERR ) $ CALL CERRGG( C3, NOUT ) DO 350 I = 1, NPARMS @@ -2157,6 +2158,7 @@ * * Blocked version * + CALL XLAENV(16,2) CALL CDRGES3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT, $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ), $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ), @@ -2223,6 +2225,7 @@ * * Blocked version * + CALL XLAENV(16,2) CALL CDRGEV3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT, $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ), $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ), @@ -2348,6 +2351,7 @@ * GSV: Generalized Singular Value Decomposition * ---------------------------------------------- * + CALL XLAENV(1,1) IF( TSTERR ) $ CALL CERRGG( 'GSV', NOUT ) CALL CCKGSV( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX, diff --git a/lapack-netlib/TESTING/EIG/cchkgg.f b/lapack-netlib/TESTING/EIG/cchkgg.f index e1daf4789..400d5b2e6 100644 --- a/lapack-netlib/TESTING/EIG/cchkgg.f +++ b/lapack-netlib/TESTING/EIG/cchkgg.f @@ -68,7 +68,7 @@ *> and each type of matrix, one matrix will be generated and used *> to test the nonsymmetric eigenroutines. For each matrix, 13 *> tests will be performed. The first twelve "test ratios" should be -*> small -- O(1). They will be compared with the threshhold THRESH: +*> small -- O(1). They will be compared with the threshold THRESH: *> *> H *> (1) | A - U H V | / ( |A| n ulp ) @@ -128,7 +128,7 @@ *> |beta(Q,Z computed) - beta(Q,Z not computed)|/|P| ) / ulp *> *> In addition, the normalization of L and R are checked, and compared -*> with the threshhold THRSHN. +*> with the threshold THRSHN. *> *> Test Matrices *> ---- -------- @@ -298,7 +298,7 @@ *> \param[in] THRSHN *> \verbatim *> THRSHN is REAL -*> Threshhold for reporting eigenvector normalization error. +*> Threshold for reporting eigenvector normalization error. *> If the normalization of any eigenvector differs from 1 by *> more than THRSHN*ulp, then a special error message will be *> printed. (This is handled separately from the other tests, @@ -492,7 +492,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_eig * @@ -503,10 +503,10 @@ $ ALPHA3, BETA3, EVECTL, EVECTR, WORK, LWORK, $ RWORK, LLWORK, RESULT, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL TSTDIF diff --git a/lapack-netlib/TESTING/EIG/cdrges.f b/lapack-netlib/TESTING/EIG/cdrges.f index 14af10397..67f83faea 100644 --- a/lapack-netlib/TESTING/EIG/cdrges.f +++ b/lapack-netlib/TESTING/EIG/cdrges.f @@ -50,7 +50,7 @@ *> number of matrix "TYPES" are specified. For each size ("N") *> and each TYPE of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following 13 tests -*> will be performed and compared with the threshhold THRESH except +*> will be performed and compared with the threshold THRESH except *> the tests (5), (11) and (13). *> *> @@ -372,7 +372,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_eig * @@ -381,10 +381,10 @@ $ NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, ALPHA, $ BETA, WORK, LWORK, RWORK, RESULT, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDQ, LWORK, NOUNIT, NSIZES, NTYPES diff --git a/lapack-netlib/TESTING/EIG/cdrges3.f b/lapack-netlib/TESTING/EIG/cdrges3.f index 0ef33dfd9..cea7f8b75 100644 --- a/lapack-netlib/TESTING/EIG/cdrges3.f +++ b/lapack-netlib/TESTING/EIG/cdrges3.f @@ -50,7 +50,7 @@ *> number of matrix "TYPES" are specified. For each size ("N") *> and each TYPE of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following 13 tests -*> will be performed and compared with the threshhold THRESH except +*> will be performed and compared with the threshold THRESH except *> the tests (5), (11) and (13). *> *> @@ -382,7 +382,7 @@ $ BETA, WORK, LWORK, RWORK, RESULT, BWORK, $ INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * February 2015 diff --git a/lapack-netlib/TESTING/EIG/cdrgev.f b/lapack-netlib/TESTING/EIG/cdrgev.f index 1e0eca55f..fcee80119 100644 --- a/lapack-netlib/TESTING/EIG/cdrgev.f +++ b/lapack-netlib/TESTING/EIG/cdrgev.f @@ -55,7 +55,7 @@ *> number of matrix "types" are specified. For each size ("n") *> and each type of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following tests -*> will be performed and compared with the threshhold THRESH. +*> will be performed and compared with the threshold THRESH. *> *> Results from CGGEV: *> @@ -389,7 +389,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex_eig * @@ -399,10 +399,10 @@ $ ALPHA, BETA, ALPHA1, BETA1, WORK, LWORK, RWORK, $ RESULT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDQ, LDQE, LWORK, NOUNIT, NSIZES, diff --git a/lapack-netlib/TESTING/EIG/cdrgev3.f b/lapack-netlib/TESTING/EIG/cdrgev3.f index 6531752b1..13fb366e4 100644 --- a/lapack-netlib/TESTING/EIG/cdrgev3.f +++ b/lapack-netlib/TESTING/EIG/cdrgev3.f @@ -55,7 +55,7 @@ *> number of matrix "types" are specified. For each size ("n") *> and each type of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following tests -*> will be performed and compared with the threshhold THRESH. +*> will be performed and compared with the threshold THRESH. *> *> Results from CGGEV3: *> @@ -399,7 +399,7 @@ $ ALPHA, BETA, ALPHA1, BETA1, WORK, LWORK, $ RWORK, RESULT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 diff --git a/lapack-netlib/TESTING/EIG/cdrgsx.f b/lapack-netlib/TESTING/EIG/cdrgsx.f index d0129ea55..54a407f83 100644 --- a/lapack-netlib/TESTING/EIG/cdrgsx.f +++ b/lapack-netlib/TESTING/EIG/cdrgsx.f @@ -59,7 +59,7 @@ *> (need more details on what kind of read-in data are needed). *> *> For each matrix pair, the following tests will be performed and -*> compared with the threshhold THRESH except for the tests (7) and (9): +*> compared with the threshold THRESH except for the tests (7) and (9): *> *> (1) | A - Q S Z' | / ( |A| n ulp ) *> @@ -340,7 +340,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_eig * @@ -349,10 +349,10 @@ $ AI, BI, Z, Q, ALPHA, BETA, C, LDC, S, WORK, $ LWORK, RWORK, IWORK, LIWORK, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDC, LIWORK, LWORK, NCMAX, NIN, diff --git a/lapack-netlib/TESTING/EIG/cdrgvx.f b/lapack-netlib/TESTING/EIG/cdrgvx.f index 9c0a807fb..1e6d8bdc6 100644 --- a/lapack-netlib/TESTING/EIG/cdrgvx.f +++ b/lapack-netlib/TESTING/EIG/cdrgvx.f @@ -50,7 +50,7 @@ *> corresponding the first and last eigenvalues are also know *> ``exactly'' (see CLATM6). *> For each matrix pair, the following tests will be performed and -*> compared with the threshhold THRESH. +*> compared with the threshold THRESH. *> *> (1) max over all left eigenvalue/-vector pairs (beta/alpha,l) of *> @@ -288,7 +288,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_eig * @@ -298,10 +298,10 @@ $ S, STRU, DIF, DIFTRU, WORK, LWORK, RWORK, $ IWORK, LIWORK, RESULT, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT, diff --git a/lapack-netlib/TESTING/EIG/cdrvbd.f b/lapack-netlib/TESTING/EIG/cdrvbd.f index 28d863de1..bd8a263a5 100644 --- a/lapack-netlib/TESTING/EIG/cdrvbd.f +++ b/lapack-netlib/TESTING/EIG/cdrvbd.f @@ -379,7 +379,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex_eig * @@ -389,10 +389,10 @@ $ SSAV, E, WORK, LWORK, RWORK, IWORK, NOUNIT, $ INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES, @@ -423,11 +423,11 @@ * .. Local Scalars .. LOGICAL BADMM, BADNN CHARACTER JOBQ, JOBU, JOBVT, RANGE - INTEGER I, IINFO, IJQ, IJU, IJVT, IL, IU, ITEMP, IWSPC, - $ IWTMP, J, JSIZE, JTYPE, LSWORK, M, MINWRK, - $ MMAX, MNMAX, MNMIN, MTYPES, N, NERRS, NFAIL, - $ NMAX, NS, NSI, NSV, NTEST, NTESTF, NTESTT, - $ LRWORK + INTEGER I, IINFO, IJQ, IJU, IJVT, IL, IU, ITEMP, + $ IWSPC, IWTMP, J, JSIZE, JTYPE, LSWORK, M, + $ MINWRK, MMAX, MNMAX, MNMIN, MTYPES, N, + $ NERRS, NFAIL, NMAX, NS, NSI, NSV, NTEST, + $ NTESTF, NTESTT, LRWORK REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV, $ UNFL, VL, VU * .. @@ -441,9 +441,9 @@ EXTERNAL SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, XERBLA, CBDT01, CBDT05, CGESDD, CGESVD, - $ CGESVJ, CGEJSV, CGESVDX, CLACPY, CLASET, CLATMS, - $ CUNT01, CUNT03 + EXTERNAL ALASVM, XERBLA, CBDT01, CBDT05, CGESDD, + $ CGESVD, CGESVJ, CGEJSV, CGESVDX, CLACPY, + $ CLASET, CLATMS, CUNT01, CUNT03 * .. * .. Intrinsic Functions .. INTRINSIC ABS, REAL, MAX, MIN diff --git a/lapack-netlib/TESTING/EIG/cdrves.f b/lapack-netlib/TESTING/EIG/cdrves.f index 782cae7c0..ccbf61efe 100644 --- a/lapack-netlib/TESTING/EIG/cdrves.f +++ b/lapack-netlib/TESTING/EIG/cdrves.f @@ -369,7 +369,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_eig * @@ -378,10 +378,10 @@ $ NOUNIT, A, LDA, H, HT, W, WT, VS, LDVS, RESULT, $ WORK, NWORK, RWORK, IWORK, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDVS, NOUNIT, NSIZES, NTYPES, NWORK @@ -901,7 +901,7 @@ $ ' 1/ulp otherwise', / $ ' 12 = 0 if W same no matter if VS computed (sort),', $ ' 1/ulp otherwise', / - $ ' 13 = 0 if sorting succesful, 1/ulp otherwise', / ) + $ ' 13 = 0 if sorting successful, 1/ulp otherwise', / ) 9993 FORMAT( ' N=', I5, ', IWK=', I2, ', seed=', 4( I4, ',' ), $ ' type ', I2, ', test(', I2, ')=', G10.3 ) 9992 FORMAT( ' CDRVES: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', diff --git a/lapack-netlib/TESTING/EIG/cdrvsx.f b/lapack-netlib/TESTING/EIG/cdrvsx.f index 8bac9cc2f..f2979da86 100644 --- a/lapack-netlib/TESTING/EIG/cdrvsx.f +++ b/lapack-netlib/TESTING/EIG/cdrvsx.f @@ -425,7 +425,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_eig * @@ -435,10 +435,10 @@ $ LDVS, VS1, RESULT, WORK, LWORK, RWORK, BWORK, $ INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDVS, LWORK, NIUNIT, NOUNIT, NSIZES, @@ -914,7 +914,7 @@ $ ' 1/ulp otherwise', / $ ' 12 = 0 if W same no matter what else computed ', $ '(sort), 1/ulp otherwise', / - $ ' 13 = 0 if sorting succesful, 1/ulp otherwise', + $ ' 13 = 0 if sorting successful, 1/ulp otherwise', $ / ' 14 = 0 if RCONDE same no matter what else computed,', $ ' 1/ulp otherwise', / $ ' 15 = 0 if RCONDv same no matter what else computed,', diff --git a/lapack-netlib/TESTING/EIG/cdrvvx.f b/lapack-netlib/TESTING/EIG/cdrvvx.f index 629e78cf3..265df145a 100644 --- a/lapack-netlib/TESTING/EIG/cdrvvx.f +++ b/lapack-netlib/TESTING/EIG/cdrvvx.f @@ -446,7 +446,7 @@ *> \verbatim *> INFO is INTEGER *> If 0, then successful exit. -*> If <0, then input paramter -INFO is incorrect. +*> If <0, then input parameter -INFO is incorrect. *> If >0, CLATMR, CLATMS, CLATME or CGET23 returned an error *> code, and INFO is its absolute value. *> @@ -485,7 +485,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_eig * @@ -496,10 +496,10 @@ $ RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT, $ WORK, NWORK, RWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDLRE, LDVL, LDVR, NIUNIT, NOUNIT, diff --git a/lapack-netlib/TESTING/EIG/cerred.f b/lapack-netlib/TESTING/EIG/cerred.f index e1b04be7a..578d9f1f4 100644 --- a/lapack-netlib/TESTING/EIG/cerred.f +++ b/lapack-netlib/TESTING/EIG/cerred.f @@ -61,17 +61,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex_eig * * ===================================================================== SUBROUTINE CERRED( PATH, NUNIT ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*3 PATH @@ -100,7 +100,7 @@ $ VT( NMAX, NMAX ), W( 10*NMAX ), X( NMAX ) * .. * .. External Subroutines .. - EXTERNAL CHKXER, CGEES, CGEESX, CGEEV, CGEEVX, CGEJSV + EXTERNAL CHKXER, CGEES, CGEESX, CGEEV, CGEEVX, CGEJSV, $ CGESDD, CGESVD * .. * .. External Functions .. @@ -484,7 +484,7 @@ CALL CGESVDX( 'V', 'N', 'A', 2, 2, A, 2, ZERO, ZERO, $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO ) CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK ) - INFOT = 16 + INFOT = 17 CALL CGESVDX( 'N', 'V', 'A', 2, 2, A, 2, ZERO, ZERO, $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO ) CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK ) diff --git a/lapack-netlib/TESTING/EIG/cerrgg.f b/lapack-netlib/TESTING/EIG/cerrgg.f index a60c4eb27..100bd82d0 100644 --- a/lapack-netlib/TESTING/EIG/cerrgg.f +++ b/lapack-netlib/TESTING/EIG/cerrgg.f @@ -50,17 +50,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex_eig * * ===================================================================== SUBROUTINE CERRGG( PATH, NUNIT ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*3 PATH @@ -83,7 +83,7 @@ * .. * .. Local Arrays .. LOGICAL BW( NMAX ), SEL( NMAX ) - INTEGER IW( LW ) + INTEGER IW( LW ), IDUM(NMAX) REAL LS( NMAX ), R1( NMAX ), R2( NMAX ), $ RCE( NMAX ), RCV( NMAX ), RS( NMAX ), RW( LW ) COMPLEX A( NMAX, NMAX ), ALPHA( NMAX ), @@ -306,57 +306,57 @@ SRNAMT = 'CGGSVD3' INFOT = 1 CALL CGGSVD3( '/', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 2 CALL CGGSVD3( 'N', '/', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 3 CALL CGGSVD3( 'N', 'N', '/', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 4 CALL CGGSVD3( 'N', 'N', 'N', -1, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 5 CALL CGGSVD3( 'N', 'N', 'N', 0, -1, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 6 CALL CGGSVD3( 'N', 'N', 'N', 0, 0, -1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 10 CALL CGGSVD3( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 12 CALL CGGSVD3( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 16 CALL CGGSVD3( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL CGGSVD3( 'N', 'V', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 2, V, 1, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 2, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL CGGSVD3( 'N', 'N', 'Q', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 2, V, 2, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 2, V, 2, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) NT = NT + 11 @@ -573,56 +573,56 @@ INFOT = 7 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ -1, 0, 0, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 8 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, -1, 0, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 9 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, -1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 11 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, -1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, -1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 22 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, -1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 24 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, -1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 26 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ -1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) diff --git a/lapack-netlib/TESTING/EIG/clctes.f b/lapack-netlib/TESTING/EIG/clctes.f index 82499faee..5b66c5395 100644 --- a/lapack-netlib/TESTING/EIG/clctes.f +++ b/lapack-netlib/TESTING/EIG/clctes.f @@ -25,7 +25,7 @@ *> eigenvalue is negative), and otherwise it returns .FALSE.. *> *> It is used by the test routine CDRGES to test whether the driver -*> routine CGGES succesfully sorts eigenvalues. +*> routine CGGES successfully sorts eigenvalues. *> \endverbatim * * Arguments: @@ -51,17 +51,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_eig * * ===================================================================== LOGICAL FUNCTION CLCTES( Z, D ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. COMPLEX D, Z diff --git a/lapack-netlib/TESTING/EIG/cslect.f b/lapack-netlib/TESTING/EIG/cslect.f index ea244d892..8c80e7af7 100644 --- a/lapack-netlib/TESTING/EIG/cslect.f +++ b/lapack-netlib/TESTING/EIG/cslect.f @@ -22,8 +22,8 @@ *> *> CSLECT returns .TRUE. if the eigenvalue Z is to be selected, *> otherwise it returns .FALSE. -*> It is used by CCHK41 to test if CGEES succesfully sorts eigenvalues, -*> and by CCHK43 to test if CGEESX succesfully sorts eigenvalues. +*> It is used by CCHK41 to test if CGEES successfully sorts eigenvalues, +*> and by CCHK43 to test if CGEESX successfully sorts eigenvalues. *> *> The common block /SSLCT/ controls how eigenvalues are selected. *> If SELOPT = 0, then CSLECT return .TRUE. when real(Z) is less than @@ -49,17 +49,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_eig * * ===================================================================== LOGICAL FUNCTION CSLECT( Z ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. COMPLEX Z diff --git a/lapack-netlib/TESTING/EIG/dchkbd.f b/lapack-netlib/TESTING/EIG/dchkbd.f index f9790692e..b093e871b 100644 --- a/lapack-netlib/TESTING/EIG/dchkbd.f +++ b/lapack-netlib/TESTING/EIG/dchkbd.f @@ -483,7 +483,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup double_eig * @@ -493,10 +493,10 @@ $ Y, Z, Q, LDQ, PT, LDPT, U, VT, WORK, LWORK, $ IWORK, NOUT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDPT, LDQ, LDX, LWORK, NOUT, NRHS, @@ -545,10 +545,10 @@ EXTERNAL DLAMCH, DLARND, DSXT1 * .. * .. External Subroutines .. - EXTERNAL ALASUM, DBDSDC, DBDSQR, DBDSVDX, DBDT01, DBDT02, - $ DBDT03, DBDT04, DCOPY, DGEBRD, DGEMM, DLABAD, - $ DLACPY, DLAHD2, DLASET, DLATMR, DLATMS, - $ DORGBR, DORT01, XERBLA + EXTERNAL ALASUM, DBDSDC, DBDSQR, DBDSVDX, DBDT01, + $ DBDT02, DBDT03, DBDT04, DCOPY, DGEBRD, + $ DGEMM, DLABAD, DLACPY, DLAHD2, DLASET, + $ DLATMR, DLATMS, DORGBR, DORT01, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, EXP, INT, LOG, MAX, MIN, SQRT @@ -563,10 +563,10 @@ COMMON / SRNAMC / SRNAMT * .. * .. Data statements .. - DATA KTYPE / 1, 2, 5*4, 5*6, 3*9, 10 / - DATA KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 / - DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, - $ 0, 0, 0 / + DATA KTYPE / 1, 2, 5*4, 5*6, 3*9, 10 / + DATA KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 / + DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, + $ 0, 0, 0 / * .. * .. Executable Statements .. * @@ -1143,7 +1143,7 @@ IWBD = IWBS + MNMIN IWBE = IWBD + MNMIN IWBZ = IWBE + MNMIN - IWWORK = IWBZ + MNMIN*(MNMIN*2+1) + IWWORK = IWBZ + 2*MNMIN*(MNMIN+1) MNMIN2 = MAX( 1,MNMIN*2 ) * CALL DCOPY( MNMIN, BD, 1, WORK( IWBD ), 1 ) diff --git a/lapack-netlib/TESTING/EIG/dchkee.f b/lapack-netlib/TESTING/EIG/dchkee.f index 14272bc48..b723687af 100644 --- a/lapack-netlib/TESTING/EIG/dchkee.f +++ b/lapack-netlib/TESTING/EIG/dchkee.f @@ -1033,17 +1033,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup double_eig * * ===================================================================== PROGRAM DCHKEE * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * ===================================================================== * @@ -2105,6 +2105,7 @@ MAXTYP = 26 NTYPES = MIN( MAXTYP, NTYPES ) CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT ) + CALL XLAENV(1,1) IF( TSTCHK .AND. TSTERR ) $ CALL DERRGG( C3, NOUT ) DO 350 I = 1, NPARMS @@ -2164,6 +2165,7 @@ * * Blocked version * + CALL XLAENV(16, 2) CALL DDRGES3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT, $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ), $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ), @@ -2351,6 +2353,7 @@ * GSV: Generalized Singular Value Decomposition * ---------------------------------------------- * + CALL XLAENV(1,1) IF( TSTERR ) $ CALL DERRGG( 'GSV', NOUT ) CALL DCKGSV( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX, diff --git a/lapack-netlib/TESTING/EIG/dchkgg.f b/lapack-netlib/TESTING/EIG/dchkgg.f index ebdc9f186..3848e7c9e 100644 --- a/lapack-netlib/TESTING/EIG/dchkgg.f +++ b/lapack-netlib/TESTING/EIG/dchkgg.f @@ -72,7 +72,7 @@ *> and each type of matrix, one matrix will be generated and used *> to test the nonsymmetric eigenroutines. For each matrix, 15 *> tests will be performed. The first twelve "test ratios" should be -*> small -- O(1). They will be compared with the threshhold THRESH: +*> small -- O(1). They will be compared with the threshold THRESH: *> *> T *> (1) | A - U H V | / ( |A| n ulp ) @@ -132,7 +132,7 @@ *> |beta(Q,Z computed) - beta(Q,Z not computed)|/|P| ) / ulp *> *> In addition, the normalization of L and R are checked, and compared -*> with the threshhold THRSHN. +*> with the threshold THRSHN. *> *> Test Matrices *> ---- -------- @@ -298,7 +298,7 @@ *> \param[in] THRSHN *> \verbatim *> THRSHN is DOUBLE PRECISION -*> Threshhold for reporting eigenvector normalization error. +*> Threshold for reporting eigenvector normalization error. *> If the normalization of any eigenvector differs from 1 by *> more than THRSHN*ulp, then a special error message will be *> printed. (This is handled separately from the other tests, @@ -500,7 +500,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_eig * @@ -511,10 +511,10 @@ $ BETA1, ALPHR3, ALPHI3, BETA3, EVECTL, EVECTR, $ WORK, LWORK, LLWORK, RESULT, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL TSTDIF diff --git a/lapack-netlib/TESTING/EIG/ddrges.f b/lapack-netlib/TESTING/EIG/ddrges.f index b16efc65b..c4b83e590 100644 --- a/lapack-netlib/TESTING/EIG/ddrges.f +++ b/lapack-netlib/TESTING/EIG/ddrges.f @@ -52,7 +52,7 @@ *> number of matrix "TYPES" are specified. For each size ("N") *> and each TYPE of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following 13 tests -*> will be performed and compared with the threshhold THRESH except +*> will be performed and compared with the threshold THRESH except *> the tests (5), (11) and (13). *> *> @@ -393,7 +393,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_eig * @@ -403,10 +403,10 @@ $ ALPHAI, BETA, WORK, LWORK, RESULT, BWORK, $ INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDQ, LWORK, NOUNIT, NSIZES, NTYPES diff --git a/lapack-netlib/TESTING/EIG/ddrges3.f b/lapack-netlib/TESTING/EIG/ddrges3.f index 773630193..3b23deebe 100644 --- a/lapack-netlib/TESTING/EIG/ddrges3.f +++ b/lapack-netlib/TESTING/EIG/ddrges3.f @@ -52,7 +52,7 @@ *> number of matrix "TYPES" are specified. For each size ("N") *> and each TYPE of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following 13 tests -*> will be performed and compared with the threshhold THRESH except +*> will be performed and compared with the threshold THRESH except *> the tests (5), (11) and (13). *> *> @@ -403,7 +403,7 @@ $ ALPHAI, BETA, WORK, LWORK, RESULT, BWORK, $ INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * February 2015 diff --git a/lapack-netlib/TESTING/EIG/ddrgev.f b/lapack-netlib/TESTING/EIG/ddrgev.f index 9155aed3c..e4d483623 100644 --- a/lapack-netlib/TESTING/EIG/ddrgev.f +++ b/lapack-netlib/TESTING/EIG/ddrgev.f @@ -55,7 +55,7 @@ *> number of matrix "types" are specified. For each size ("n") *> and each type of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following tests -*> will be performed and compared with the threshhold THRESH. +*> will be performed and compared with the threshold THRESH. *> *> Results from DGGEV: *> @@ -398,7 +398,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup double_eig * @@ -408,10 +408,10 @@ $ ALPHAR, ALPHAI, BETA, ALPHR1, ALPHI1, BETA1, $ WORK, LWORK, RESULT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDQ, LDQE, LWORK, NOUNIT, NSIZES, diff --git a/lapack-netlib/TESTING/EIG/ddrgev3.f b/lapack-netlib/TESTING/EIG/ddrgev3.f index e8de1a8a6..1c60e4434 100644 --- a/lapack-netlib/TESTING/EIG/ddrgev3.f +++ b/lapack-netlib/TESTING/EIG/ddrgev3.f @@ -55,7 +55,7 @@ *> number of matrix "types" are specified. For each size ("n") *> and each type of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following tests -*> will be performed and compared with the threshhold THRESH. +*> will be performed and compared with the threshold THRESH. *> *> Results from DGGEV3: *> @@ -408,7 +408,7 @@ $ ALPHAR, ALPHAI, BETA, ALPHR1, ALPHI1, BETA1, $ WORK, LWORK, RESULT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * February 2015 diff --git a/lapack-netlib/TESTING/EIG/ddrgsx.f b/lapack-netlib/TESTING/EIG/ddrgsx.f index 843fd2042..aca715e90 100644 --- a/lapack-netlib/TESTING/EIG/ddrgsx.f +++ b/lapack-netlib/TESTING/EIG/ddrgsx.f @@ -60,7 +60,7 @@ *> to test DGGESX. *> *> For each matrix pair, the following tests will be performed and -*> compared with the threshhold THRESH except for the tests (7) and (9): +*> compared with the threshold THRESH except for the tests (7) and (9): *> *> (1) | A - Q S Z' | / ( |A| n ulp ) *> @@ -350,7 +350,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_eig * @@ -359,10 +359,10 @@ $ BI, Z, Q, ALPHAR, ALPHAI, BETA, C, LDC, S, $ WORK, LWORK, IWORK, LIWORK, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDC, LIWORK, LWORK, NCMAX, NIN, diff --git a/lapack-netlib/TESTING/EIG/ddrgvx.f b/lapack-netlib/TESTING/EIG/ddrgvx.f index 08a7aff07..970a3ccde 100644 --- a/lapack-netlib/TESTING/EIG/ddrgvx.f +++ b/lapack-netlib/TESTING/EIG/ddrgvx.f @@ -50,7 +50,7 @@ *> ``exactly'' (see DLATM6). *> *> For each matrix pair, the following tests will be performed and -*> compared with the threshhold THRESH. +*> compared with the threshold THRESH. *> *> (1) max over all left eigenvalue/-vector pairs (beta/alpha,l) of *> @@ -300,7 +300,7 @@ $ RSCALE, S, DTRU, DIF, DIFTRU, WORK, LWORK, $ IWORK, LIWORK, RESULT, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.1) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 diff --git a/lapack-netlib/TESTING/EIG/ddrvbd.f b/lapack-netlib/TESTING/EIG/ddrvbd.f index d73405669..fbe26a5de 100644 --- a/lapack-netlib/TESTING/EIG/ddrvbd.f +++ b/lapack-netlib/TESTING/EIG/ddrvbd.f @@ -346,7 +346,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup double_eig * @@ -355,10 +355,10 @@ $ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S, $ SSAV, E, WORK, LWORK, IWORK, NOUT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES, @@ -404,8 +404,8 @@ * .. * .. External Subroutines .. EXTERNAL ALASVM, DBDT01, DGEJSV, DGESDD, DGESVD, - $ DGESVDX, DGESVJ, DLABAD, DLACPY, DLASET, DLATMS, - $ DORT01, DORT03, XERBLA + $ DGESVDX, DGESVJ, DLABAD, DLACPY, DLASET, + $ DLATMS, DORT01, DORT03, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN @@ -1141,7 +1141,7 @@ $ / '21 = | S - Spartial | / ( min(M,N) ulp |S| )', $ / '22 = 0 if S contains min(M,N) nonnegative values in', $ ' decreasing order, else 1/ulp', - $ / '23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ),' + $ / '23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ),', $ ' DGESVDX(V,V,A) ', $ / '24 = | I - U**T U | / ( M ulp ) ', $ / '25 = | I - VT VT**T | / ( N ulp ) ', diff --git a/lapack-netlib/TESTING/EIG/ddrves.f b/lapack-netlib/TESTING/EIG/ddrves.f index 93e495e13..7275fe2a4 100644 --- a/lapack-netlib/TESTING/EIG/ddrves.f +++ b/lapack-netlib/TESTING/EIG/ddrves.f @@ -379,7 +379,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_eig * @@ -388,10 +388,10 @@ $ NOUNIT, A, LDA, H, HT, WR, WI, WRT, WIT, VS, $ LDVS, RESULT, WORK, NWORK, IWORK, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDVS, NOUNIT, NSIZES, NTYPES, NWORK @@ -948,7 +948,7 @@ $ ' 1/ulp otherwise', / $ ' 12 = 0 if WR, WI same no matter if VS computed (sort),', $ ' 1/ulp otherwise', / - $ ' 13 = 0 if sorting succesful, 1/ulp otherwise', / ) + $ ' 13 = 0 if sorting successful, 1/ulp otherwise', / ) 9993 FORMAT( ' N=', I5, ', IWK=', I2, ', seed=', 4( I4, ',' ), $ ' type ', I2, ', test(', I2, ')=', G10.3 ) 9992 FORMAT( ' DDRVES: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', diff --git a/lapack-netlib/TESTING/EIG/ddrvsx.f b/lapack-netlib/TESTING/EIG/ddrvsx.f index 42b5b76e7..66df93398 100644 --- a/lapack-netlib/TESTING/EIG/ddrvsx.f +++ b/lapack-netlib/TESTING/EIG/ddrvsx.f @@ -444,7 +444,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_eig * @@ -454,10 +454,10 @@ $ WIT, WRTMP, WITMP, VS, LDVS, VS1, RESULT, WORK, $ LWORK, IWORK, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDVS, LWORK, NIUNIT, NOUNIT, NSIZES, @@ -933,7 +933,7 @@ $ ' 1/ulp otherwise', / $ ' 12 = 0 if WR, WI same no matter what else computed ', $ '(sort), 1/ulp otherwise', / - $ ' 13 = 0 if sorting succesful, 1/ulp otherwise', + $ ' 13 = 0 if sorting successful, 1/ulp otherwise', $ / ' 14 = 0 if RCONDE same no matter what else computed,', $ ' 1/ulp otherwise', / $ ' 15 = 0 if RCONDv same no matter what else computed,', diff --git a/lapack-netlib/TESTING/EIG/ddrvvx.f b/lapack-netlib/TESTING/EIG/ddrvvx.f index 14c5c74b9..85ad62473 100644 --- a/lapack-netlib/TESTING/EIG/ddrvvx.f +++ b/lapack-netlib/TESTING/EIG/ddrvvx.f @@ -471,7 +471,7 @@ *> \verbatim *> INFO is INTEGER *> If 0, then successful exit. -*> If <0, then input paramter -INFO is incorrect. +*> If <0, then input parameter -INFO is incorrect. *> If >0, DLATMR, SLATMS, SLATME or DGET23 returned an error *> code, and INFO is its absolute value. *> @@ -510,7 +510,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_eig * @@ -521,10 +521,10 @@ $ RCDVIN, RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, $ RESULT, WORK, NWORK, IWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDLRE, LDVL, LDVR, NIUNIT, NOUNIT, diff --git a/lapack-netlib/TESTING/EIG/derrbd.f b/lapack-netlib/TESTING/EIG/derrbd.f index da03504c1..6d47bd869 100644 --- a/lapack-netlib/TESTING/EIG/derrbd.f +++ b/lapack-netlib/TESTING/EIG/derrbd.f @@ -48,17 +48,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup double_eig * * ===================================================================== SUBROUTINE DERRBD( PATH, NUNIT ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*3 PATH @@ -89,8 +89,8 @@ EXTERNAL LSAMEN * .. * .. External Subroutines .. - EXTERNAL CHKXER, DBDSDC, DBDSQR, DBDSVDX, DGEBD2, DGEBRD, DORGBR, - $ DORMBR + EXTERNAL CHKXER, DBDSDC, DBDSQR, DBDSVDX, DGEBD2, + $ DGEBRD, DORGBR, DORMBR * .. * .. Scalars in Common .. LOGICAL LERR, OK diff --git a/lapack-netlib/TESTING/EIG/derred.f b/lapack-netlib/TESTING/EIG/derred.f index 4f778b157..c5bf6ea49 100644 --- a/lapack-netlib/TESTING/EIG/derred.f +++ b/lapack-netlib/TESTING/EIG/derred.f @@ -61,17 +61,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup double_eig * * ===================================================================== SUBROUTINE DERRED( PATH, NUNIT ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*3 PATH @@ -475,7 +475,7 @@ CALL DGESVDX( 'V', 'N', 'A', 2, 2, A, 2, ZERO, ZERO, $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) - INFOT = 16 + INFOT = 17 CALL DGESVDX( 'N', 'V', 'A', 2, 2, A, 2, ZERO, ZERO, $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) diff --git a/lapack-netlib/TESTING/EIG/derrgg.f b/lapack-netlib/TESTING/EIG/derrgg.f index 917cf0480..4edd472dc 100644 --- a/lapack-netlib/TESTING/EIG/derrgg.f +++ b/lapack-netlib/TESTING/EIG/derrgg.f @@ -50,17 +50,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup double_eig * * ===================================================================== SUBROUTINE DERRGG( PATH, NUNIT ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*3 PATH @@ -83,7 +83,7 @@ * .. * .. Local Arrays .. LOGICAL BW( NMAX ), SEL( NMAX ) - INTEGER IW( NMAX ) + INTEGER IW( NMAX ), IDUM(NMAX) DOUBLE PRECISION A( NMAX, NMAX ), B( NMAX, NMAX ), LS( NMAX ), $ Q( NMAX, NMAX ), R1( NMAX ), R2( NMAX ), $ R3( NMAX ), RCE( 2 ), RCV( 2 ), RS( NMAX ), @@ -305,47 +305,47 @@ SRNAMT = 'DGGSVD3' INFOT = 1 CALL DGGSVD3( '/', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 2 CALL DGGSVD3( 'N', '/', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 3 CALL DGGSVD3( 'N', 'N', '/', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 4 CALL DGGSVD3( 'N', 'N', 'N', -1, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 5 CALL DGGSVD3( 'N', 'N', 'N', 0, -1, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 6 CALL DGGSVD3( 'N', 'N', 'N', 0, 0, -1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 10 CALL DGGSVD3( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 12 CALL DGGSVD3( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 16 CALL DGGSVD3( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL DGGSVD3( 'N', 'V', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL DGGSVD3( 'N', 'N', 'Q', 1, 2, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) NT = NT + 11 * diff --git a/lapack-netlib/TESTING/EIG/dlctes.f b/lapack-netlib/TESTING/EIG/dlctes.f index 71b70919d..908bd091d 100644 --- a/lapack-netlib/TESTING/EIG/dlctes.f +++ b/lapack-netlib/TESTING/EIG/dlctes.f @@ -26,7 +26,7 @@ *> .FALSE.. *> *> It is used by the test routine DDRGES to test whether the driver -*> routine DGGES succesfully sorts eigenvalues. +*> routine DGGES successfully sorts eigenvalues. *> \endverbatim * * Arguments: @@ -61,17 +61,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_eig * * ===================================================================== LOGICAL FUNCTION DLCTES( ZR, ZI, D ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. DOUBLE PRECISION D, ZI, ZR diff --git a/lapack-netlib/TESTING/EIG/dslect.f b/lapack-netlib/TESTING/EIG/dslect.f index 3978024c9..a7a0e0947 100644 --- a/lapack-netlib/TESTING/EIG/dslect.f +++ b/lapack-netlib/TESTING/EIG/dslect.f @@ -22,8 +22,8 @@ *> *> DSLECT returns .TRUE. if the eigenvalue ZR+sqrt(-1)*ZI is to be *> selected, and otherwise it returns .FALSE. -*> It is used by DCHK41 to test if DGEES succesfully sorts eigenvalues, -*> and by DCHK43 to test if DGEESX succesfully sorts eigenvalues. +*> It is used by DCHK41 to test if DGEES successfully sorts eigenvalues, +*> and by DCHK43 to test if DGEESX successfully sorts eigenvalues. *> *> The common block /SSLCT/ controls how eigenvalues are selected. *> If SELOPT = 0, then DSLECT return .TRUE. when ZR is less than zero, @@ -55,17 +55,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_eig * * ===================================================================== LOGICAL FUNCTION DSLECT( ZR, ZI ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ZI, ZR diff --git a/lapack-netlib/TESTING/EIG/schkbd.f b/lapack-netlib/TESTING/EIG/schkbd.f index 3419c7df0..5569e0e60 100644 --- a/lapack-netlib/TESTING/EIG/schkbd.f +++ b/lapack-netlib/TESTING/EIG/schkbd.f @@ -483,7 +483,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup single_eig * @@ -493,10 +493,10 @@ $ Y, Z, Q, LDQ, PT, LDPT, U, VT, WORK, LWORK, $ IWORK, NOUT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDPT, LDQ, LDX, LWORK, NOUT, NRHS, @@ -527,7 +527,7 @@ CHARACTER*3 PATH INTEGER I, IINFO, IL, IMODE, ITEMP, ITYPE, IU, IWBD, $ IWBE, IWBS, IWBZ, IWWORK, J, JCOL, JSIZE, - $ JTYPE, LOG2UI, M, MINWRK, MMAX, MNMAX, MNMIN, + $ JTYPE, LOG2UI, M, MINWRK, MMAX, MNMAX, MNMIN, $ MNMIN2, MQ, MTYPES, N, NFAIL, NMAX, $ NS1, NS2, NTEST REAL ABSTOL, AMNINV, ANORM, COND, OVFL, RTOVFL, @@ -545,10 +545,10 @@ EXTERNAL SLAMCH, SLARND, SSXT1 * .. * .. External Subroutines .. - EXTERNAL ALASUM, SBDSDC, SBDSQR, SBDSVDX, SBDT01, SBDT02, - $ SBDT03, SBDT04, SCOPY, SGEBRD, SGEMM, SLABAD, - $ SLACPY, SLAHD2, SLASET, SLATMR, SLATMS, - $ SORGBR, SORT01, XERBLA + EXTERNAL ALASUM, SBDSDC, SBDSQR, SBDSVDX, SBDT01, + $ SBDT02, SBDT03, SBDT04, SCOPY, SGEBRD, + $ SGEMM, SLABAD, SLACPY, SLAHD2, SLASET, + $ SLATMR, SLATMS, SORGBR, SORT01, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, EXP, INT, LOG, MAX, MIN, SQRT @@ -563,9 +563,9 @@ COMMON / SRNAMC / SRNAMT * .. * .. Data statements .. - DATA KTYPE / 1, 2, 5*4, 5*6, 3*9, 10 / - DATA KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 / - DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, + DATA KTYPE / 1, 2, 5*4, 5*6, 3*9, 10 / + DATA KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 / + DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, $ 0, 0, 0 / * .. * .. Executable Statements .. @@ -1143,7 +1143,7 @@ IWBD = IWBS + MNMIN IWBE = IWBD + MNMIN IWBZ = IWBE + MNMIN - IWWORK = IWBZ + MNMIN*(MNMIN*2+1) + IWWORK = IWBZ + 2*MNMIN*(MNMIN+1) MNMIN2 = MAX( 1,MNMIN*2 ) * CALL SCOPY( MNMIN, BD, 1, WORK( IWBD ), 1 ) diff --git a/lapack-netlib/TESTING/EIG/schkee.f b/lapack-netlib/TESTING/EIG/schkee.f index 0bd994cc4..ecbef3c10 100644 --- a/lapack-netlib/TESTING/EIG/schkee.f +++ b/lapack-netlib/TESTING/EIG/schkee.f @@ -1033,17 +1033,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup single_eig * * ===================================================================== PROGRAM SCHKEE * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * ===================================================================== * @@ -2105,8 +2105,9 @@ MAXTYP = 26 NTYPES = MIN( MAXTYP, NTYPES ) CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT ) + CALL XLAENV(1,1) IF( TSTCHK .AND. TSTERR ) - $ CALL SERRGG( C3, NOUT ) + & CALL SERRGG( C3, NOUT ) DO 350 I = 1, NPARMS CALL XLAENV( 1, NBVAL( I ) ) CALL XLAENV( 2, NBMIN( I ) ) @@ -2165,6 +2166,7 @@ * * Blocked version * + CALL XLAENV(16,1) CALL SDRGES3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT, $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ), $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ), @@ -2353,6 +2355,7 @@ * GSV: Generalized Singular Value Decomposition * ---------------------------------------------- * + CALL XLAENV( 1, 1 ) IF( TSTERR ) $ CALL SERRGG( 'GSV', NOUT ) CALL SCKGSV( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX, diff --git a/lapack-netlib/TESTING/EIG/schkgg.f b/lapack-netlib/TESTING/EIG/schkgg.f index 708b24374..3772340e6 100644 --- a/lapack-netlib/TESTING/EIG/schkgg.f +++ b/lapack-netlib/TESTING/EIG/schkgg.f @@ -72,7 +72,7 @@ *> and each type of matrix, one matrix will be generated and used *> to test the nonsymmetric eigenroutines. For each matrix, 15 *> tests will be performed. The first twelve "test ratios" should be -*> small -- O(1). They will be compared with the threshhold THRESH: +*> small -- O(1). They will be compared with the threshold THRESH: *> *> T *> (1) | A - U H V | / ( |A| n ulp ) @@ -132,7 +132,7 @@ *> |beta(Q,Z computed) - beta(Q,Z not computed)|/|P| ) / ulp *> *> In addition, the normalization of L and R are checked, and compared -*> with the threshhold THRSHN. +*> with the threshold THRSHN. *> *> Test Matrices *> ---- -------- @@ -298,7 +298,7 @@ *> \param[in] THRSHN *> \verbatim *> THRSHN is REAL -*> Threshhold for reporting eigenvector normalization error. +*> Threshold for reporting eigenvector normalization error. *> If the normalization of any eigenvector differs from 1 by *> more than THRSHN*ulp, then a special error message will be *> printed. (This is handled separately from the other tests, @@ -500,7 +500,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup single_eig * @@ -511,10 +511,10 @@ $ BETA1, ALPHR3, ALPHI3, BETA3, EVECTL, EVECTR, $ WORK, LWORK, LLWORK, RESULT, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL TSTDIF diff --git a/lapack-netlib/TESTING/EIG/sdrges.f b/lapack-netlib/TESTING/EIG/sdrges.f index f4d9a1246..73f0cb14c 100644 --- a/lapack-netlib/TESTING/EIG/sdrges.f +++ b/lapack-netlib/TESTING/EIG/sdrges.f @@ -52,7 +52,7 @@ *> number of matrix "TYPES" are specified. For each size ("N") *> and each TYPE of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following 13 tests -*> will be performed and compared with the threshhold THRESH except +*> will be performed and compared with the threshold THRESH except *> the tests (5), (11) and (13). *> *> @@ -393,7 +393,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup single_eig * @@ -403,10 +403,10 @@ $ ALPHAI, BETA, WORK, LWORK, RESULT, BWORK, $ INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDQ, LWORK, NOUNIT, NSIZES, NTYPES diff --git a/lapack-netlib/TESTING/EIG/sdrges3.f b/lapack-netlib/TESTING/EIG/sdrges3.f index 6fed3c846..90351f6df 100644 --- a/lapack-netlib/TESTING/EIG/sdrges3.f +++ b/lapack-netlib/TESTING/EIG/sdrges3.f @@ -52,7 +52,7 @@ *> number of matrix "TYPES" are specified. For each size ("N") *> and each TYPE of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following 13 tests -*> will be performed and compared with the threshhold THRESH except +*> will be performed and compared with the threshold THRESH except *> the tests (5), (11) and (13). *> *> @@ -403,7 +403,7 @@ $ ALPHAI, BETA, WORK, LWORK, RESULT, BWORK, $ INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * February 2015 diff --git a/lapack-netlib/TESTING/EIG/sdrgev.f b/lapack-netlib/TESTING/EIG/sdrgev.f index 816b37bbf..05c3afe94 100644 --- a/lapack-netlib/TESTING/EIG/sdrgev.f +++ b/lapack-netlib/TESTING/EIG/sdrgev.f @@ -55,7 +55,7 @@ *> number of matrix "types" are specified. For each size ("n") *> and each type of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following tests -*> will be performed and compared with the threshhold THRESH. +*> will be performed and compared with the threshold THRESH. *> *> Results from SGGEV: *> @@ -398,7 +398,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup single_eig * @@ -408,10 +408,10 @@ $ ALPHAR, ALPHAI, BETA, ALPHR1, ALPHI1, BETA1, $ WORK, LWORK, RESULT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDQ, LDQE, LWORK, NOUNIT, NSIZES, diff --git a/lapack-netlib/TESTING/EIG/sdrgev3.f b/lapack-netlib/TESTING/EIG/sdrgev3.f index c1c92a89e..9492d43bf 100644 --- a/lapack-netlib/TESTING/EIG/sdrgev3.f +++ b/lapack-netlib/TESTING/EIG/sdrgev3.f @@ -55,7 +55,7 @@ *> number of matrix "types" are specified. For each size ("n") *> and each type of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following tests -*> will be performed and compared with the threshhold THRESH. +*> will be performed and compared with the threshold THRESH. *> *> Results from SGGEV3: *> @@ -408,7 +408,7 @@ $ ALPHAR, ALPHAI, BETA, ALPHR1, ALPHI1, BETA1, $ WORK, LWORK, RESULT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * February 2015 diff --git a/lapack-netlib/TESTING/EIG/sdrgsx.f b/lapack-netlib/TESTING/EIG/sdrgsx.f index 4cc8d0192..58c61f08d 100644 --- a/lapack-netlib/TESTING/EIG/sdrgsx.f +++ b/lapack-netlib/TESTING/EIG/sdrgsx.f @@ -60,7 +60,7 @@ *> to test SGGESX. *> *> For each matrix pair, the following tests will be performed and -*> compared with the threshhold THRESH except for the tests (7) and (9): +*> compared with the threshold THRESH except for the tests (7) and (9): *> *> (1) | A - Q S Z' | / ( |A| n ulp ) *> @@ -350,7 +350,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup single_eig * @@ -359,10 +359,10 @@ $ AI, BI, Z, Q, ALPHAR, ALPHAI, BETA, C, LDC, S, $ WORK, LWORK, IWORK, LIWORK, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDC, LIWORK, LWORK, NCMAX, NIN, diff --git a/lapack-netlib/TESTING/EIG/sdrgvx.f b/lapack-netlib/TESTING/EIG/sdrgvx.f index d899e56db..06b94c9f1 100644 --- a/lapack-netlib/TESTING/EIG/sdrgvx.f +++ b/lapack-netlib/TESTING/EIG/sdrgvx.f @@ -51,7 +51,7 @@ *> ``exactly'' (see SLATM6). *> *> For each matrix pair, the following tests will be performed and -*> compared with the threshhold THRESH. +*> compared with the threshold THRESH. *> *> (1) max over all left eigenvalue/-vector pairs (beta/alpha,l) of *> @@ -291,7 +291,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup single_eig * @@ -301,10 +301,10 @@ $ RSCALE, S, STRU, DIF, DIFTRU, WORK, LWORK, $ IWORK, LIWORK, RESULT, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT, diff --git a/lapack-netlib/TESTING/EIG/sdrvbd.f b/lapack-netlib/TESTING/EIG/sdrvbd.f index 0eeddb8f7..e8bf7ea5b 100644 --- a/lapack-netlib/TESTING/EIG/sdrvbd.f +++ b/lapack-netlib/TESTING/EIG/sdrvbd.f @@ -346,7 +346,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup single_eig * @@ -355,10 +355,10 @@ $ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S, $ SSAV, E, WORK, LWORK, IWORK, NOUT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES, @@ -404,8 +404,8 @@ * .. * .. External Subroutines .. EXTERNAL ALASVM, SBDT01, SGEJSV, SGESDD, SGESVD, - $ SGESVDX, SGESVJ, SLABAD, SLACPY, SLASET, SLATMS, - $ SORT01, SORT03, XERBLA + $ SGESVDX, SGESVJ, SLABAD, SLACPY, SLASET, + $ SLATMS, SORT01, SORT03, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, REAL, INT, MAX, MIN diff --git a/lapack-netlib/TESTING/EIG/sdrves.f b/lapack-netlib/TESTING/EIG/sdrves.f index f2ec1e727..f6493ea0f 100644 --- a/lapack-netlib/TESTING/EIG/sdrves.f +++ b/lapack-netlib/TESTING/EIG/sdrves.f @@ -379,7 +379,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup single_eig * @@ -388,10 +388,10 @@ $ NOUNIT, A, LDA, H, HT, WR, WI, WRT, WIT, VS, $ LDVS, RESULT, WORK, NWORK, IWORK, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDVS, NOUNIT, NSIZES, NTYPES, NWORK @@ -948,7 +948,7 @@ $ ' 1/ulp otherwise', / $ ' 12 = 0 if WR, WI same no matter if VS computed (sort),', $ ' 1/ulp otherwise', / - $ ' 13 = 0 if sorting succesful, 1/ulp otherwise', / ) + $ ' 13 = 0 if sorting successful, 1/ulp otherwise', / ) 9993 FORMAT( ' N=', I5, ', IWK=', I2, ', seed=', 4( I4, ',' ), $ ' type ', I2, ', test(', I2, ')=', G10.3 ) 9992 FORMAT( ' SDRVES: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', diff --git a/lapack-netlib/TESTING/EIG/sdrvsx.f b/lapack-netlib/TESTING/EIG/sdrvsx.f index a4437adb4..9599e54f4 100644 --- a/lapack-netlib/TESTING/EIG/sdrvsx.f +++ b/lapack-netlib/TESTING/EIG/sdrvsx.f @@ -444,7 +444,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup single_eig * @@ -454,10 +454,10 @@ $ WIT, WRTMP, WITMP, VS, LDVS, VS1, RESULT, WORK, $ LWORK, IWORK, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDVS, LWORK, NIUNIT, NOUNIT, NSIZES, @@ -933,7 +933,7 @@ $ ' 1/ulp otherwise', / $ ' 12 = 0 if WR, WI same no matter what else computed ', $ '(sort), 1/ulp otherwise', / - $ ' 13 = 0 if sorting succesful, 1/ulp otherwise', + $ ' 13 = 0 if sorting successful, 1/ulp otherwise', $ / ' 14 = 0 if RCONDE same no matter what else computed,', $ ' 1/ulp otherwise', / $ ' 15 = 0 if RCONDv same no matter what else computed,', diff --git a/lapack-netlib/TESTING/EIG/sdrvvx.f b/lapack-netlib/TESTING/EIG/sdrvvx.f index a71361967..64951fe23 100644 --- a/lapack-netlib/TESTING/EIG/sdrvvx.f +++ b/lapack-netlib/TESTING/EIG/sdrvvx.f @@ -470,7 +470,7 @@ *> \verbatim *> INFO is INTEGER *> If 0, then successful exit. -*> If <0, then input paramter -INFO is incorrect. +*> If <0, then input parameter -INFO is incorrect. *> If >0, SLATMR, SLATMS, SLATME or SGET23 returned an error *> code, and INFO is its absolute value. *> @@ -509,7 +509,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup single_eig * @@ -520,10 +520,10 @@ $ RCDVIN, RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, $ RESULT, WORK, NWORK, IWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDLRE, LDVL, LDVR, NIUNIT, NOUNIT, diff --git a/lapack-netlib/TESTING/EIG/serrbd.f b/lapack-netlib/TESTING/EIG/serrbd.f index fbd1c2eb9..757825a2d 100644 --- a/lapack-netlib/TESTING/EIG/serrbd.f +++ b/lapack-netlib/TESTING/EIG/serrbd.f @@ -48,17 +48,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup single_eig * * ===================================================================== SUBROUTINE SERRBD( PATH, NUNIT ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*3 PATH @@ -89,8 +89,8 @@ EXTERNAL LSAMEN * .. * .. External Subroutines .. - EXTERNAL CHKXER, SBDSDC, SBDSQR, SBDSVDX, SGEBD2, SGEBRD, SORGBR, - $ SORMBR + EXTERNAL CHKXER, SBDSDC, SBDSQR, SBDSVDX, SGEBD2, + $ SGEBRD, SORGBR, SORMBR * .. * .. Scalars in Common .. LOGICAL LERR, OK diff --git a/lapack-netlib/TESTING/EIG/serred.f b/lapack-netlib/TESTING/EIG/serred.f index 72ff23914..ecd811195 100644 --- a/lapack-netlib/TESTING/EIG/serred.f +++ b/lapack-netlib/TESTING/EIG/serred.f @@ -61,17 +61,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup single_eig * * ===================================================================== SUBROUTINE SERRED( PATH, NUNIT ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*3 PATH @@ -475,7 +475,7 @@ CALL SGESVDX( 'V', 'N', 'A', 2, 2, A, 2, ZERO, ZERO, $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK ) - INFOT = 16 + INFOT = 17 CALL SGESVDX( 'N', 'V', 'A', 2, 2, A, 2, ZERO, ZERO, $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK ) diff --git a/lapack-netlib/TESTING/EIG/serrgg.f b/lapack-netlib/TESTING/EIG/serrgg.f index aede817b6..21c65ee4b 100644 --- a/lapack-netlib/TESTING/EIG/serrgg.f +++ b/lapack-netlib/TESTING/EIG/serrgg.f @@ -50,17 +50,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup single_eig * * ===================================================================== SUBROUTINE SERRGG( PATH, NUNIT ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*3 PATH @@ -78,12 +78,12 @@ * .. Local Scalars .. CHARACTER*2 C2 INTEGER DUMMYK, DUMMYL, I, IFST, ILO, IHI, ILST, INFO, - $ J, M, NCYCLE, NT, SDIM, LWORK + $ J, M, NCYCLE, NT, SDIM, LWORK, JDUM REAL ANRM, BNRM, DIF, SCALE, TOLA, TOLB * .. * .. Local Arrays .. LOGICAL BW( NMAX ), SEL( NMAX ) - INTEGER IW( NMAX ) + INTEGER IW( NMAX ), IDUM(NMAX) REAL A( NMAX, NMAX ), B( NMAX, NMAX ), LS( NMAX ), $ Q( NMAX, NMAX ), R1( NMAX ), R2( NMAX ), $ R3( NMAX ), RCE( 2 ), RCV( 2 ), RS( NMAX ), @@ -305,47 +305,47 @@ SRNAMT = 'SGGSVD3' INFOT = 1 CALL SGGSVD3( '/', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 2 CALL SGGSVD3( 'N', '/', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 3 CALL SGGSVD3( 'N', 'N', '/', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 4 CALL SGGSVD3( 'N', 'N', 'N', -1, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 5 CALL SGGSVD3( 'N', 'N', 'N', 0, -1, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 6 CALL SGGSVD3( 'N', 'N', 'N', 0, 0, -1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 10 CALL SGGSVD3( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 12 CALL SGGSVD3( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 16 CALL SGGSVD3( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL SGGSVD3( 'N', 'V', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL SGGSVD3( 'N', 'N', 'Q', 1, 2, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) NT = NT + 11 * diff --git a/lapack-netlib/TESTING/EIG/slctes.f b/lapack-netlib/TESTING/EIG/slctes.f index e39b0d635..9be9e3df9 100644 --- a/lapack-netlib/TESTING/EIG/slctes.f +++ b/lapack-netlib/TESTING/EIG/slctes.f @@ -26,7 +26,7 @@ *> .FALSE.. *> *> It is used by the test routine SDRGES to test whether the driver -*> routine SGGES succesfully sorts eigenvalues. +*> routine SGGES successfully sorts eigenvalues. *> \endverbatim * * Arguments: @@ -61,17 +61,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup single_eig * * ===================================================================== LOGICAL FUNCTION SLCTES( ZR, ZI, D ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. REAL D, ZI, ZR diff --git a/lapack-netlib/TESTING/EIG/sslect.f b/lapack-netlib/TESTING/EIG/sslect.f index 89d0981a2..5127df3d2 100644 --- a/lapack-netlib/TESTING/EIG/sslect.f +++ b/lapack-netlib/TESTING/EIG/sslect.f @@ -22,8 +22,8 @@ *> *> SSLECT returns .TRUE. if the eigenvalue ZR+sqrt(-1)*ZI is to be *> selected, and otherwise it returns .FALSE. -*> It is used by SCHK41 to test if SGEES succesfully sorts eigenvalues, -*> and by SCHK43 to test if SGEESX succesfully sorts eigenvalues. +*> It is used by SCHK41 to test if SGEES successfully sorts eigenvalues, +*> and by SCHK43 to test if SGEESX successfully sorts eigenvalues. *> *> The common block /SSLCT/ controls how eigenvalues are selected. *> If SELOPT = 0, then SSLECT return .TRUE. when ZR is less than zero, @@ -55,17 +55,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup single_eig * * ===================================================================== LOGICAL FUNCTION SSLECT( ZR, ZI ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. REAL ZI, ZR diff --git a/lapack-netlib/TESTING/EIG/zchkbd.f b/lapack-netlib/TESTING/EIG/zchkbd.f index f126e47c8..493b7804c 100644 --- a/lapack-netlib/TESTING/EIG/zchkbd.f +++ b/lapack-netlib/TESTING/EIG/zchkbd.f @@ -405,7 +405,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_eig * @@ -415,10 +415,10 @@ $ Y, Z, Q, LDQ, PT, LDPT, U, VT, WORK, LWORK, $ RWORK, NOUT, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDPT, LDQ, LDX, LWORK, NOUT, NRHS, @@ -483,9 +483,9 @@ COMMON / SRNAMC / SRNAMT * .. * .. Data statements .. - DATA KTYPE / 1, 2, 5*4, 5*6, 3*9, 10 / - DATA KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 / - DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, + DATA KTYPE / 1, 2, 5*4, 5*6, 3*9, 10 / + DATA KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 / + DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, $ 0, 0, 0 / * .. * .. Executable Statements .. diff --git a/lapack-netlib/TESTING/EIG/zchkee.f b/lapack-netlib/TESTING/EIG/zchkee.f index 67221276e..2588060ba 100644 --- a/lapack-netlib/TESTING/EIG/zchkee.f +++ b/lapack-netlib/TESTING/EIG/zchkee.f @@ -1027,17 +1027,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16_eig * * ===================================================================== PROGRAM ZCHKEE * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * ===================================================================== * @@ -2098,6 +2098,7 @@ MAXTYP = 26 NTYPES = MIN( MAXTYP, NTYPES ) CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT ) + CALL XLAENV(1,1) IF( TSTCHK .AND. TSTERR ) $ CALL ZERRGG( C3, NOUT ) DO 350 I = 1, NPARMS @@ -2222,6 +2223,7 @@ * * Blocked version * + CALL XLAENV(16,2) CALL ZDRGEV3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT, $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ), $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ), @@ -2347,6 +2349,7 @@ * GSV: Generalized Singular Value Decomposition * ---------------------------------------------- * + CALL XLAENV(1,1) IF( TSTERR ) $ CALL ZERRGG( 'GSV', NOUT ) CALL ZCKGSV( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX, diff --git a/lapack-netlib/TESTING/EIG/zchkgg.f b/lapack-netlib/TESTING/EIG/zchkgg.f index 5c554caec..53bd07a1a 100644 --- a/lapack-netlib/TESTING/EIG/zchkgg.f +++ b/lapack-netlib/TESTING/EIG/zchkgg.f @@ -68,7 +68,7 @@ *> and each type of matrix, one matrix will be generated and used *> to test the nonsymmetric eigenroutines. For each matrix, 13 *> tests will be performed. The first twelve "test ratios" should be -*> small -- O(1). They will be compared with the threshhold THRESH: +*> small -- O(1). They will be compared with the threshold THRESH: *> *> H *> (1) | A - U H V | / ( |A| n ulp ) @@ -128,7 +128,7 @@ *> |beta(Q,Z computed) - beta(Q,Z not computed)|/|P| ) / ulp *> *> In addition, the normalization of L and R are checked, and compared -*> with the threshhold THRSHN. +*> with the threshold THRSHN. *> *> Test Matrices *> ---- -------- @@ -298,7 +298,7 @@ *> \param[in] THRSHN *> \verbatim *> THRSHN is DOUBLE PRECISION -*> Threshhold for reporting eigenvector normalization error. +*> Threshold for reporting eigenvector normalization error. *> If the normalization of any eigenvector differs from 1 by *> more than THRSHN*ulp, then a special error message will be *> printed. (This is handled separately from the other tests, @@ -492,7 +492,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_eig * @@ -503,10 +503,10 @@ $ ALPHA3, BETA3, EVECTL, EVECTR, WORK, LWORK, $ RWORK, LLWORK, RESULT, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL TSTDIF diff --git a/lapack-netlib/TESTING/EIG/zdrges.f b/lapack-netlib/TESTING/EIG/zdrges.f index 6e10cb1e2..a0a76b958 100644 --- a/lapack-netlib/TESTING/EIG/zdrges.f +++ b/lapack-netlib/TESTING/EIG/zdrges.f @@ -50,7 +50,7 @@ *> number of matrix "TYPES" are specified. For each size ("N") *> and each TYPE of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following 13 tests -*> will be performed and compared with the threshhold THRESH except +*> will be performed and compared with the threshold THRESH except *> the tests (5), (11) and (13). *> *> @@ -372,7 +372,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_eig * @@ -381,10 +381,10 @@ $ NOUNIT, A, LDA, B, S, T, Q, LDQ, Z, ALPHA, $ BETA, WORK, LWORK, RWORK, RESULT, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDQ, LWORK, NOUNIT, NSIZES, NTYPES diff --git a/lapack-netlib/TESTING/EIG/zdrges3.f b/lapack-netlib/TESTING/EIG/zdrges3.f index 9a4277398..2b3be003c 100644 --- a/lapack-netlib/TESTING/EIG/zdrges3.f +++ b/lapack-netlib/TESTING/EIG/zdrges3.f @@ -50,7 +50,7 @@ *> number of matrix "TYPES" are specified. For each size ("N") *> and each TYPE of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following 13 tests -*> will be performed and compared with the threshhold THRESH except +*> will be performed and compared with the threshold THRESH except *> the tests (5), (11) and (13). *> *> @@ -382,7 +382,7 @@ $ BETA, WORK, LWORK, RWORK, RESULT, BWORK, $ INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * February 2015 diff --git a/lapack-netlib/TESTING/EIG/zdrgev.f b/lapack-netlib/TESTING/EIG/zdrgev.f index 96727449b..6f745d180 100644 --- a/lapack-netlib/TESTING/EIG/zdrgev.f +++ b/lapack-netlib/TESTING/EIG/zdrgev.f @@ -55,7 +55,7 @@ *> number of matrix "types" are specified. For each size ("n") *> and each type of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following tests -*> will be performed and compared with the threshhold THRESH. +*> will be performed and compared with the threshold THRESH. *> *> Results from ZGGEV: *> @@ -389,7 +389,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16_eig * @@ -399,10 +399,10 @@ $ ALPHA, BETA, ALPHA1, BETA1, WORK, LWORK, RWORK, $ RESULT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDQ, LDQE, LWORK, NOUNIT, NSIZES, diff --git a/lapack-netlib/TESTING/EIG/zdrgev3.f b/lapack-netlib/TESTING/EIG/zdrgev3.f index cc9526c3c..62ddf2b56 100644 --- a/lapack-netlib/TESTING/EIG/zdrgev3.f +++ b/lapack-netlib/TESTING/EIG/zdrgev3.f @@ -55,7 +55,7 @@ *> number of matrix "types" are specified. For each size ("n") *> and each type of matrix, a pair of matrices (A, B) will be generated *> and used for testing. For each matrix pair, the following tests -*> will be performed and compared with the threshhold THRESH. +*> will be performed and compared with the threshold THRESH. *> *> Results from ZGGEV3: *> @@ -399,7 +399,7 @@ $ ALPHA, BETA, ALPHA1, BETA1, WORK, LWORK, $ RWORK, RESULT, INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * February 2015 diff --git a/lapack-netlib/TESTING/EIG/zdrgsx.f b/lapack-netlib/TESTING/EIG/zdrgsx.f index 9b859e493..3714b705a 100644 --- a/lapack-netlib/TESTING/EIG/zdrgsx.f +++ b/lapack-netlib/TESTING/EIG/zdrgsx.f @@ -59,7 +59,7 @@ *> (need more details on what kind of read-in data are needed). *> *> For each matrix pair, the following tests will be performed and -*> compared with the threshhold THRESH except for the tests (7) and (9): +*> compared with the threshold THRESH except for the tests (7) and (9): *> *> (1) | A - Q S Z' | / ( |A| n ulp ) *> @@ -340,7 +340,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_eig * @@ -349,10 +349,10 @@ $ BI, Z, Q, ALPHA, BETA, C, LDC, S, WORK, LWORK, $ RWORK, IWORK, LIWORK, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDC, LIWORK, LWORK, NCMAX, NIN, diff --git a/lapack-netlib/TESTING/EIG/zdrgvx.f b/lapack-netlib/TESTING/EIG/zdrgvx.f index 452530feb..f36007b3b 100644 --- a/lapack-netlib/TESTING/EIG/zdrgvx.f +++ b/lapack-netlib/TESTING/EIG/zdrgvx.f @@ -49,7 +49,7 @@ *> corresponding the first and last eigenvalues are also know *> ``exactly'' (see ZLATM6). *> For each matrix pair, the following tests will be performed and -*> compared with the threshhold THRESH. +*> compared with the threshold THRESH. *> *> (1) max over all left eigenvalue/-vector pairs (beta/alpha,l) of *> @@ -287,7 +287,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_eig * @@ -297,10 +297,10 @@ $ S, DTRU, DIF, DIFTRU, WORK, LWORK, RWORK, $ IWORK, LIWORK, RESULT, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT, diff --git a/lapack-netlib/TESTING/EIG/zdrvbd.f b/lapack-netlib/TESTING/EIG/zdrvbd.f index 2f1e3cc38..d8388eed7 100644 --- a/lapack-netlib/TESTING/EIG/zdrvbd.f +++ b/lapack-netlib/TESTING/EIG/zdrvbd.f @@ -379,7 +379,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16_eig * @@ -389,10 +389,10 @@ $ SSAV, E, WORK, LWORK, RWORK, IWORK, NOUNIT, $ INFO ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES, @@ -423,11 +423,11 @@ * .. Local Scalars .. LOGICAL BADMM, BADNN CHARACTER JOBQ, JOBU, JOBVT, RANGE - INTEGER I, IINFO, IJQ, IJU, IJVT, IL, IU, ITEMP, IWSPC, - $ IWTMP, J, JSIZE, JTYPE, LSWORK, M, MINWRK, - $ MMAX, MNMAX, MNMIN, MTYPES, N, NERRS, NFAIL, - $ NMAX, NS, NSI, NSV, NTEST, NTESTF, NTESTT, - $ LRWORK + INTEGER I, IINFO, IJQ, IJU, IJVT, IL, IU, ITEMP, + $ IWSPC, IWTMP, J, JSIZE, JTYPE, LSWORK, M, + $ MINWRK, MMAX, MNMAX, MNMIN, MTYPES, N, + $ NERRS, NFAIL, NMAX, NS, NSI, NSV, NTEST, + $ NTESTF, NTESTT, LRWORK DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV, $ UNFL, VL, VU * .. @@ -441,9 +441,9 @@ EXTERNAL DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, XERBLA, ZBDT01, ZBDT05, ZGESDD, ZGESVD, - $ ZGESVJ, ZGEJSV, ZGESVDX, ZLACPY, ZLASET, ZLATMS, - $ ZUNT01, ZUNT03 + EXTERNAL ALASVM, XERBLA, ZBDT01, ZBDT05, ZGESDD, + $ ZGESVD, ZGESVJ, ZGEJSV, ZGESVDX, ZLACPY, + $ ZLASET, ZLATMS, ZUNT01, ZUNT03 * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN diff --git a/lapack-netlib/TESTING/EIG/zdrves.f b/lapack-netlib/TESTING/EIG/zdrves.f index d2657720a..15f5debcb 100644 --- a/lapack-netlib/TESTING/EIG/zdrves.f +++ b/lapack-netlib/TESTING/EIG/zdrves.f @@ -369,7 +369,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_eig * @@ -378,10 +378,10 @@ $ NOUNIT, A, LDA, H, HT, W, WT, VS, LDVS, RESULT, $ WORK, NWORK, RWORK, IWORK, BWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDVS, NOUNIT, NSIZES, NTYPES, NWORK @@ -901,7 +901,7 @@ $ ' 1/ulp otherwise', / $ ' 12 = 0 if W same no matter if VS computed (sort),', $ ' 1/ulp otherwise', / - $ ' 13 = 0 if sorting succesful, 1/ulp otherwise', / ) + $ ' 13 = 0 if sorting successful, 1/ulp otherwise', / ) 9993 FORMAT( ' N=', I5, ', IWK=', I2, ', seed=', 4( I4, ',' ), $ ' type ', I2, ', test(', I2, ')=', G10.3 ) 9992 FORMAT( ' ZDRVES: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', diff --git a/lapack-netlib/TESTING/EIG/zdrvsx.f b/lapack-netlib/TESTING/EIG/zdrvsx.f index 742162eb8..96cb23653 100644 --- a/lapack-netlib/TESTING/EIG/zdrvsx.f +++ b/lapack-netlib/TESTING/EIG/zdrvsx.f @@ -425,7 +425,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_eig * @@ -435,10 +435,10 @@ $ LDVS, VS1, RESULT, WORK, LWORK, RWORK, BWORK, $ INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDVS, LWORK, NIUNIT, NOUNIT, NSIZES, @@ -914,7 +914,7 @@ $ ' 1/ulp otherwise', / $ ' 12 = 0 if W same no matter what else computed ', $ '(sort), 1/ulp otherwise', / - $ ' 13 = 0 if sorting succesful, 1/ulp otherwise', + $ ' 13 = 0 if sorting successful, 1/ulp otherwise', $ / ' 14 = 0 if RCONDE same no matter what else computed,', $ ' 1/ulp otherwise', / $ ' 15 = 0 if RCONDv same no matter what else computed,', diff --git a/lapack-netlib/TESTING/EIG/zdrvvx.f b/lapack-netlib/TESTING/EIG/zdrvvx.f index c9ea4e0d8..00c91fec6 100644 --- a/lapack-netlib/TESTING/EIG/zdrvvx.f +++ b/lapack-netlib/TESTING/EIG/zdrvvx.f @@ -446,7 +446,7 @@ *> \verbatim *> INFO is INTEGER *> If 0, then successful exit. -*> If <0, then input paramter -INFO is incorrect. +*> If <0, then input parameter -INFO is incorrect. *> If >0, ZLATMR, CLATMS, CLATME or ZGET23 returned an error *> code, and INFO is its absolute value. *> @@ -485,7 +485,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_eig * @@ -496,10 +496,10 @@ $ RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT, $ WORK, NWORK, RWORK, INFO ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDLRE, LDVL, LDVR, NIUNIT, NOUNIT, diff --git a/lapack-netlib/TESTING/EIG/zerred.f b/lapack-netlib/TESTING/EIG/zerred.f index 407964709..9179b1df0 100644 --- a/lapack-netlib/TESTING/EIG/zerred.f +++ b/lapack-netlib/TESTING/EIG/zerred.f @@ -61,17 +61,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16_eig * * ===================================================================== SUBROUTINE ZERRED( PATH, NUNIT ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*3 PATH @@ -484,7 +484,7 @@ CALL ZGESVDX( 'V', 'N', 'A', 2, 2, A, 2, ZERO, ZERO, $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO ) CALL CHKXER( 'ZGESVDX', INFOT, NOUT, LERR, OK ) - INFOT = 16 + INFOT = 17 CALL ZGESVDX( 'N', 'V', 'A', 2, 2, A, 2, ZERO, ZERO, $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO ) CALL CHKXER( 'ZGESVDX', INFOT, NOUT, LERR, OK ) diff --git a/lapack-netlib/TESTING/EIG/zerrgg.f b/lapack-netlib/TESTING/EIG/zerrgg.f index 3366c7716..a91363324 100644 --- a/lapack-netlib/TESTING/EIG/zerrgg.f +++ b/lapack-netlib/TESTING/EIG/zerrgg.f @@ -50,17 +50,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16_eig * * ===================================================================== SUBROUTINE ZERRGG( PATH, NUNIT ) * -* -- LAPACK test routine (version 3.6.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*3 PATH @@ -83,7 +83,7 @@ * .. * .. Local Arrays .. LOGICAL BW( NMAX ), SEL( NMAX ) - INTEGER IW( LW ) + INTEGER IW( LW ), IDUM(NMAX) DOUBLE PRECISION LS( NMAX ), R1( NMAX ), R2( NMAX ), $ RCE( NMAX ), RCV( NMAX ), RS( NMAX ), RW( LW ) COMPLEX*16 A( NMAX, NMAX ), ALPHA( NMAX ), @@ -306,57 +306,57 @@ SRNAMT = 'ZGGSVD3' INFOT = 1 CALL ZGGSVD3( '/', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 2 CALL ZGGSVD3( 'N', '/', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 3 CALL ZGGSVD3( 'N', 'N', '/', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 4 CALL ZGGSVD3( 'N', 'N', 'N', -1, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 5 CALL ZGGSVD3( 'N', 'N', 'N', 0, -1, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 6 CALL ZGGSVD3( 'N', 'N', 'N', 0, 0, -1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 10 CALL ZGGSVD3( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 12 CALL ZGGSVD3( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 16 CALL ZGGSVD3( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL ZGGSVD3( 'N', 'V', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 2, V, 1, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 2, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL ZGGSVD3( 'N', 'N', 'Q', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 2, V, 2, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 2, V, 2, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) NT = NT + 11 @@ -573,56 +573,56 @@ INFOT = 7 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ -1, 0, 0, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 8 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, -1, 0, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 9 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, -1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 11 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, -1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, -1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 22 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, -1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 24 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, -1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 26 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ -1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) diff --git a/lapack-netlib/TESTING/EIG/zlctes.f b/lapack-netlib/TESTING/EIG/zlctes.f index 1306180d8..e0acd882f 100644 --- a/lapack-netlib/TESTING/EIG/zlctes.f +++ b/lapack-netlib/TESTING/EIG/zlctes.f @@ -25,7 +25,7 @@ *> eigenvalue is negative), and otherwise it returns .FALSE.. *> *> It is used by the test routine ZDRGES to test whether the driver -*> routine ZGGES succesfully sorts eigenvalues. +*> routine ZGGES successfully sorts eigenvalues. *> \endverbatim * * Arguments: @@ -51,17 +51,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_eig * * ===================================================================== LOGICAL FUNCTION ZLCTES( Z, D ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. COMPLEX*16 D, Z diff --git a/lapack-netlib/TESTING/EIG/zslect.f b/lapack-netlib/TESTING/EIG/zslect.f index a01308db9..1d6ef4d56 100644 --- a/lapack-netlib/TESTING/EIG/zslect.f +++ b/lapack-netlib/TESTING/EIG/zslect.f @@ -22,8 +22,8 @@ *> *> ZSLECT returns .TRUE. if the eigenvalue Z is to be selected, *> otherwise it returns .FALSE. -*> It is used by ZCHK41 to test if ZGEES succesfully sorts eigenvalues, -*> and by ZCHK43 to test if ZGEESX succesfully sorts eigenvalues. +*> It is used by ZCHK41 to test if ZGEES successfully sorts eigenvalues, +*> and by ZCHK43 to test if ZGEESX successfully sorts eigenvalues. *> *> The common block /SSLCT/ controls how eigenvalues are selected. *> If SELOPT = 0, then ZSLECT return .TRUE. when real(Z) is less than @@ -49,17 +49,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_eig * * ===================================================================== LOGICAL FUNCTION ZSLECT( Z ) * -* -- LAPACK test routine (version 3.4.0) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. COMPLEX*16 Z diff --git a/lapack-netlib/TESTING/LIN/Makefile b/lapack-netlib/TESTING/LIN/Makefile index 09d514e5d..9db8b38af 100644 --- a/lapack-netlib/TESTING/LIN/Makefile +++ b/lapack-netlib/TESTING/LIN/Makefile @@ -339,3 +339,5 @@ zchkaa.o: zchkaa.f .f.o: $(FORTRAN) $(OPTS) -c $< -o $@ + +.NOTPARALLEL: diff --git a/lapack-netlib/TESTING/LIN/cqrt04.f b/lapack-netlib/TESTING/LIN/cqrt04.f index e3715a9fd..3176a0a02 100644 --- a/lapack-netlib/TESTING/LIN/cqrt04.f +++ b/lapack-netlib/TESTING/LIN/cqrt04.f @@ -74,7 +74,7 @@ SUBROUTINE CQRT04(M,N,NB,RESULT) IMPLICIT NONE * -* -- LAPACK test routine (version 3.4.1) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -89,8 +89,9 @@ * .. * .. Local allocatable arrays COMPLEX, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) + REAL, ALLOCATABLE :: RWORK(:) * * .. Parameters .. REAL ZERO diff --git a/lapack-netlib/TESTING/LIN/cqrt05.f b/lapack-netlib/TESTING/LIN/cqrt05.f index 256045af6..31d9d3b92 100644 --- a/lapack-netlib/TESTING/LIN/cqrt05.f +++ b/lapack-netlib/TESTING/LIN/cqrt05.f @@ -81,7 +81,7 @@ SUBROUTINE CQRT05(M,N,L,NB,RESULT) IMPLICIT NONE * -* -- LAPACK test routine (version 3.4.1) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -96,8 +96,9 @@ * .. * .. Local allocatable arrays COMPLEX, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) + REAL, ALLOCATABLE :: RWORK(:) * * .. Parameters .. REAL ZERO diff --git a/lapack-netlib/TESTING/LIN/zqrt04.f b/lapack-netlib/TESTING/LIN/zqrt04.f index 274c51a09..714f3fbb3 100644 --- a/lapack-netlib/TESTING/LIN/zqrt04.f +++ b/lapack-netlib/TESTING/LIN/zqrt04.f @@ -74,7 +74,7 @@ SUBROUTINE ZQRT04(M,N,NB,RESULT) IMPLICIT NONE * -* -- LAPACK test routine (version 3.4.1) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -89,8 +89,9 @@ * .. * .. Local allocatable arrays COMPLEX*16, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) + DOUBLE PRECISION, ALLOCATABLE :: RWORK(:) * * .. Parameters .. DOUBLE PRECISION ZERO diff --git a/lapack-netlib/TESTING/LIN/zqrt05.f b/lapack-netlib/TESTING/LIN/zqrt05.f index 8080a4522..c51c02fda 100644 --- a/lapack-netlib/TESTING/LIN/zqrt05.f +++ b/lapack-netlib/TESTING/LIN/zqrt05.f @@ -81,7 +81,7 @@ SUBROUTINE ZQRT05(M,N,L,NB,RESULT) IMPLICIT NONE * -* -- LAPACK test routine (version 3.4.1) -- +* -- LAPACK test routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -96,8 +96,9 @@ * .. * .. Local allocatable arrays COMPLEX*16, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) + DOUBLE PRECISION, ALLOCATABLE :: RWORK(:) * * .. Parameters .. DOUBLE PRECISION ZERO diff --git a/lapack-netlib/TESTING/MATGEN/clatm2.f b/lapack-netlib/TESTING/MATGEN/clatm2.f index 588caaa41..f5d7395e6 100644 --- a/lapack-netlib/TESTING/MATGEN/clatm2.f +++ b/lapack-netlib/TESTING/MATGEN/clatm2.f @@ -30,7 +30,7 @@ *> \verbatim *> *> CLATM2 returns the (I,J) entry of a random matrix of dimension -*> (M, N) described by the other paramters. It is called by the +*> (M, N) described by the other parameters. It is called by the *> CLATMR routine in order to build random test matrices. No error *> checking on parameters is done, because this routine is called in *> a tight loop by CLATMR which has already checked the parameters. @@ -204,7 +204,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_matgen * @@ -212,10 +212,10 @@ COMPLEX FUNCTION CLATM2( M, N, I, J, KL, KU, IDIST, ISEED, D, $ IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) * -* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. * diff --git a/lapack-netlib/TESTING/MATGEN/clatm3.f b/lapack-netlib/TESTING/MATGEN/clatm3.f index d3073bef7..1526e4128 100644 --- a/lapack-netlib/TESTING/MATGEN/clatm3.f +++ b/lapack-netlib/TESTING/MATGEN/clatm3.f @@ -32,7 +32,7 @@ *> \verbatim *> *> CLATM3 returns the (ISUB,JSUB) entry of a random matrix of -*> dimension (M, N) described by the other paramters. (ISUB,JSUB) +*> dimension (M, N) described by the other parameters. (ISUB,JSUB) *> is the final position of the (I,J) entry after pivoting *> according to IPVTNG and IWORK. CLATM3 is called by the *> CLATMR routine in order to build random test matrices. No error @@ -220,7 +220,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_matgen * @@ -229,10 +229,10 @@ $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * -* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. * diff --git a/lapack-netlib/TESTING/MATGEN/clatm5.f b/lapack-netlib/TESTING/MATGEN/clatm5.f index 3f3eb956c..bce75f1ee 100644 --- a/lapack-netlib/TESTING/MATGEN/clatm5.f +++ b/lapack-netlib/TESTING/MATGEN/clatm5.f @@ -48,7 +48,7 @@ *> \param[in] PRTYPE *> \verbatim *> PRTYPE is INTEGER -*> "Points" to a certian type of the matrices to generate +*> "Points" to a certain type of the matrices to generate *> (see futher details). *> \endverbatim *> @@ -192,7 +192,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex_matgen * @@ -268,10 +268,10 @@ $ E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA, $ QBLCKB ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB, LDC, LDD, LDE, LDF, LDL, LDR, M, N, diff --git a/lapack-netlib/TESTING/MATGEN/dlatm2.f b/lapack-netlib/TESTING/MATGEN/dlatm2.f index 87ef4f423..f12a737e5 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm2.f +++ b/lapack-netlib/TESTING/MATGEN/dlatm2.f @@ -30,7 +30,7 @@ *> \verbatim *> *> DLATM2 returns the (I,J) entry of a random matrix of dimension -*> (M, N) described by the other paramters. It is called by the +*> (M, N) described by the other parameters. It is called by the *> DLATMR routine in order to build random test matrices. No error *> checking on parameters is done, because this routine is called in *> a tight loop by DLATMR which has already checked the parameters. @@ -200,7 +200,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_matgen * @@ -208,10 +208,10 @@ DOUBLE PRECISION FUNCTION DLATM2( M, N, I, J, KL, KU, IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) * -* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. * diff --git a/lapack-netlib/TESTING/MATGEN/dlatm3.f b/lapack-netlib/TESTING/MATGEN/dlatm3.f index b2c49823e..4ad342516 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm3.f +++ b/lapack-netlib/TESTING/MATGEN/dlatm3.f @@ -32,7 +32,7 @@ *> \verbatim *> *> DLATM3 returns the (ISUB,JSUB) entry of a random matrix of -*> dimension (M, N) described by the other paramters. (ISUB,JSUB) +*> dimension (M, N) described by the other parameters. (ISUB,JSUB) *> is the final position of the (I,J) entry after pivoting *> according to IPVTNG and IWORK. DLATM3 is called by the *> DLATMR routine in order to build random test matrices. No error @@ -217,7 +217,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_matgen * @@ -226,10 +226,10 @@ $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * -* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. * diff --git a/lapack-netlib/TESTING/MATGEN/dlatm5.f b/lapack-netlib/TESTING/MATGEN/dlatm5.f index 9c8ee380f..f7581ad84 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm5.f +++ b/lapack-netlib/TESTING/MATGEN/dlatm5.f @@ -48,7 +48,7 @@ *> \param[in] PRTYPE *> \verbatim *> PRTYPE is INTEGER -*> "Points" to a certian type of the matrices to generate +*> "Points" to a certain type of the matrices to generate *> (see futher details). *> \endverbatim *> @@ -192,7 +192,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup double_matgen * @@ -268,10 +268,10 @@ $ E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA, $ QBLCKB ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB, LDC, LDD, LDE, LDF, LDL, LDR, M, N, diff --git a/lapack-netlib/TESTING/MATGEN/slatm2.f b/lapack-netlib/TESTING/MATGEN/slatm2.f index 88dcd6494..9707096b4 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm2.f +++ b/lapack-netlib/TESTING/MATGEN/slatm2.f @@ -30,7 +30,7 @@ *> \verbatim *> *> SLATM2 returns the (I,J) entry of a random matrix of dimension -*> (M, N) described by the other paramters. It is called by the +*> (M, N) described by the other parameters. It is called by the *> SLATMR routine in order to build random test matrices. No error *> checking on parameters is done, because this routine is called in *> a tight loop by SLATMR which has already checked the parameters. @@ -200,7 +200,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup real_matgen * @@ -208,10 +208,10 @@ REAL FUNCTION SLATM2( M, N, I, J, KL, KU, IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) * -* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. * diff --git a/lapack-netlib/TESTING/MATGEN/slatm3.f b/lapack-netlib/TESTING/MATGEN/slatm3.f index f90790cb9..32301ca20 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm3.f +++ b/lapack-netlib/TESTING/MATGEN/slatm3.f @@ -32,7 +32,7 @@ *> \verbatim *> *> SLATM3 returns the (ISUB,JSUB) entry of a random matrix of -*> dimension (M, N) described by the other paramters. (ISUB,JSUB) +*> dimension (M, N) described by the other parameters. (ISUB,JSUB) *> is the final position of the (I,J) entry after pivoting *> according to IPVTNG and IWORK. SLATM3 is called by the *> SLATMR routine in order to build random test matrices. No error @@ -217,7 +217,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup real_matgen * @@ -226,10 +226,10 @@ $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * -* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. * diff --git a/lapack-netlib/TESTING/MATGEN/slatm5.f b/lapack-netlib/TESTING/MATGEN/slatm5.f index ce0540c19..eeb3e6f3b 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm5.f +++ b/lapack-netlib/TESTING/MATGEN/slatm5.f @@ -48,7 +48,7 @@ *> \param[in] PRTYPE *> \verbatim *> PRTYPE is INTEGER -*> "Points" to a certian type of the matrices to generate +*> "Points" to a certain type of the matrices to generate *> (see futher details). *> \endverbatim *> @@ -192,7 +192,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup real_matgen * @@ -268,10 +268,10 @@ $ E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA, $ QBLCKB ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB, LDC, LDD, LDE, LDF, LDL, LDR, M, N, diff --git a/lapack-netlib/TESTING/MATGEN/zlatm2.f b/lapack-netlib/TESTING/MATGEN/zlatm2.f index 920e43e83..3719a685e 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatm2.f +++ b/lapack-netlib/TESTING/MATGEN/zlatm2.f @@ -30,7 +30,7 @@ *> \verbatim *> *> ZLATM2 returns the (I,J) entry of a random matrix of dimension -*> (M, N) described by the other paramters. It is called by the +*> (M, N) described by the other parameters. It is called by the *> ZLATMR routine in order to build random test matrices. No error *> checking on parameters is done, because this routine is called in *> a tight loop by ZLATMR which has already checked the parameters. @@ -203,7 +203,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_matgen * @@ -211,10 +211,10 @@ COMPLEX*16 FUNCTION ZLATM2( M, N, I, J, KL, KU, IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) * -* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. * diff --git a/lapack-netlib/TESTING/MATGEN/zlatm3.f b/lapack-netlib/TESTING/MATGEN/zlatm3.f index 4c27ad3b8..d7b10579d 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatm3.f +++ b/lapack-netlib/TESTING/MATGEN/zlatm3.f @@ -32,7 +32,7 @@ *> \verbatim *> *> ZLATM3 returns the (ISUB,JSUB) entry of a random matrix of -*> dimension (M, N) described by the other paramters. (ISUB,JSUB) +*> dimension (M, N) described by the other parameters. (ISUB,JSUB) *> is the final position of the (I,J) entry after pivoting *> according to IPVTNG and IWORK. ZLATM3 is called by the *> ZLATMR routine in order to build random test matrices. No error @@ -220,7 +220,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_matgen * @@ -229,10 +229,10 @@ $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * -* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. * diff --git a/lapack-netlib/TESTING/MATGEN/zlatm5.f b/lapack-netlib/TESTING/MATGEN/zlatm5.f index 6b277268d..4020c8554 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatm5.f +++ b/lapack-netlib/TESTING/MATGEN/zlatm5.f @@ -48,7 +48,7 @@ *> \param[in] PRTYPE *> \verbatim *> PRTYPE is INTEGER -*> "Points" to a certian type of the matrices to generate +*> "Points" to a certain type of the matrices to generate *> (see futher details). *> \endverbatim *> @@ -192,7 +192,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16_matgen * @@ -268,10 +268,10 @@ $ E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA, $ QBLCKB ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB, LDC, LDD, LDE, LDF, LDL, LDR, M, N, diff --git a/lapack-netlib/TESTING/Makefile b/lapack-netlib/TESTING/Makefile index 9aaf07de7..968a9a2bd 100644 --- a/lapack-netlib/TESTING/Makefile +++ b/lapack-netlib/TESTING/Makefile @@ -582,3 +582,5 @@ FRCEIG: FRC: @FRC=$(FRC) + +.NOTPARALLEL: diff --git a/lapack-netlib/TESTING/ctest_rfp.in b/lapack-netlib/TESTING/ctest_rfp.in index 2975f225d..d6988f2a7 100644 --- a/lapack-netlib/TESTING/ctest_rfp.in +++ b/lapack-netlib/TESTING/ctest_rfp.in @@ -5,5 +5,5 @@ Data file for testing COMPLEX LAPACK linear equation routines RFP format 1 2 15 Values of NRHS (number of right hand sides) 9 Number of matrix types (list types on next line if 0 < NTYPES < 9) 1 2 3 4 5 6 7 8 9 Matrix Types -60.0 Threshold value of test ratio +30.0 Threshold value of test ratio T Put T to test the error exits diff --git a/lapack-netlib/TESTING/sep.in b/lapack-netlib/TESTING/sep.in index 2116c7f2b..7f9f54f52 100644 --- a/lapack-netlib/TESTING/sep.in +++ b/lapack-netlib/TESTING/sep.in @@ -1,11 +1,11 @@ SEP: Data file for testing Symmetric Eigenvalue Problem routines -8 Number of values of N -0 1 2 3 5 16 19 20 Values of N (dimension) +6 Number of values of N +0 1 2 3 5 20 Values of N (dimension) 5 Number of values of NB 1 3 3 3 10 Values of NB (blocksize) 2 2 2 2 2 Values of NBMIN (minimum blocksize) 1 0 5 9 1 Values of NX (crossover point) -600.0 Threshold value +50.0 Threshold value T Put T to test the LAPACK routines T Put T to test the driver routines T Put T to test the error exits diff --git a/lapack-netlib/TESTING/svd.in b/lapack-netlib/TESTING/svd.in index 225b82658..bc0ae2d2e 100644 --- a/lapack-netlib/TESTING/svd.in +++ b/lapack-netlib/TESTING/svd.in @@ -7,7 +7,7 @@ SVD: Data file for testing Singular Value Decomposition routines 2 2 2 2 2 Values of NBMIN (minimum blocksize) 1 0 5 9 1 Values of NX (crossover point) 2 0 2 2 2 Values of NRHS -100.0 Threshold value +50.0 Threshold value T Put T to test the LAPACK routines T Put T to test the driver routines T Put T to test the error exits diff --git a/lapack-netlib/lapack.pc.in b/lapack-netlib/lapack.pc.in index d34c8708b..4d4fe0137 100644 --- a/lapack-netlib/lapack.pc.in +++ b/lapack-netlib/lapack.pc.in @@ -1,9 +1,9 @@ -prefix=@prefix@ -libdir=@libdir@ +prefix=@CMAKE_INSTALL_PREFIX@ +libdir=@CMAKE_INSTALL_PREFIX@/@CMAKE_INSTALL_LIBDIR@ Name: lapack Description: FORTRAN reference implementation of LAPACK Linear Algebra PACKage Version: @LAPACK_VERSION@ URL: http://www.netlib.org/lapack/ -Libs: -L${libdir} -llapack +Libs: -L@CMAKE_INSTALL_PREFIX@/@CMAKE_INSTALL_LIBDIR@ -llapack Requires: blas diff --git a/lapack-netlib/lapack_testing.py b/lapack-netlib/lapack_testing.py index 8ddc049b7..4ffd72a00 100755 --- a/lapack-netlib/lapack_testing.py +++ b/lapack-netlib/lapack_testing.py @@ -3,22 +3,22 @@ ############################################################################### -# lapack_testing.py +# lapack_testing.py ############################################################################### - -from subprocess import Popen, STDOUT, PIPE +from __future__ import print_function +from subprocess import Popen, STDOUT, PIPE import os, sys, math import getopt # Arguments try: - opts, args = getopt.getopt(sys.argv[1:], "hd:srep:t:n", - ["help", "dir", "short", "run", "error","prec=","test=","number"]) - -except getopt.error, msg: - print msg - print "for help use --help" - sys.exit(2) + opts, args = getopt.getopt(sys.argv[1:], "hd:srep:t:n", + ["help", "dir", "short", "run", "error","prec=","test=","number"]) + +except getopt.error as msg: + print(msg) + print("for help use --help") + sys.exit(2) short_summary=0 with_file=1 @@ -32,56 +32,56 @@ bin_dir='bin/Release' abs_bin_dir=os.path.normpath(os.path.join(os.getcwd(),bin_dir)) for o, a in opts: - if o in ("-h", "--help"): - print sys.argv[0]+" [-h|--help] [-d dir |--dir dir] [-s |--short] [-r |--run] [-e |--error] [-p p |--prec p] [-t test |--test test] [-n | --number]" - print " - h is to print this message" - print " - r is to use to run the LAPACK tests then analyse the output (.out files). By default, the script will not run all the LAPACK tests" - print " - d [dir] is to indicate where is the LAPACK testing directory (.out files). By default, the script will use ." - print " LEVEL OF OUTPUT" - print " - x is to print a detailed summary" - print " - e is to print only the error summary" - print " - s is to print a short summary" - print " - n is to print the numbers of failing tests (turn on summary mode)" - print " SECLECTION OF TESTS:" - print " - p [s/c/d/z/x] is to indicate the PRECISION to run:" - print " s=single" - print " d=double" - print " sd=single/double" - print " c=complex" - print " z=double complex" - print " cz=complex/double complex" - print " x=all [DEFAULT]" - print " - t [lin/eig/mixed/rfp/all] is to indicate which TEST FAMILY to run:" - print " lin=Linear Equation" - print " eig=Eigen Problems" - print " mixed=mixed-precision" - print " rfp=rfp format" - print " all=all tests [DEFAULT]" - print " EXAMPLES:" - print " ./lapack_testing.py -n" - print " Will return the numbers of failed tests by analyzing the LAPACK output" - print " ./lapack_testing.py -n -r -p s" - print " Will return the numbers of failed tests in REAL precision by running the LAPACK Tests then analyzing the output" - print " ./lapack_testing.py -n -p s -t eig " - print " Will return the numbers of failed tests in REAL precision by analyzing only the LAPACK output of EIGEN testings" - print "Written by Julie Langou (June 2011) " - sys.exit(0) - else: - if o in ("-s", "--short"): - short_summary = 1 - if o in ("-r", "--run"): - with_file = 0 - if o in ("-e", "--error"): - just_errors = 1 - if o in ( '-p', '--prec' ): - prec = a - if o in ( '-d', '--dir' ): - test_dir = a - if o in ( '-t', '--test' ): - test = a - if o in ( '-n', '--number' ): - only_numbers = 1 - short_summary = 1 + if o in ("-h", "--help"): + print(sys.argv[0]+" [-h|--help] [-d dir |--dir dir] [-s |--short] [-r |--run] [-e |--error] [-p p |--prec p] [-t test |--test test] [-n | --number]") + print(" - h is to print this message") + print(" - r is to use to run the LAPACK tests then analyse the output (.out files). By default, the script will not run all the LAPACK tests") + print(" - d [dir] is to indicate where is the LAPACK testing directory (.out files). By default, the script will use .") + print(" LEVEL OF OUTPUT") + print(" - x is to print a detailed summary") + print(" - e is to print only the error summary") + print(" - s is to print a short summary") + print(" - n is to print the numbers of failing tests (turn on summary mode)") + print(" SECLECTION OF TESTS:") + print(" - p [s/c/d/z/x] is to indicate the PRECISION to run:") + print(" s=single") + print(" d=double") + print(" sd=single/double") + print(" c=complex") + print(" z=double complex") + print(" cz=complex/double complex") + print(" x=all [DEFAULT]") + print(" - t [lin/eig/mixed/rfp/all] is to indicate which TEST FAMILY to run:") + print(" lin=Linear Equation") + print(" eig=Eigen Problems") + print(" mixed=mixed-precision") + print(" rfp=rfp format") + print(" all=all tests [DEFAULT]") + print(" EXAMPLES:") + print(" ./lapack_testing.py -n") + print(" Will return the numbers of failed tests by analyzing the LAPACK output") + print(" ./lapack_testing.py -n -r -p s") + print(" Will return the numbers of failed tests in REAL precision by running the LAPACK Tests then analyzing the output") + print(" ./lapack_testing.py -n -p s -t eig ") + print(" Will return the numbers of failed tests in REAL precision by analyzing only the LAPACK output of EIGEN testings") + print("Written by Julie Langou (June 2011) ") + sys.exit(0) + else: + if o in ("-s", "--short"): + short_summary = 1 + if o in ("-r", "--run"): + with_file = 0 + if o in ("-e", "--error"): + just_errors = 1 + if o in ( '-p', '--prec' ): + prec = a + if o in ( '-d', '--dir' ): + test_dir = a + if o in ( '-t', '--test' ): + test = a + if o in ( '-n', '--number' ): + only_numbers = 1 + short_summary = 1 # process options @@ -89,7 +89,7 @@ os.chdir(test_dir) execution=1 summary="\n\t\t\t--> LAPACK TESTING SUMMARY <--\n"; -if with_file: summary+= "\t\tProcessing LAPACK Testing output found in the "+test_dir+" direcory\n"; +if with_file: summary+= "\t\tProcessing LAPACK Testing output found in the "+test_dir+" directory\n"; summary+="SUMMARY \tnb test run \tnumerical error \tother error \n"; summary+="================ \t===========\t=================\t================ \n"; nb_of_test=0 @@ -100,80 +100,80 @@ os.environ["PATH"] = os.environ["PATH"]+":." # Define a function to open the executable (different filenames on unix and Windows) def run_summary_test( f, cmdline, short_summary): - nb_test_run=0 - nb_test_fail=0 - nb_test_illegal=0 - nb_test_info=0 - - if (with_file): - if not os.path.exists(cmdline): - error_message=cmdline+" file not found" - r=1 - if short_summary: return [nb_test_run,nb_test_fail,nb_test_illegal,nb_test_info] - else: - pipe = open(cmdline,'r') - r=0 - else: - if os.name != 'nt': - cmdline='./' + cmdline - else : - cmdline=abs_bin_dir+os.path.sep+cmdline + nb_test_run=0 + nb_test_fail=0 + nb_test_illegal=0 + nb_test_info=0 - outfile=cmdline.split()[4] - #pipe = open(outfile,'w') - p = Popen(cmdline, shell=True)#, stdout=pipe) - p.wait() - #pipe.close() - r=p.returncode - pipe = open(outfile,'r') - error_message=cmdline+" did not work" + if (with_file): + if not os.path.exists(cmdline): + error_message=cmdline+" file not found" + r=1 + if short_summary: return [nb_test_run,nb_test_fail,nb_test_illegal,nb_test_info] + else: + pipe = open(cmdline,'r') + r=0 + else: + if os.name != 'nt': + cmdline='./' + cmdline + else : + cmdline=abs_bin_dir+os.path.sep+cmdline - if r != 0 and not with_file: - print "---- TESTING " + cmdline.split()[0] + "... FAILED(" + error_message +") !" - for line in pipe.readlines(): - f.write(str(line)) - elif r != 0 and with_file and not short_summary: - print "---- WARNING: please check that you have the LAPACK output : "+cmdline+"!" - print "---- WARNING: with the option -r, we can run the LAPACK testing for you" - # print "---- "+error_message - else: - for line in pipe.readlines(): - f.write(str(line)) - words_in_line=line.split() - if (line.find("run")!=-1): -# print line - whereisrun=words_in_line.index("run)") - nb_test_run+=int(words_in_line[whereisrun-2]) - if (line.find("out of")!=-1): - if (short_summary==0): print line, - whereisout= words_in_line.index("out") - nb_test_fail+=int(words_in_line[whereisout-1]) - if ((line.find("illegal")!=-1) or (line.find("Illegal")!=-1)): - if (short_summary==0):print line, - nb_test_illegal+=1 - if (line.find(" INFO")!=-1): - if (short_summary==0):print line, - nb_test_info+=1 - if (with_file==1): - pipe.close() - - f.flush(); + outfile=cmdline.split()[4] + #pipe = open(outfile,'w') + p = Popen(cmdline, shell=True)#, stdout=pipe) + p.wait() + #pipe.close() + r=p.returncode + pipe = open(outfile,'r') + error_message=cmdline+" did not work" - return [nb_test_run,nb_test_fail,nb_test_illegal,nb_test_info] + if r != 0 and not with_file: + print("---- TESTING " + cmdline.split()[0] + "... FAILED(" + error_message +") !") + for line in pipe.readlines(): + f.write(str(line)) + elif r != 0 and with_file and not short_summary: + print("---- WARNING: please check that you have the LAPACK output : "+cmdline+"!") + print("---- WARNING: with the option -r, we can run the LAPACK testing for you") + # print "---- "+error_message + else: + for line in pipe.readlines(): + f.write(str(line)) + words_in_line=line.split() + if (line.find("run")!=-1): +# print line + whereisrun=words_in_line.index("run)") + nb_test_run+=int(words_in_line[whereisrun-2]) + if (line.find("out of")!=-1): + if (short_summary==0): print(line, end=' ') + whereisout= words_in_line.index("out") + nb_test_fail+=int(words_in_line[whereisout-1]) + if ((line.find("illegal")!=-1) or (line.find("Illegal")!=-1)): + if (short_summary==0):print(line, end=' ') + nb_test_illegal+=1 + if (line.find(" INFO")!=-1): + if (short_summary==0):print(line, end=' ') + nb_test_info+=1 + if (with_file==1): + pipe.close() + + f.flush(); + + return [nb_test_run,nb_test_fail,nb_test_illegal,nb_test_info] # If filename cannot be opened, send output to sys.stderr filename = "testing_results.txt" try: - f = open(filename, 'w') + f = open(filename, 'w') except IOError: - f = sys.stdout + f = sys.stdout if (short_summary==0): - print " " - print "---------------- Testing LAPACK Routines ----------------" - print " " - print "-- Detailed results are stored in", filename + print(" ") + print("---------------- Testing LAPACK Routines ----------------") + print(" ") + print("-- Detailed results are stored in", filename) dtypes = ( ("s", "d", "c", "z"), @@ -181,32 +181,32 @@ dtypes = ( ) if prec=='s': - range_prec=[0] + range_prec=[0] elif prec=='d': - range_prec=[1] + range_prec=[1] elif prec=='sd': - range_prec=[0,1] + range_prec=[0,1] elif prec=='c': - range_prec=[2] + range_prec=[2] elif prec=='z': - range_prec=[3] + range_prec=[3] elif prec=='cz': - range_prec=[2,3] -else: - prec='x'; - range_prec=range(4) + range_prec=[2,3] +else: + prec='x'; + range_prec=list(range(4)) if test=='lin': - range_test=[15] + range_test=[15] elif test=='mixed': - range_test=[16] - range_prec=[1,3] + range_test=[16] + range_prec=[1,3] elif test=='rfp': - range_test=[17] + range_test=[17] elif test=='eig': - range_test=range(15) -else: - range_test=range(18) + range_test=list(range(15)) +else: + range_test=list(range(18)) list_results = [ [0, 0, 0, 0, 0], @@ -216,111 +216,111 @@ list_results = [ ] for dtype in range_prec: - letter = dtypes[0][dtype] - name = dtypes[1][dtype] + letter = dtypes[0][dtype] + name = dtypes[1][dtype] - if (short_summary==0): - print " " - print "------------------------- %s ------------------------" % name - print " " - sys.stdout.flush() + if (short_summary==0): + print(" ") + print("------------------------- %s ------------------------" % name) + print(" ") + sys.stdout.flush() - dtests = ( - ("nep", "sep", "svd", - letter+"ec",letter+"ed",letter+"gg", - letter+"gd",letter+"sb",letter+"sg", - letter+"bb","glm","gqr", - "gsv","csd","lse", - letter+"test", letter+dtypes[0][dtype-1]+"test",letter+"test_rfp"), - ("Nonsymmetric Eigenvalue Problem", "Symmetric Eigenvalue Problem", "Singular Value Decomposition", - "Eigen Condition","Nonsymmetric Eigenvalue","Nonsymmetric Generalized Eigenvalue Problem", - "Nonsymmetric Generalized Eigenvalue Problem driver", "Symmetric Eigenvalue Problem", "Symmetric Eigenvalue Generalized Problem", - "Banded Singular Value Decomposition routines", "Generalized Linear Regression Model routines", "Generalized QR and RQ factorization routines", - "Generalized Singular Value Decomposition routines", "CS Decomposition routines", "Constrained Linear Least Squares routines", - "Linear Equation routines", "Mixed Precision linear equation routines","RFP linear equation routines"), - (letter+"nep", letter+"sep", letter+"svd", - letter+"ec",letter+"ed",letter+"gg", - letter+"gd",letter+"sb",letter+"sg", - letter+"bb",letter+"glm",letter+"gqr", - letter+"gsv",letter+"csd",letter+"lse", - letter+"test", letter+dtypes[0][dtype-1]+"test",letter+"test_rfp"), - ) + dtests = ( + ("nep", "sep", "svd", + letter+"ec",letter+"ed",letter+"gg", + letter+"gd",letter+"sb",letter+"sg", + letter+"bb","glm","gqr", + "gsv","csd","lse", + letter+"test", letter+dtypes[0][dtype-1]+"test",letter+"test_rfp"), + ("Nonsymmetric Eigenvalue Problem", "Symmetric Eigenvalue Problem", "Singular Value Decomposition", + "Eigen Condition","Nonsymmetric Eigenvalue","Nonsymmetric Generalized Eigenvalue Problem", + "Nonsymmetric Generalized Eigenvalue Problem driver", "Symmetric Eigenvalue Problem", "Symmetric Eigenvalue Generalized Problem", + "Banded Singular Value Decomposition routines", "Generalized Linear Regression Model routines", "Generalized QR and RQ factorization routines", + "Generalized Singular Value Decomposition routines", "CS Decomposition routines", "Constrained Linear Least Squares routines", + "Linear Equation routines", "Mixed Precision linear equation routines","RFP linear equation routines"), + (letter+"nep", letter+"sep", letter+"svd", + letter+"ec",letter+"ed",letter+"gg", + letter+"gd",letter+"sb",letter+"sg", + letter+"bb",letter+"glm",letter+"gqr", + letter+"gsv",letter+"csd",letter+"lse", + letter+"test", letter+dtypes[0][dtype-1]+"test",letter+"test_rfp"), + ) - for dtest in range_test: - nb_of_test=0 - # NEED TO SKIP SOME PRECISION (namely s and c) FOR PROTO MIXED PRECISION TESTING - if dtest==16 and (letter=="s" or letter=="c"): - continue - if (with_file==1): - cmdbase=dtests[2][dtest]+".out" - else: - if dtest==15: - # LIN TESTS - cmdbase="xlintst"+letter+" < "+dtests[0][dtest]+".in > "+dtests[2][dtest]+".out" - elif dtest==16: - # PROTO LIN TESTS - cmdbase="xlintst"+letter+dtypes[0][dtype-1]+" < "+dtests[0][dtest]+".in > "+dtests[2][dtest]+".out" - elif dtest==17: - # PROTO LIN TESTS - cmdbase="xlintstrf"+letter+" < "+dtests[0][dtest]+".in > "+dtests[2][dtest]+".out" + for dtest in range_test: + nb_of_test=0 + # NEED TO SKIP SOME PRECISION (namely s and c) FOR PROTO MIXED PRECISION TESTING + if dtest==16 and (letter=="s" or letter=="c"): + continue + if (with_file==1): + cmdbase=dtests[2][dtest]+".out" else: - # EIG TESTS - cmdbase="xeigtst"+letter+" < "+dtests[0][dtest]+".in > "+dtests[2][dtest]+".out" - if (not just_errors and not short_summary): - print "--> Testing "+name+" "+dtests[1][dtest]+" [ "+cmdbase+" ]" - # Run the process: either to read the file or run the LAPACK testing - nb_test = run_summary_test(f, cmdbase, short_summary) - list_results[0][dtype]+=nb_test[0] - list_results[1][dtype]+=nb_test[1] - list_results[2][dtype]+=nb_test[2] - list_results[3][dtype]+=nb_test[3] - got_error=nb_test[1]+nb_test[2]+nb_test[3] - - if (not short_summary): - if (nb_test[0]>0 and just_errors==0): - print "--> Tests passed: "+str(nb_test[0]) - if (nb_test[1]>0): - print "--> Tests failing to pass the threshold: "+str(nb_test[1]) - if (nb_test[2]>0): - print "--> Illegal Error: "+str(nb_test[2]) - if (nb_test[3]>0): - print "--> Info Error: "+str(nb_test[3]) - if (got_error>0 and just_errors==1): - print "ERROR IS LOCATED IN "+name+" "+dtests[1][dtest]+" [ "+cmdbase+" ]" - print "" - if (just_errors==0): - print "" + if dtest==15: + # LIN TESTS + cmdbase="xlintst"+letter+" < "+dtests[0][dtest]+".in > "+dtests[2][dtest]+".out" + elif dtest==16: + # PROTO LIN TESTS + cmdbase="xlintst"+letter+dtypes[0][dtype-1]+" < "+dtests[0][dtest]+".in > "+dtests[2][dtest]+".out" + elif dtest==17: + # PROTO LIN TESTS + cmdbase="xlintstrf"+letter+" < "+dtests[0][dtest]+".in > "+dtests[2][dtest]+".out" + else: + # EIG TESTS + cmdbase="xeigtst"+letter+" < "+dtests[0][dtest]+".in > "+dtests[2][dtest]+".out" + if (not just_errors and not short_summary): + print("--> Testing "+name+" "+dtests[1][dtest]+" [ "+cmdbase+" ]") + # Run the process: either to read the file or run the LAPACK testing + nb_test = run_summary_test(f, cmdbase, short_summary) + list_results[0][dtype]+=nb_test[0] + list_results[1][dtype]+=nb_test[1] + list_results[2][dtype]+=nb_test[2] + list_results[3][dtype]+=nb_test[3] + got_error=nb_test[1]+nb_test[2]+nb_test[3] + + if (not short_summary): + if (nb_test[0]>0 and just_errors==0): + print("--> Tests passed: "+str(nb_test[0])) + if (nb_test[1]>0): + print("--> Tests failing to pass the threshold: "+str(nb_test[1])) + if (nb_test[2]>0): + print("--> Illegal Error: "+str(nb_test[2])) + if (nb_test[3]>0): + print("--> Info Error: "+str(nb_test[3])) + if (got_error>0 and just_errors==1): + print("ERROR IS LOCATED IN "+name+" "+dtests[1][dtest]+" [ "+cmdbase+" ]") + print("") + if (just_errors==0): + print("") # elif (got_error>0): # print dtests[2][dtest]+".out \t"+str(nb_test[1])+"\t"+str(nb_test[2])+"\t"+str(nb_test[3]) - - sys.stdout.flush() - if (list_results[0][dtype] > 0 ): - percent_num_error=float(list_results[1][dtype])/float(list_results[0][dtype])*100 - percent_error=float(list_results[2][dtype]+list_results[3][dtype])/float(list_results[0][dtype])*100 - else: - percent_num_error=0 - percent_error=0 - summary+=name+"\t"+str(list_results[0][dtype])+"\t\t"+str(list_results[1][dtype])+"\t("+"%.3f" % percent_num_error+"%)\t"+str(list_results[2][dtype]+list_results[3][dtype])+"\t("+"%.3f" % percent_error+"%)\t""\n" - list_results[0][4]+=list_results[0][dtype] - list_results[1][4]+=list_results[1][dtype] - list_results[2][4]+=list_results[2][dtype] - list_results[3][4]+=list_results[3][dtype] - + + sys.stdout.flush() + if (list_results[0][dtype] > 0 ): + percent_num_error=float(list_results[1][dtype])/float(list_results[0][dtype])*100 + percent_error=float(list_results[2][dtype]+list_results[3][dtype])/float(list_results[0][dtype])*100 + else: + percent_num_error=0 + percent_error=0 + summary+=name+"\t"+str(list_results[0][dtype])+"\t\t"+str(list_results[1][dtype])+"\t("+"%.3f" % percent_num_error+"%)\t"+str(list_results[2][dtype]+list_results[3][dtype])+"\t("+"%.3f" % percent_error+"%)\t""\n" + list_results[0][4]+=list_results[0][dtype] + list_results[1][4]+=list_results[1][dtype] + list_results[2][4]+=list_results[2][dtype] + list_results[3][4]+=list_results[3][dtype] + if only_numbers==1: - print str(list_results[1][4])+"\n"+str(list_results[2][4]+list_results[3][4]) + print(str(list_results[1][4])+"\n"+str(list_results[2][4]+list_results[3][4])) else: - print summary - if (list_results[0][4] > 0 ): - percent_num_error=float(list_results[1][4])/float(list_results[0][4])*100 - percent_error=float(list_results[2][4]+list_results[3][4])/float(list_results[0][4])*100 - else: - percent_num_error=0 - percent_error=0 - if (prec=='x'): - print "--> ALL PRECISIONS\t"+str(list_results[0][4])+"\t\t"+str(list_results[1][4])+"\t("+"%.3f" % percent_num_error+"%)\t"+str(list_results[2][4]+list_results[3][4])+"\t("+"%.3f" % percent_error+"%)\t""\n" - if list_results[0][4] == 0: - print "NO TESTS WERE ANALYZED, please use the -r option to run the LAPACK TESTING" + print(summary) + if (list_results[0][4] > 0 ): + percent_num_error=float(list_results[1][4])/float(list_results[0][4])*100 + percent_error=float(list_results[2][4]+list_results[3][4])/float(list_results[0][4])*100 + else: + percent_num_error=0 + percent_error=0 + if (prec=='x'): + print("--> ALL PRECISIONS\t"+str(list_results[0][4])+"\t\t"+str(list_results[1][4])+"\t("+"%.3f" % percent_num_error+"%)\t"+str(list_results[2][4]+list_results[3][4])+"\t("+"%.3f" % percent_error+"%)\t""\n") + if list_results[0][4] == 0: + print("NO TESTS WERE ANALYZED, please use the -r option to run the LAPACK TESTING") # This may close the sys.stdout stream, so make it the last statement f.close() diff --git a/lapack-netlib/make.inc.example b/lapack-netlib/make.inc.example index 504a16421..f59f34e7a 100644 --- a/lapack-netlib/make.inc.example +++ b/lapack-netlib/make.inc.example @@ -1,7 +1,7 @@ #################################################################### # LAPACK make include file. # -# LAPACK, Version 3.6.0 # -# November 2015 # +# LAPACK, Version 3.6.1 # +# June 2016 # #################################################################### # SHELL = /bin/sh