From 0b8a436af956788b8e75f7da6621cdc730e3b203 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 22 Apr 2021 02:11:20 +0200 Subject: [PATCH 01/10] Add mixed clang/ifort build on OSX to Azure CI (#3185) * Add mixed clang/ifort build on OSX to the Azure CI config based on https://github.com/oneapi-src/oneapi-ci (and remove debugging tools from the clang+gfortran job) * Remove extraneous libgfortran dependency of ifort builds * remove FEXTRALIB from link line of shared library as ifort keeps track of dependencies (and they are different for a .dylib than what f_check got for an executable) --- azure-pipelines.yml | 49 ++++++++++++++++++++++++++++++++++++++++----- exports/Makefile | 4 ++++ f_check | 4 ---- 3 files changed, 48 insertions(+), 9 deletions(-) diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 68e48437f..56a3fd4ae 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -4,7 +4,15 @@ trigger: branches: include: - develop - +resources: + containers: + - container: oneapi-hpckit + image: intel/oneapi-hpckit:latest + options: '-v /usr/bin/sudo:/usr/bin/sudo -v /usr/lib/sudo/libsudo_util.so.0:/usr/lib/sudo/libsudo_util.so.0 -v /usr/lib/sudo/sudoers.so:/usr/lib/sudo/sudoers.so' + - container: oneapi-basekit + image: intel/oneapi-basekit:latest + options: '-v /usr/bin/sudo:/usr/bin/sudo -v /usr/lib/sudo/libsudo_util.so.0:/usr/lib/sudo/libsudo_util.so.0 -v /usr/lib/sudo/sudoers.so:/usr/lib/sudo/sudoers.so' + jobs: # manylinux1 is useful to test because the # standard Docker container uses an old version @@ -94,7 +102,38 @@ jobs: - script: | brew update brew install llvm libomp - brew tap LouisBrunner/valgrind - brew install --HEAD LouisBrunner/valgrind/valgrind - make TARGET=SANDYBRIDGE NO_AVX512=1 USE_OPENMP=1 INTERFACE64=1 DYNAMIC_ARCH=1 DYNAMIC_LIST=SANDYBRIDGE DEBUG=1 NO_PARALLEL_MAKE=1 CC=/usr/local/opt/llvm/bin/clang FC=gfortran-10 - cd ctest; OMP_NUM_THREADS=1 valgrind ./xscblat2 Date: Mon, 26 Apr 2021 21:55:30 +0200 Subject: [PATCH 02/10] replace spurious avx512 requirement with fma check --- kernel/x86_64/drot_microk_haswell-2.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/kernel/x86_64/drot_microk_haswell-2.c b/kernel/x86_64/drot_microk_haswell-2.c index 72a87696e..cc5949b1a 100644 --- a/kernel/x86_64/drot_microk_haswell-2.c +++ b/kernel/x86_64/drot_microk_haswell-2.c @@ -1,6 +1,4 @@ -/* need a new enough GCC for avx512 support */ -#if (( defined(__GNUC__) && __GNUC__ > 6 && defined(__AVX512CD__)) || (defined(__clang__) && __clang_major__ >= 9)) - +#if defined(HAVE_FMA3) && defined(HAVE_AVX2) #define HAVE_DROT_KERNEL 1 #include From 0608bc5d82d780cf81f27e0297af37814cfd73dc Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 26 Apr 2021 22:32:23 +0200 Subject: [PATCH 03/10] delay creation of the softlink until after the library has been created --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index de0735c4a..555d1c467 100644 --- a/Makefile +++ b/Makefile @@ -167,7 +167,6 @@ ifeq ($(NO_SHARED), 1) $(error OpenBLAS: neither static nor shared are enabled.) endif endif - @-ln -fs $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) @for d in $(SUBDIRS) ; \ do if test -d $$d; then \ $(MAKE) -C $$d $(@F) || exit 1 ; \ @@ -196,6 +195,7 @@ endif ifdef USE_THREAD @echo USE_THREAD=$(USE_THREAD) >> Makefile.conf_last endif + @-ln -fs $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) @touch lib.grd prof : prof_blas prof_lapack From 3526ff25070d1e3094933598ea803dd577d5e566 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 27 Apr 2021 12:52:49 +0200 Subject: [PATCH 04/10] Apply fixes from Reference-LAPACK PR538 --- lapack-netlib/TESTING/LIN/cdrvgex.f | 7 ++++--- lapack-netlib/TESTING/LIN/cdrvhe_aa_2stage.f | 10 +++++----- lapack-netlib/TESTING/LIN/cdrvrfp.f | 8 ++++---- lapack-netlib/TESTING/LIN/ddrvrfp.f | 3 +-- lapack-netlib/TESTING/LIN/sdrvrfp.f | 2 +- lapack-netlib/TESTING/LIN/zdrvgex.f | 7 ++++--- lapack-netlib/TESTING/LIN/zdrvhex.f | 8 ++++---- lapack-netlib/TESTING/LIN/zdrvpox.f | 8 ++++---- lapack-netlib/TESTING/LIN/zdrvrfp.f | 2 +- lapack-netlib/TESTING/LIN/zdrvsyx.f | 8 ++++---- lapack-netlib/TESTING/LIN/zerrvxx.f | 2 +- 11 files changed, 33 insertions(+), 32 deletions(-) diff --git a/lapack-netlib/TESTING/LIN/cdrvgex.f b/lapack-netlib/TESTING/LIN/cdrvgex.f index 51fc84899..9b075908f 100644 --- a/lapack-netlib/TESTING/LIN/cdrvgex.f +++ b/lapack-netlib/TESTING/LIN/cdrvgex.f @@ -707,9 +707,10 @@ CALL CLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA ) IF( .NOT.PREFAC ) - $ CALL CLASET( 'Full', N, N, ZERO, ZERO, AFAC, - $ LDA ) - CALL CLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) + $ CALL CLASET( 'Full', N, N, CMPLX( ZERO ), + $ CMPLX( ZERO ), AFAC, LDA ) + CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ), + $ CMPLX( ZERO ), X, LDA ) IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN * * Equilibrate the matrix if FACT = 'F' and diff --git a/lapack-netlib/TESTING/LIN/cdrvhe_aa_2stage.f b/lapack-netlib/TESTING/LIN/cdrvhe_aa_2stage.f index 32be41f64..959258e1f 100644 --- a/lapack-netlib/TESTING/LIN/cdrvhe_aa_2stage.f +++ b/lapack-netlib/TESTING/LIN/cdrvhe_aa_2stage.f @@ -449,11 +449,11 @@ * Reconstruct matrix from factors and compute * residual. * -c CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA, -c $ IWORK, AINV, LDA, RWORK, -c $ RESULT( 2 ) ) -c NT = 2 - NT = 1 +c CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA, +c $ IWORK, AINV, LDA, RWORK, +c $ RESULT( 2 ) ) +c NT = 2 + NT = 1 * * Print information about the tests that did not pass * the threshold. diff --git a/lapack-netlib/TESTING/LIN/cdrvrfp.f b/lapack-netlib/TESTING/LIN/cdrvrfp.f index a57688f83..362a0e7cb 100644 --- a/lapack-netlib/TESTING/LIN/cdrvrfp.f +++ b/lapack-netlib/TESTING/LIN/cdrvrfp.f @@ -449,19 +449,19 @@ * Form the inverse of A. * CALL CPOTRI( UPLO, N, A, LDA, INFO ) + + IF ( N .NE. 0 ) THEN * -* Compute the 1-norm condition number of A. +* Compute the 1-norm condition number of A. * - IF ( N .NE. 0 ) THEN AINVNM = CLANHE( '1', UPLO, N, A, LDA, + S_WORK_CLANHE ) RCONDC = ( ONE / ANORM ) / AINVNM * * Restore the matrix A. * - CALL CLACPY( UPLO, N, N, ASAV, LDA, A, LDA ) + CALL CLACPY( UPLO, N, N, ASAV, LDA, A, LDA ) END IF - * END IF * diff --git a/lapack-netlib/TESTING/LIN/ddrvrfp.f b/lapack-netlib/TESTING/LIN/ddrvrfp.f index d67cf6713..18ccbdfc4 100644 --- a/lapack-netlib/TESTING/LIN/ddrvrfp.f +++ b/lapack-netlib/TESTING/LIN/ddrvrfp.f @@ -443,8 +443,7 @@ * CALL DPOTRI( UPLO, N, A, LDA, INFO ) - IF ( N .NE. 0 ) THEN - + IF ( N .NE. 0 ) THEN * * Compute the 1-norm condition number of A. * diff --git a/lapack-netlib/TESTING/LIN/sdrvrfp.f b/lapack-netlib/TESTING/LIN/sdrvrfp.f index 4b022bcfb..c0eb4d564 100644 --- a/lapack-netlib/TESTING/LIN/sdrvrfp.f +++ b/lapack-netlib/TESTING/LIN/sdrvrfp.f @@ -443,7 +443,7 @@ * CALL SPOTRI( UPLO, N, A, LDA, INFO ) - IF ( N .NE. 0 ) THEN + IF ( N .NE. 0 ) THEN * * Compute the 1-norm condition number of A. * diff --git a/lapack-netlib/TESTING/LIN/zdrvgex.f b/lapack-netlib/TESTING/LIN/zdrvgex.f index cdfa10727..1b784d31b 100644 --- a/lapack-netlib/TESTING/LIN/zdrvgex.f +++ b/lapack-netlib/TESTING/LIN/zdrvgex.f @@ -707,9 +707,10 @@ CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA ) IF( .NOT.PREFAC ) - $ CALL ZLASET( 'Full', N, N, ZERO, ZERO, AFAC, - $ LDA ) - CALL ZLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) + $ CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ), + $ DCMPLX( ZERO ), AFAC, LDA ) + CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), + $ DCMPLX( ZERO ), X, LDA ) IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN * * Equilibrate the matrix if FACT = 'F' and diff --git a/lapack-netlib/TESTING/LIN/zdrvhex.f b/lapack-netlib/TESTING/LIN/zdrvhex.f index 3c0dfbfe4..527114508 100644 --- a/lapack-netlib/TESTING/LIN/zdrvhex.f +++ b/lapack-netlib/TESTING/LIN/zdrvhex.f @@ -599,10 +599,10 @@ * Restore the matrices A and B. * IF( IFACT.EQ.2 ) - $ CALL ZLASET( UPLO, N, N, CMPLX( ZERO ), - $ CMPLX( ZERO ), AFAC, LDA ) - CALL ZLASET( 'Full', N, NRHS, CMPLX( ZERO ), - $ CMPLX( ZERO ), X, LDA ) + $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ), + $ DCMPLX( ZERO ), AFAC, LDA ) + CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), + $ DCMPLX( ZERO ), X, LDA ) * * Solve the system and compute the condition number * and error bounds using ZHESVXX. diff --git a/lapack-netlib/TESTING/LIN/zdrvpox.f b/lapack-netlib/TESTING/LIN/zdrvpox.f index 260d8c1f2..0bc2c89d8 100644 --- a/lapack-netlib/TESTING/LIN/zdrvpox.f +++ b/lapack-netlib/TESTING/LIN/zdrvpox.f @@ -611,10 +611,10 @@ CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA ) IF( .NOT.PREFAC ) - $ CALL ZLASET( UPLO, N, N, CMPLX( ZERO ), - $ CMPLX( ZERO ), AFAC, LDA ) - CALL ZLASET( 'Full', N, NRHS, CMPLX( ZERO ), - $ CMPLX( ZERO ), X, LDA ) + $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ), + $ DCMPLX( ZERO ), AFAC, LDA ) + CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), + $ DCMPLX( ZERO ), X, LDA ) IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN * * Equilibrate the matrix if FACT='F' and diff --git a/lapack-netlib/TESTING/LIN/zdrvrfp.f b/lapack-netlib/TESTING/LIN/zdrvrfp.f index c7be7da03..b299a487b 100644 --- a/lapack-netlib/TESTING/LIN/zdrvrfp.f +++ b/lapack-netlib/TESTING/LIN/zdrvrfp.f @@ -450,7 +450,7 @@ * CALL ZPOTRI( UPLO, N, A, LDA, INFO ) - IF ( N .NE. 0 ) THEN + IF ( N .NE. 0 ) THEN * * Compute the 1-norm condition number of A. * diff --git a/lapack-netlib/TESTING/LIN/zdrvsyx.f b/lapack-netlib/TESTING/LIN/zdrvsyx.f index 9431cd692..e4556f150 100644 --- a/lapack-netlib/TESTING/LIN/zdrvsyx.f +++ b/lapack-netlib/TESTING/LIN/zdrvsyx.f @@ -605,10 +605,10 @@ * Restore the matrices A and B. * IF( IFACT.EQ.2 ) - $ CALL ZLASET( UPLO, N, N, CMPLX( ZERO ), - $ CMPLX( ZERO ), AFAC, LDA ) - CALL ZLASET( 'Full', N, NRHS, CMPLX( ZERO ), - $ CMPLX( ZERO ), X, LDA ) + $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ), + $ DCMPLX( ZERO ), AFAC, LDA ) + CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), + $ DCMPLX( ZERO ), X, LDA ) * * Solve the system and compute the condition number * and error bounds using ZSYSVXX. diff --git a/lapack-netlib/TESTING/LIN/zerrvxx.f b/lapack-netlib/TESTING/LIN/zerrvxx.f index 9dc008215..bdaf44d8a 100644 --- a/lapack-netlib/TESTING/LIN/zerrvxx.f +++ b/lapack-netlib/TESTING/LIN/zerrvxx.f @@ -1166,7 +1166,7 @@ $ 2, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_N, $ ERR_BNDS_C, NPARAMS, PARAMS, W, RW, INFO ) CALL CHKXER( 'ZSYSVXX', INFOT, NOUT, LERR, OK ) - INFOT = 13 + INFOT = 13 EQ = 'N' CALL ZSYSVXX( 'N', 'U', 2, 0, A, 2, AF, 2, IP, EQ, R, B, 1, X, $ 2, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_N, From 13a29d13fde096176b0e6f70be2390dd5f3250c7 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 27 Apr 2021 15:48:22 +0200 Subject: [PATCH 05/10] Apply lapack-testing fix from Reference-LAPACK PR536 fixes changing back from a single OMP thread for error exit testing to the originally requested number of threads for computational tests --- lapack-netlib/TESTING/EIG/cchkee.F | 4 ++-- lapack-netlib/TESTING/EIG/dchkee.F | 2 +- lapack-netlib/TESTING/EIG/schkee.F | 2 +- lapack-netlib/TESTING/EIG/zchkee.F | 4 ++-- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lapack-netlib/TESTING/EIG/cchkee.F b/lapack-netlib/TESTING/EIG/cchkee.F index 0d3d7493c..de4aed696 100644 --- a/lapack-netlib/TESTING/EIG/cchkee.F +++ b/lapack-netlib/TESTING/EIG/cchkee.F @@ -1871,7 +1871,7 @@ CALL XLAENV( 9, 25 ) IF( TSTERR ) THEN #if defined(_OPENMP) - N_THREADS = OMP_GET_NUM_THREADS() + N_THREADS = OMP_GET_MAX_THREADS() CALL OMP_SET_NUM_THREADS(1) #endif CALL CERRST( 'CST', NOUT ) @@ -2338,7 +2338,7 @@ CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT ) IF( TSTERR ) THEN #if defined(_OPENMP) - N_THREADS = OMP_GET_NUM_THREADS() + N_THREADS = OMP_GET_MAX_THREADS() CALL OMP_SET_NUM_THREADS(1) #endif CALL CERRST( 'CHB', NOUT ) diff --git a/lapack-netlib/TESTING/EIG/dchkee.F b/lapack-netlib/TESTING/EIG/dchkee.F index ee22ce33d..00e8eb57f 100644 --- a/lapack-netlib/TESTING/EIG/dchkee.F +++ b/lapack-netlib/TESTING/EIG/dchkee.F @@ -1876,7 +1876,7 @@ CALL XLAENV( 9, 25 ) IF( TSTERR ) THEN #if defined(_OPENMP) - N_THREADS = OMP_GET_NUM_THREADS() + N_THREADS = OMP_GET_MAX_THREADS() CALL OMP_SET_NUM_THREADS(1) #endif CALL DERRST( 'DST', NOUT ) diff --git a/lapack-netlib/TESTING/EIG/schkee.F b/lapack-netlib/TESTING/EIG/schkee.F index a063c18b5..c3f9ca162 100644 --- a/lapack-netlib/TESTING/EIG/schkee.F +++ b/lapack-netlib/TESTING/EIG/schkee.F @@ -1877,7 +1877,7 @@ CALL XLAENV( 9, 25 ) IF( TSTERR ) THEN #if defined(_OPENMP) - N_THREADS = OMP_GET_NUM_THREADS() + N_THREADS = OMP_GET_MAX_THREADS() CALL OMP_SET_NUM_THREADS(1) #endif CALL SERRST( 'SST', NOUT ) diff --git a/lapack-netlib/TESTING/EIG/zchkee.F b/lapack-netlib/TESTING/EIG/zchkee.F index 29604956d..908b7d651 100644 --- a/lapack-netlib/TESTING/EIG/zchkee.F +++ b/lapack-netlib/TESTING/EIG/zchkee.F @@ -1871,7 +1871,7 @@ CALL XLAENV( 9, 25 ) IF( TSTERR ) THEN #if defined(_OPENMP) - N_THREADS = OMP_GET_NUM_THREADS() + N_THREADS = OMP_GET_MAX_THREADS() CALL OMP_SET_NUM_THREADS(1) #endif CALL ZERRST( 'ZST', NOUT ) @@ -2336,7 +2336,7 @@ CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT ) IF( TSTERR ) THEN #if defined(_OPENMP) - N_THREADS = OMP_GET_NUM_THREADS() + N_THREADS = OMP_GET_MAX_THREADS() CALL OMP_SET_NUM_THREADS(1) #endif CALL ZERRST( 'ZHB', NOUT ) From 2b01132515cc0ca709a4addf2e7101d94234b71e Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 28 Apr 2021 19:20:08 +0200 Subject: [PATCH 06/10] Clean up misdeclaration of the dummy stand-in for A in ?ORGBR/?UNGBR workspace queries (Reference-LAPACK PR 468 and 530) --- lapack-netlib/SRC/cungbr.f | 8 ++++---- lapack-netlib/SRC/dorgbr.f | 8 ++++---- lapack-netlib/SRC/sorgbr.f | 8 ++++---- lapack-netlib/SRC/zungbr.f | 8 ++++---- 4 files changed, 16 insertions(+), 16 deletions(-) diff --git a/lapack-netlib/SRC/cungbr.f b/lapack-netlib/SRC/cungbr.f index df25799ca..0dddd42a6 100644 --- a/lapack-netlib/SRC/cungbr.f +++ b/lapack-netlib/SRC/cungbr.f @@ -222,8 +222,8 @@ CALL CUNGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( M.GT.1 ) THEN - CALL CUNGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL CUNGQR( M-1, M-1, M-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF ELSE @@ -231,8 +231,8 @@ CALL CUNGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( N.GT.1 ) THEN - CALL CUNGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL CUNGLQ( N-1, N-1, N-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF END IF diff --git a/lapack-netlib/SRC/dorgbr.f b/lapack-netlib/SRC/dorgbr.f index cfebda5ab..6868fc38d 100644 --- a/lapack-netlib/SRC/dorgbr.f +++ b/lapack-netlib/SRC/dorgbr.f @@ -221,8 +221,8 @@ CALL DORGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( M.GT.1 ) THEN - CALL DORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL DORGQR( M-1, M-1, M-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF ELSE @@ -230,8 +230,8 @@ CALL DORGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( N.GT.1 ) THEN - CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL DORGLQ( N-1, N-1, N-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF END IF diff --git a/lapack-netlib/SRC/sorgbr.f b/lapack-netlib/SRC/sorgbr.f index dccdbb58a..2266505dc 100644 --- a/lapack-netlib/SRC/sorgbr.f +++ b/lapack-netlib/SRC/sorgbr.f @@ -221,8 +221,8 @@ CALL SORGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( M.GT.1 ) THEN - CALL SORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL SORGQR( M-1, M-1, M-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF ELSE @@ -230,8 +230,8 @@ CALL SORGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( N.GT.1 ) THEN - CALL SORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL SORGLQ( N-1, N-1, N-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF END IF diff --git a/lapack-netlib/SRC/zungbr.f b/lapack-netlib/SRC/zungbr.f index 3cdb8127d..c1c35822c 100644 --- a/lapack-netlib/SRC/zungbr.f +++ b/lapack-netlib/SRC/zungbr.f @@ -222,8 +222,8 @@ CALL ZUNGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( M.GT.1 ) THEN - CALL ZUNGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL ZUNGQR( M-1, M-1, M-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF ELSE @@ -231,8 +231,8 @@ CALL ZUNGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( N.GT.1 ) THEN - CALL ZUNGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL ZUNGLQ( N-1, N-1, N-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF END IF From 6b760666324806e89dfa4e52191dc7f92a13be3a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 28 Apr 2021 20:55:37 +0200 Subject: [PATCH 07/10] Add const qualifiers --- lapack-netlib/LAPACKE/include/lapack.h | 36 +++++++++++++------------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/lapack-netlib/LAPACKE/include/lapack.h b/lapack-netlib/LAPACKE/include/lapack.h index aedaa308d..828d3279e 100644 --- a/lapack-netlib/LAPACKE/include/lapack.h +++ b/lapack-netlib/LAPACKE/include/lapack.h @@ -566,8 +566,8 @@ void LAPACK_cgbrfsx( lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, lapack_complex_float const* AB, lapack_int const* ldab, lapack_complex_float const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, - float* R, - float* C, + const float* R, + const float* C, lapack_complex_float const* B, lapack_int const* ldb, lapack_complex_float* X, lapack_int const* ldx, float* rcond, @@ -585,8 +585,8 @@ void LAPACK_dgbrfsx( lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, double const* AB, lapack_int const* ldab, double const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, - double* R, - double* C, + const double* R, + const double* C, double const* B, lapack_int const* ldb, double* X, lapack_int const* ldx, double* rcond, @@ -604,8 +604,8 @@ void LAPACK_sgbrfsx( lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, float const* AB, lapack_int const* ldab, float const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, - float* R, - float* C, + const float* R, + const float* C, float const* B, lapack_int const* ldb, float* X, lapack_int const* ldx, float* rcond, @@ -623,8 +623,8 @@ void LAPACK_zgbrfsx( lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, lapack_complex_double const* AB, lapack_int const* ldab, lapack_complex_double const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, - double* R, - double* C, + const double* R, + const double* C, lapack_complex_double const* B, lapack_int const* ldb, lapack_complex_double* X, lapack_int const* ldx, double* rcond, @@ -4913,7 +4913,7 @@ void LAPACK_cherfsx( lapack_int const* n, lapack_int const* nrhs, lapack_complex_float const* A, lapack_int const* lda, lapack_complex_float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, - float* S, + const float* S, lapack_complex_float const* B, lapack_int const* ldb, lapack_complex_float* X, lapack_int const* ldx, float* rcond, @@ -4931,7 +4931,7 @@ void LAPACK_zherfsx( lapack_int const* n, lapack_int const* nrhs, lapack_complex_double const* A, lapack_int const* lda, lapack_complex_double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, - double* S, + const double* S, lapack_complex_double const* B, lapack_int const* ldb, lapack_complex_double* X, lapack_int const* ldx, double* rcond, @@ -8005,7 +8005,7 @@ void LAPACK_cporfsx( lapack_int const* n, lapack_int const* nrhs, lapack_complex_float const* A, lapack_int const* lda, lapack_complex_float const* AF, lapack_int const* ldaf, - float* S, + const float* S, lapack_complex_float const* B, lapack_int const* ldb, lapack_complex_float* X, lapack_int const* ldx, float* rcond, @@ -8023,7 +8023,7 @@ void LAPACK_dporfsx( lapack_int const* n, lapack_int const* nrhs, double const* A, lapack_int const* lda, double const* AF, lapack_int const* ldaf, - double* S, + const double* S, double const* B, lapack_int const* ldb, double* X, lapack_int const* ldx, double* rcond, @@ -8041,7 +8041,7 @@ void LAPACK_sporfsx( lapack_int const* n, lapack_int const* nrhs, float const* A, lapack_int const* lda, float const* AF, lapack_int const* ldaf, - float* S, + const float* S, float const* B, lapack_int const* ldb, float* X, lapack_int const* ldx, float* rcond, @@ -8059,7 +8059,7 @@ void LAPACK_zporfsx( lapack_int const* n, lapack_int const* nrhs, lapack_complex_double const* A, lapack_int const* lda, lapack_complex_double const* AF, lapack_int const* ldaf, - double* S, + const double* S, lapack_complex_double const* B, lapack_int const* ldb, lapack_complex_double* X, lapack_int const* ldx, double* rcond, @@ -10756,7 +10756,7 @@ void LAPACK_csyrfsx( lapack_int const* n, lapack_int const* nrhs, lapack_complex_float const* A, lapack_int const* lda, lapack_complex_float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, - float* S, + const float* S, lapack_complex_float const* B, lapack_int const* ldb, lapack_complex_float* X, lapack_int const* ldx, float* rcond, @@ -10774,7 +10774,7 @@ void LAPACK_dsyrfsx( lapack_int const* n, lapack_int const* nrhs, double const* A, lapack_int const* lda, double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, - double* S, + const double* S, double const* B, lapack_int const* ldb, double* X, lapack_int const* ldx, double* rcond, @@ -10792,7 +10792,7 @@ void LAPACK_ssyrfsx( lapack_int const* n, lapack_int const* nrhs, float const* A, lapack_int const* lda, float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, - float* S, + const float* S, float const* B, lapack_int const* ldb, float* X, lapack_int const* ldx, float* rcond, @@ -10810,7 +10810,7 @@ void LAPACK_zsyrfsx( lapack_int const* n, lapack_int const* nrhs, lapack_complex_double const* A, lapack_int const* lda, lapack_complex_double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, - double* S, + const double* S, lapack_complex_double const* B, lapack_int const* ldb, lapack_complex_double* X, lapack_int const* ldx, double* rcond, From 3704f5e5b0a229cbfb3f949dd5fcea557915f49b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 28 Apr 2021 20:56:55 +0200 Subject: [PATCH 08/10] Add missing break statements in the ?lascl functions --- lapack-netlib/LAPACKE/src/lapacke_clascl.c | 1 + lapack-netlib/LAPACKE/src/lapacke_dlascl.c | 1 + lapack-netlib/LAPACKE/src/lapacke_slascl.c | 1 + lapack-netlib/LAPACKE/src/lapacke_zlascl.c | 1 + 4 files changed, 4 insertions(+) diff --git a/lapack-netlib/LAPACKE/src/lapacke_clascl.c b/lapack-netlib/LAPACKE/src/lapacke_clascl.c index fdcb02947..4f4e0bf35 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_clascl.c +++ b/lapack-netlib/LAPACKE/src/lapacke_clascl.c @@ -83,6 +83,7 @@ lapack_int LAPACKE_clascl( int matrix_layout, char type, lapack_int kl, LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) { return -9; } + break; case 'B': // TYPE = 'B' - lower part of symmetric band matrix (assume m==n) if( LAPACKE_chb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_dlascl.c b/lapack-netlib/LAPACKE/src/lapacke_dlascl.c index 5b579a5d1..058105127 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dlascl.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dlascl.c @@ -83,6 +83,7 @@ lapack_int LAPACKE_dlascl( int matrix_layout, char type, lapack_int kl, LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) { return -9; } + break; case 'B': // TYPE = 'B' - lower part of symmetric band matrix (assume m==n) if( LAPACKE_dsb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_slascl.c b/lapack-netlib/LAPACKE/src/lapacke_slascl.c index 25bd9624e..62f7390ed 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_slascl.c +++ b/lapack-netlib/LAPACKE/src/lapacke_slascl.c @@ -83,6 +83,7 @@ lapack_int LAPACKE_slascl( int matrix_layout, char type, lapack_int kl, LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) { return -9; } + break; case 'B': // TYPE = 'B' - lower part of symmetric band matrix (assume m==n) if( LAPACKE_ssb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zlascl.c b/lapack-netlib/LAPACKE/src/lapacke_zlascl.c index 7e37d559c..8bf1ee767 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zlascl.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zlascl.c @@ -83,6 +83,7 @@ lapack_int LAPACKE_zlascl( int matrix_layout, char type, lapack_int kl, LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) { return -9; } + break; case 'B': // TYPE = 'B' - lower part of symmetric band matrix (assume m==n) if( LAPACKE_zhb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { From c5fb91f1bc19baac6c874e6a41fd107c40187278 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 29 Apr 2021 09:47:18 +0200 Subject: [PATCH 09/10] Fix division by zero in the non-x86 codepath --- interface/zrotg.c | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/interface/zrotg.c b/interface/zrotg.c index 8caa411fc..bc4f06492 100644 --- a/interface/zrotg.c +++ b/interface/zrotg.c @@ -79,8 +79,12 @@ void NAME(FLOAT *DA, FLOAT *DB, FLOAT *C, FLOAT *S){ aa_i = fabs(da_r); } - scale = (aa_i / aa_r); - ada = aa_r * sqrt(ONE + scale * scale); + if (aa_r == ZERO) { + ada = 0.; + } else { + scale = (aa_i / aa_r); + ada = aa_r * sqrt(ONE + scale * scale); + } bb_r = fabs(db_r); bb_i = fabs(db_i); @@ -90,9 +94,12 @@ void NAME(FLOAT *DA, FLOAT *DB, FLOAT *C, FLOAT *S){ bb_i = fabs(bb_r); } - scale = (bb_i / bb_r); - adb = bb_r * sqrt(ONE + scale * scale); - + if (bb_r == ZERO) { + adb = 0.; + } else { + scale = (bb_i / bb_r); + adb = bb_r * sqrt(ONE + scale * scale); + } scale = ada + adb; aa_r = da_r / scale; From 444cb78be54e76a90d25476893748c44957d3553 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 30 Apr 2021 09:26:54 +0200 Subject: [PATCH 10/10] correct INFO value (Reference-LAPACK 506) --- lapack-netlib/SRC/dlasq2.f | 12 ++++++++++-- lapack-netlib/SRC/slasq2.f | 12 ++++++++++-- 2 files changed, 20 insertions(+), 4 deletions(-) diff --git a/lapack-netlib/SRC/dlasq2.f b/lapack-netlib/SRC/dlasq2.f index 68d922870..27eb1f79a 100644 --- a/lapack-netlib/SRC/dlasq2.f +++ b/lapack-netlib/SRC/dlasq2.f @@ -184,10 +184,18 @@ * * 2-by-2 case. * - IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN - INFO = -2 + IF( Z( 1 ).LT.ZERO ) THEN + INFO = -201 CALL XERBLA( 'DLASQ2', 2 ) RETURN + ELSE IF( Z( 2 ).LT.ZERO ) THEN + INFO = -202 + CALL XERBLA( 'DLASQ2', 2 ) + RETURN + ELSE IF( Z( 3 ).LT.ZERO ) THEN + INFO = -203 + CALL XERBLA( 'DLASQ2', 2 ) + RETURN ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN D = Z( 3 ) Z( 3 ) = Z( 1 ) diff --git a/lapack-netlib/SRC/slasq2.f b/lapack-netlib/SRC/slasq2.f index 6e5f86447..219797c4a 100644 --- a/lapack-netlib/SRC/slasq2.f +++ b/lapack-netlib/SRC/slasq2.f @@ -183,10 +183,18 @@ * * 2-by-2 case. * - IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN - INFO = -2 + IF( Z( 1 ).LT.ZERO ) THEN + INFO = -201 + CALL XERBLA( 'DLASQ2', 2 ) + RETURN + ELSE IF( Z( 2 ).LT.ZERO ) THEN + INFO = -202 CALL XERBLA( 'SLASQ2', 2 ) RETURN + ELSE IF( Z( 3 ).LT.ZERO ) THEN + INFO = -203 + CALL XERBLA( 'SLASQ2', 2 ) + RETURN ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN D = Z( 3 ) Z( 3 ) = Z( 1 )